From ea3e41aeb6bfe40af0a35bbc04dc52795c15acbe Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Mon, 31 Oct 2016 20:06:04 +0100 Subject: [PATCH] Build MIDAS from source code. --- Makefile | 2 +- build/build.tcl | 6 + doc/midas.macro | 4398 +++++++++++++++ src/midas/midas.458 | 12013 +++++++++++++++++++++++++++++++++++++++++ src/midas/tsrtns.231 | 4586 ++++++++++++++++ 5 files changed, 21004 insertions(+), 1 deletion(-) create mode 100755 doc/midas.macro create mode 100755 src/midas/midas.458 create mode 100755 src/midas/tsrtns.231 diff --git a/Makefile b/Makefile index 047c76ac..ebc66302 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -SRC = system +SRC = system midas MINSYS = _ sys sys3 sysbin RAM = bin/boot/ram.262 NSALV = bin/boot/salv.rp06 diff --git a/build/build.tcl b/build/build.tcl index 60003643..0aa34f1b 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -86,6 +86,12 @@ spawn pdp10 build/simh/boot respond "DSKDMP" "its\r" type "\033g" pdset +respond "*" ":midas midas;_midas\r" +respond ":KILL" ":job midas\r" +respond "*" ":load midas;midas bin\r" +respond "*" "purify\033g" +respond "CR to dump" "\r" +respond "*" ":kill\r" respond "*" ":midas system;_its\r" respond "MACHINE NAME =" "AI\r" expect ":KILL" diff --git a/doc/midas.macro b/doc/midas.macro new file mode 100755 index 00000000..2af03d6b --- /dev/null +++ b/doc/midas.macro @@ -0,0 +1,4398 @@ +-*-Text-*- + +MIDAS Node: Top, Up: (DIR), Next: Invoke + +Overview of MIDAS + + MIDAS is a PDP-10 assembler. It takes as its input an ASCII file, +and produces a binary file in any of several formats (*Note Out: Output.) + +NOTE: Numbers used in this document are assumed to be octal, unless +followed by a "." in which case they are decimal. E.G. 12 = 10. = ten. + +* Menu: + +* Invoke:: How to invoke MIDAS. Commands strings. +* Switches:: MIDAS command string switches. +* Interrupts:: Terminal Interrupt Characters. +* Basic:: Introduction to MIDAS input syntax. +* Example:: Simple example of MIDAS code. +* Frame:: The beginning and end of a MIDAS program. +* Words:: Syntax of the "Word" -- the fundamental MIDAS construct. +* Fields:: Words are made up of fields, which are made of syllables. +* Syllables:: A syllable is a number, symbol, etc. +* LocnCtr:: The "location counter" is used to assign storage locations + to the words which MIDAS assembled. +* Output:: Output formats. +* Relocation:: Relocatable assemblies. +* Symbols:: Defining symbols. +* DDT:: Communicating to DDT. +* Numbers:: Hairy ways of writing numbers. +* LIterals:: Generating constants in memory where you want to use them. +* BYtes:: Pseudos for working with bytes and byte pointers. +* FIleinfo:: How filenames can be accessed at assembly time. +* Terminal:: Typing on the terminal. Reading from the terminal. +* Macros:: MIDAS macros: definition and use. +* LOOps:: Assembly-time iterations for use with macros. +* Cond:: Assembly conditionals. +* Arithmetic:: .I and .F: the "arithmetic assignment" statements. +* FASL:: Assembling code to be loaded by MacLisp. +* Blocks:: Symbol table block structure. +* Constructs:: Alphabetical index of constructs (special characters). +* Pseudos:: Alphabetical index of pseudo-ops. +* LIB: (LIB) The subroutine libraries for MIDAS programs. +* Outformats:: More obscure details about output formats (RIM, etc) +* Changes: (MIDAS ARCHIV)* MIDAS changes in chronological order. + + +MIDAS Node: Invoke, Up: Top, Previous: Top, Next: Switches + +MIDAS Command Strings + + Once you have run the program MIDAS, it will ask for a command line +on which you must specify the names of the input and output files. In +addition to the filenames, the command line usually contains switches. +*Note Switches: Switches. + + MIDAS can write four output files for each assembly: a binary +output file, an error file containing whatever would normally appear on the +terminal, a listing file, and a cross-reference table file. The +cross-reference table file (a compact binary file, not a DEC cref listing) +is not really useful now that the @ program exists (*Note @: (@)Top.). +The listing output file is also inferior to an @ listing, but it is +sometimes useful for debugging hairy macros. To facilitate this use, it is +possible to ask for a listing of both passes (some macros cause fatal +errors on the first pass). The binary output file is essential; an error +output file is also very useful as a permanent record of the assembly +errors. + + Normally, one specifies either just the input file or the input +file and the binary output file. The error output file name is allowed to +default from them. MIDAS tries hard to default all filename components so +as to minimize your type-in. Not specifying the binary file name is +equivalent to letting each component of the name default based on the input +file name. + + Defaulting in MIDAS works bidirectionally; the input file name can +default from the binary file name, and the binary file name can default +from the input file name. This is actually useful. Note how the Twenex +GTJFN-from-the-terminal scheme of things cannot provide this! + + The binary file's device defaults to DSK. The directory defaults +to your working directory. The second filename defaults based on the type +of output format used: BIN for SBLK files, FASL for FASL output files, or +REL for relocatable output files. The first filename defaults to the input +files's first filename. One exception: if TTY: is specified as the input +file, and the binary file name is not specified, no binary file is made. + + The input file's device and directory default to those of the +binary file. The second filename defaults to ">" for ITS and "MID" on DEC +systems. The first filename defaults to that of the binary file. If +no first filename is specified for either file, the default is "PROG". +This becomes relevant sometimes when TTY: is specified as the input device. +Exception: if the binary file was on device PTP or NUL, the default is DSK. + + These defaulting rules make common things very convenient. +To assemble a file FOO;BAR > onto the same directory, you can use + + FOO;BAR_ + +letting the input file names default. To assemble it onto your directory, +just say + + FOO;BAR + +letting the binary file names default. + +* Menu: + +* Switches:: Command line switches. +* Interrupts:: Terminal interrupt characters. + +MIDAS Node: Switches, Previous: Invoke, Up: Top, Next: Interrupts + +Switches: + + Switches should be enclosed in parentheses or preceded by slashes, +and may go anywhere in the command string. The effects of a switch in no +way depend on where it appears, although it should not appear in the middle +of a file name as that may confuse the filename parser. Any number of +switches may be enclosed by one pair of parentheses, as in (ET) which is +equivalent to (E)(T) or /E/T. Each slash is good for just one switch. +It is sometimes significant whether a switch occurs once or twice: (TT) is +not the same as (T). + +/C Produce a CREF file. +/E Produce an error output file. +/L Produce a listing. +(LL) List on 1st pass as well as 2nd. +/T Read assembly input from the terminal after the TITLE + statement, on pass 1. You can type in parameter assignments + to control conditional assembly. +(TT) Read from the terminal on both passes. +/W Do not print on the terminal. + This implies the (E) switch, so your errors are not lost. + /W works by setting the .TTYFLG variable initially to 1. + +MIDAS Node: Interrupts, Previous: Switches, Up: Top, Next: Basic + +Terminal Interrupt Characters. + +In the ITS and Twenex (I believe) versions, the characters ^H, ^V and ^W +have an instantaneous effect if typed on the terminal while MIDAS is +running. + +^H Causes an error message "^H-BREAK" + (which says where the assembly has reached) + followed by the .INSRTion of TTY:. + Thus, this is a sort of "break-loop" you can use + to debug runaway macros. To exit, cause an end-of-file + on the terminal input. + +^V Decrements .TTYFLG. + Since type-out on the terminal happens only when .TTYFLG is + negative or zero, this undoes the effect of one ^W. + (some very bad errors that .INSRT TTY: + also zero .TTYFLG before typing an error message.) + +^W Increments .TTYFLG, suppressing terminal type-out. + It is not wise to do this if you don't have an error + output file (since after the assembly has been started + it is too late to start writing one). + + +In the Bottoms-10 version, you can get a ^H-break by typing +^C and then Reenter. + +MIDAS Node: Basic, Previous: Interrupts, Up: Top, Next: Example + +Machine Instructions in MIDAS + + The main body of a MIDAS program is composed primarily of machine +instructions -- just as you would expect. + + The PDP-10 machine language instruction breaks down into five +fields of bits: a nine bit opcode field, a four bit accumulator (AC) field, +a one bit indirect field, a four bit index register field, and an 18 bit +memory address field. The instruction set is documented very clearly in +the "DecSystem-10 System Reference Manual" (DEC-10-HGAC-D, and the later +versions), which is published by the manufacturer, Digital Equiptment Corp. +("DecSystem-10" is a pretentious salesman's name for the PDP-10). + + In MIDAS, the fundamental syntactic construct is the word. Its +components parallel the fields of a machine instruction, but it is flexible +enough to be used for all other purposes as well. This is because the +subunits or "fields" which compose a word are simply added together, into +parts of the 36-bit word determined by the pattern of spaces and commas +that separate them. Every word of data assembled into the binary program +is written in MIDAS as a syntactical word of some sort or other, with the +sole exception of multi-word text strings. *Note Words: Words, for full +details. + + Words are terminated and separated by the "line terminators", which +are Return, Linefeed, and "?". Return and Linefeed should always be used +together, to prevent confusion when editing the program. Strictly +speaking, Return Linefeed contains a blank line, but blank lines are +ignored anyway. + + The value of the words that appear in a MIDAS program become the +words of the binary program output. Each word is assembled at the +address specified by the MIDAS "location counter", which increments by one +after each word to put consecutive words in consecutive locations. This is +called "assembling a storage word". The ultimate goal of assembling a +program is to assemble storage words, but word quantities can appear in +other contexts such as to be passed as arguments to functions. Before +each word in the MIDAS input, at the beginning of the line, there may be +one or more "labels", which are symbols which are defined to equal the +current value of the location counter. Thus, a label preceding a word is +defined to be the address of that word. *Note LocnCtr: LocnCtr. + + The other most important constituent of a MIDAS program is the +comment. A comment starts with a semicolon ";" and ends with the following +Return. The whole thing is equivalent to a single Return. Another way to +think of it is that you can put a comment at the end of any line in the +file; but "lines" terminated by the "?" character do not count. + + A few other MIDAS constructs may appear in place of a word. One is +the parameter assignment, which defines a symbol with an explicitly +specified value at assembly time. *Note Assign: Symbols. Another is the +"Statement". Everything that must be specified in a MIDAS program aside +from the contents of words to be loaded and the values of symbols is +specified by means of statements. A statement begins with a symbol which +is the name of a "pseudo-op"; it is a sort of escape which directs MIDAS +to perform some special function. Some pseudo-ops read arguments. The +syntax of the arguments depends on which pseudo-op it is. An example of a +statement is the END statement, which must appear at the end of every +program. It starts with the symbol END. After that comes the program's +starting address, which is syntactically a word (and thus, terminated by a +"?" or Return or Linefeed). If a Return immediately follows the symbol +END, then there is no argument (and no starting address). + + The separation into lines should not be thought of as a +hard-and-fast rule. The "line-separating" characters USUALLY have that +effect, but in some contexts (such as text-string constants) they may have +NO special effect. and "?" are both "line-separators", but in a +semicolon-comment they do not act the same: a ends the comment, but a +"?" is ignored as "part" of the comment. Semicolon usually starts a +comment, but not inside a text string. Thus, + + MOVE A,B ;COMMENT ? MOVE C,D + +assembles only a single instruction. The moral is that the meaning of a +character depends on its context, which depends on the characters IN FRONT +of it. MIDAS does not work by BNF-like grammatical rules ("a MUMBLE can be +either a FOO or three BARs in a row") although a few constructs can be +approximated by them. It works like a finite-state machine: "In the normal +input-reading state, if a is read, terminate the line and process it; +if a question-mark is read, terminate the line and process it; if a +semicolon is read, enter the comment-reading state. In the comment-reading +state, if anything but a is read, ignore it; if a is read, return +to the normal input-reading state and terminate the line and process it." + +MIDAS Node: Example, Previous: Basic, Up: Top, Next: Frame + +Simple examples of MIDAS code + + MOVE C,COUNTA + TLNE B,100 + SETZ C, + JUMPGE A,@DISTAB(B) + JRST LABEL1 + +Each of these lines will generate one storage word in the output. +The first line will generate a MOVE instruction that will load the +contents of memory location COUNTA into accumulator C. This is accomplished +by putting the value of the symbol C in the instruction's AC field, +and the value of the symbol COUNTA in the address field, and then adding +the value of the symbol MOVE (which supplies the appropriate value in the +op-code field). The second line is similar, except that the address field +is specified by the octal number 100 instead of a symbol. That is a +common thing to do with instructions like TLNE which use the address +as a bit-mask. The third line is a SETZ instruction. The address field +has been omitted, because the SETZ instruction ignores its address. +In fact, the address field will be assembled as zero. The SETZ has been +indented one space as a note to humans that the preceding TLNE instruction +can skip over it. The fourth line +is a JUMPGE instruction which demonstrates indexing and indirect addressing. +The "@" turns on the instruction's indirect-bit, selecting indirect +addressing. The "(B)" puts B's value in the index field. Presumably, +B is the number of an accumulator which is to be used as an index register. +The fifth line shows a JRST instruction, for which it is not necessary +to specify an accumulator. In fact, the accumulator field of the instruction +will be assembled as zero; but instructions that actually use accumulator +zero should say so explicitly. + So in the simple cases, MIDAS agrees with the format used in the +"DecSystem-10 System Reference Manual." + +MIDAS Node: Frame, Previous: Example, Up: Top, Next: Words + +The Framework of Every MIDAS Program + + A MIDAS program consists primarily of PDP-10 instructions and +data, together with labels and comments. But other things are usually +or always needed at the beginning and end of the program. + + The first thing in every MIDAS program (or every subfile of +one, for that matter) is a line containing ";-*-MIDAS-*-" to tell +EMACS how the file is to be edited. + + The second thing in a MIDAS program, which is not actually +needed for small programs, is a .SYMTAB statement which says how large +a symbol table is required. The argument to .SYMTAB is the desired +number of entries in the symbol table. This must include the +predefined symbols, the user-defined symbols, and some extra to make +hashing efficient. It should also be prime. To help you set up your +.SYMTAB, MIDAS prints the symbol table size and the number of entries +used at the end of the assembly. + + Next, in every MIDAS program, should come the TITLE statement, +which consists of TITLE followed by a line of text, and performs these +functions: +1) for relocatable assemblies, the first symbol following TITLE +becomes the name of the relocatable program being assembled; +2) the text following TITLE is printed on the terminal on each pass. +3) when the /T switch is used to request input from the terminal, +this input is read when the TITLE statement is reached. +Because of 3), it is sometimes useful to define a few symbols before +the TITLE statement so that they can be used when giving input on the +terminal. If there is no TITLE statement, /T won't do anything! + + After the TITLE statement, you should define names for the +accumulators. Single letters starting with A=1 are best. Accumulator +0 should also have a name, but not in sequence with 1, since 0 can +only be used for special purposes. But don't ever write an +instruction which actually USES accumulator 0 without putting in the +name of that accumulator. The stack pointer should be in accumulator +17, which should be named P. Putting the accumulator definitions on +page 1 will produce the best results in @ listings. + + After this point, you are on your own. But at the end of the +program, you need an END statement. The END statement consists of END +followed by the starting address of the program (this is an old assembler +tradition). You can omit the starting address if you don't want your +program to have one (in a relocatable program, this is often the case). If +you don't have an END statement, you get an error. This catches many +errors in assembly conditionals and macro definitions which cause the +END statement not to be recognized as such. Any text which follows the END +statement will be ignored completely by MIDAS. + +MIDAS Node: Words, Previous: Frame, Up: Top, Next: Fields + +Words, and Their Syntax + + The "word" is the most commonly used MIDAS construct, as a storage +word to be assembled must be, syntactically, a word, and an ordinary PDP-10 +instruction is an example of a word. However, the word construct includes +other things than instructions, and is used in other contexts besides that +of storage words. This section of the manual describes how to put a WORD +together. The concept of a WORD is tied closely to those of SYLLABLES and +FIELDS, out of which WORDS are made. Loosely, a syllable is a number or +symbol, and a field is an arithmetic expression. Words are made up of +fields, and fields are made up of syllables. Do not confuse a MIDAS field +with a "field" of bits in a PDP-10 machine language word. + + A word is one or more fields connected by field separators, with +optionally an indirect bit or index field anywhere among them. There +are two field separators, space (or horizontal tab) and comma. (Space and +horizontal tab are identical and will both be referred to as space.) To +improve readability, spaces before and after a word and spaces adjacent to +a comma are ignored, and more than one space in a row are treated as one. + The values of the fields are combined to form the values of the +word according to the number of fields and the pattern of separators. These +formats are described in the following table, in which A, B, and C are +fields. "TR(x)" is used to represent the result of truncating x to 18. bits. + + +pattern format # value + in octal +====== ======= ===== + +,,C 13 TR(C) +,B 14 TR(B) +,B C 15 unassigned +,B, 16 unassigned +,B,C 17 unassigned +A 20 A + 21,22,23 not possible +A B 24 A++TR(B) +A B C 25 A++TR(B)++TR(C) +A B, 26 A+<_23.> +A B,C 27 A+<_23.>++TR(C) +A, 30 A + 31 not possible +A,, 32 _18. +A,,C 33 _18.+TR(C) +A,B 34 A++TR(B) +A,B C 35 unassigned +A,B, 36 unassigned +A,B,C 37 unassigned + + Here are some examples of what these formats are most useful for: + +A B,C This is the normal instruction format, e.g., CAMN A,FOO +A B This is good for instructions with no accumulator field, + e.g., JRST BAR +A B, and this is for instructions with no address field, e.g., + SETZ D, +A,,C This is the standard way to specify the contents of a + storage word by half-words, e.g., + BLETCH: -PDL,,PDB + +NOTES: + +1) "+" means normal 36-bit addition, but "++" addition is special in +that carry from bit 18 to bit 17 is suppressed. In other words, when the +user specifies a field which is supposed to be a right half-word field, he +can normally rest assured that his quantity didn't carry over into the left +half. + +2) A word may have more than three fields. In that case, the +fourth and following fields are added in with the third field. Thus, +if the third field is truncated to 18. bits and added in, so are the +following fields. Only spaces may be used for separating fields after +the third field; a comma after the third field is an error, but will +be treated as a space. Commas are flagged so as to catch places where +the accidental omission of a has run two lines together. + +4) The user can redefine these formats by using the .FORMAT pseudo-op. +That is what the "Format number" of a format is used for, and the pseudo +is documented here: +.FORMA fno,fval + Inserts an entry in the format table (ie replaces old entry) for +format number "fno". The numeric value of field fval is taken as three +12-bit bytes referring to the (up to) three distinctly handled fields in a +word: the left 12 bits refer to the rightmost field, the middle 12 bits to +the field next to the rightmost (if any) and the right 12 bits to the field +2 from the right and any additional fields. (If there is only one field in +a given format it is the rightmost regardless of punctuation which may be +required after it.) + A 12-bit byte describing a particular field is in turn treated as +two 6-bit bytes. The right 6-bit byte specifies a mask and the left 6-bit +byte specifies a shift. The mask number (say M) directs that only the +right M bits of the field value be taken. The shift number (say S) directs +that the bits remaining after masking be shifted left S bits. The fields, +after this masking and shifting are added to give the value of the word. +(Example: the 12-bit specification 2704 describes an accumulator field: +_23.) + There are three exceptions to the above procedure. (1) If a field +is specified as 0022 (right half, not shifted) the carry out of bit 18 is +suppressed as the field is added into the word. (2) A virtual quantity may +only occur in a field specified 0044, 0022, 2222, 0504, or 2704. (3) If as +a syllable in the leftmost field of a word appears any of the eight I/O +instructions (DATAO, DATAI, CONO, CONI, BLKO, BLKI, CONSZ, CONSO) then any +field in that word specified 2704 is instead taken as if specified 3211 +(I/O device field) + + + In addition to the fields and separators that make up a word, there +can be an indirect bit and an index field. These subconstructs resemble +the fields of the word in that their values are merged into the value of +the word. They differ from the fields in that they are marked out by their +own special syntax, and are interpreted in the same way no matter where in +the word they appear (unlike fields, which are all the same and are +interpreted according to their position in sequence). + + a. The Indirect bit + + The character @ (atsign) is a special character. It may occur +anywhere inside a word. Whenever MIDAS encounters an @ inside a word, a 1 +is ORed into bit 22. of the word, i.e., the indirect bit. The @ does not +terminate syllables or fields, nor is it taken as part of a syllable or +field. + Its position in the word is totally irrelevant. However, the +normal convention is to put it in front of the field specifying the right +half of the word (the address) if there is one; if not, put the @ where the +address would go. + + b. The Index field + + To get a certain quantity into the index field, the easy, convntional +way is to use a bracketed word of the parentheses type. For example, + MOVE A,FOO(D) +will put the value of D into the storage word's index field. As explained +in section C.2.d, the parenthesis bracketed word works in its strange way +because the index field of the machine word is the lowest four bits in the +left halfword. + The index field, used this way, may appear anywhere in the word +except in the middle of a syllable or following an arithmetic operator, but +the normal convention is to put it at the end of the field specifying the +right half of the word (the address) if there is one. When "(" appears +following an arithmetic operator, it signifies a type of bracketed word, +rather than an index field. + +MIDAS Node: Fields, Previous: Words, Up: Top, Next: Syllables + +Fields + + A "field" in MIDAS is essentially an arithmetic expression. A +field may be either a single syllable, or two or more syllables combined +arithmetic operators. Many MIDAS pseudo-ops take arguments that are +syntactically fields. These are the arithmetic operators, in their order +by priority: + + char. operator + ===== ======== +highest _ left shift 1st operand by # of bits specified by 2nd + operand. (Negative 2nd operand shifts right) + & bitwise AND + # bitwise XOR + \ bitwise OR + * and / 36. bit integer multiplication and subtraction +lowest + and - 36. bit integer addition and subtraction + + + Thus all _'s are done first, then &'s, then #'s, then \'s, then *'s +and /'s, and finally +'s and -'s. Operators of the same priority will be +performed in left-to-right order. Examples: (assuming that A, B and FOO +are numerically defined symbols with the values 1, 2, and 53 respectively.) + + Field Value + ===== ===== + 3+4 7 + 1+4&FOO+1 2 + 1+4& 5 + + The first example is rather trivial. The second and third +demonstrate the use of angle brackets as algebraic parentheses (actually, +part of the syntax of syllables). In the second, 4 is anded with FOO, +giving zero, then 1+0+1 equals 2. In the third example, first FOO is added +to 1, giving 54. Then 54&4 gives 4, and then the 4 is added to the 1, +giving 5. + + Note that there may NOT be spaces within a field; so "4 * 5" is +not the same as "4*5". + +MIDAS Node: Syllables, Previous: Fields, Up: Top, Next: LocnCtr + +Syllables + + There are several types of MIDAS syllables. A symbol may be a +NUMBER, a NUMERICALLY DEFINED SYMBOL, a QUOTED CHARACTER, a BRACKETED WORD, +or a call to a PSEUDO-OP (but see *Note MACROS:macros) +(Note: only "value-returning" pseudo-ops can be used to make syllables. +Other pseudo-ops will either be ignored by the process of building words +and fields out of syllables (except for their side effects), or illegal to +be used except alone on a line). + + Each syllable has a value, which is a 36.-bit quantity. + + a. NUMBERS + + The simplest form of number is an octal integer, which is just a +string of digits. Following them with a "." makes it a decimal integer +instead. + + *Note Numbers: Numbers, for other sorts of numbers, which you won't +need very often. + + + b. SYMBOLS + + A symbol is a string of SQUOZE characters which is not a +number. More precisely, it is a string of characters from the +SQUOZE character set of length 1 or greater which contains at +least one letter, or at least one % (percent) or $ (dollarsign), +or at least two .'s (periods). The SQUOZE set includes all 26. +letters, all 10. digits, and the characters $ (dollar sign), % +(percent sign), and "." (period). (Note that the symbol "." (a +single period) is special; *Note LocnCtr: LocnCtr.). + + Here are some examples of symbols: + + LOC3 + GOHERE + $END + A%LOCATION + 35X + 1.2.3 + .$Z%.G + +(The last example is NOT considered an example of good programming style.) +A symbol has no length restriction, but MIDAS only looks at the first six +characters, so the symbols THISLOCN and THISLO, for example, are +effectively identical. + + MIDAS symbols can have several sorts of definitions. The symbols +that can appear as syllables are those with numeric definitions (other +sorts of symbols might appear at the same places, but they would be +interpreted differently and would constitute different constructs). MIDAS +provides many predefined numeric symbols (including all the PDP-10 +instructions, and others specific to the operating system), and programmer +can define others (*Note Define: Symbols.). + + An example of numerically defined symbols: +In the word MOVE B,FOO , there are three symbols: MOVE, B, and FOO. +The symbol MOVE is predefined; the other two must be defined by the +programmer. + + c. Quoted Characters: + + A quoted character starts with any one of the characters ' (single +quote), " (double quote), or ^ (uparrow) followed by a character. The +quote or uparrow and the character following are taken as a syllable. A ' +followed by a character has the value of the SIXBIT representation of the +character. A " followed by a character has as its value the ASCII +representation of the character. ^ works the same way as " except that the +ASCII value is ANDed with 77 octal; that is, only the low six bits are +kept. ^ is used for generating the ASCII code for "control" characters. + Examples of quoted characters: + + Syllable Value + ======== ===== + + 'A 41 octal + "+ 53 octal + ^C 3 octal + + d. Bracketed words: + + A word surrounded by ( ) (parentheses), < > (angle brackets), or [ +] (square brackets) is a syllable called a BRACKETED WORD. Each works in +its own way: + + is simply a syllable whose value is that of the word between the + brackets. Angle brackets act much like algebra's parentheses, + and are usually used that way. + +(word) works two different ways. If the preceeding character is an + arithmetic operator, the value of the word has its halves swapped, + and this becomes the value of the syllable, on which the arithmetic + operator acts. If the preceeding character is not an arithmetic + operation, the value of the word is swapped and saved, and at the + end of the outer word, it is added into the word being formed. + This quirk is so that (5) stuck at most places in a word will put 5 + in the index field. + +[word] is a LITERAL, or CONSTANT. *Note Literals: Literals. The value of + the syllable is the location where MIDAS put the literal. + + It is hard to give examples of ( ) and < > until some further +concepts have been introduced, so these have been delayed. + + e. Pseudo-ops which return a value: + + Pseudo-ops are instruction given by the programmer to MIDAS in the +input ASCII file about how to assemble various things. They are described +in section E, "Pseudo-ops that every programmer needs," and in the section +on pseudo-ops. + They are the "built-in functions" of the MIDAS assembly-time +programming language. Some pseudo-ops are used for their side-effects; +some, to compute values. Calls to value-returning pseudo-ops constitute +syllables, whose value, of course, is the value returned by the pseudo-op. + +MIDAS Node: LocnCtr, Previous: Syllables, Up: Top, Next: Output + +The Location Counter + + Normally, when MIDAS finishes reading a Word at top level in the +input file, the value of that word is assembled into the binary program +output. The place where it will be loaded is specified by the location +counter, which is normally an 18.-bit number. After assembling each such +word, MIDAS increments the location counter. + + The value of location counter is explicitly available as the value +of the symbol ".". It refers to the address of the current word, not the +following one. A label defines a symbol to equal the current value of ".". + + The location counter can be set with a LOC statement, or by +assigning a value to the symbol "." (*Note .=: Symbols, for how to do +that). These have slightly different effects when an offset is in effect. +In a relocatable program, the location counter can be set to a relocatable +value or to an absolute value. + + The usual way to leave space for non-constant data in a program is +the BLOCK statement. + + BLOCK 200 + +leaves 200 words of space, by incrementing the location counter by 200 . +It is an error to ask for a block of negative length. + + In relocatable assemblies, the location counter starts out at +relocatable zero. In absolute assemblies, it starts out at absolute 100 +octal. + + Sometimes it is necessary to assemble code at one location and copy +it to another before using it. When that is done, all references to labels +in the code (whether from within it or outside it) should be arranged so as +to be correct when the code has been moved to its ultimate position. This +can be done by defining an offset. The statement + + OFFSET 200 + +causes all references to the location counter -- the symbol ".", labels, +etc. -- to add 200 to the real value of the location counter. If the code +being assembled is moved 200 words upward, it will be at the addresses at +which the program will refer to it. + + Offsets do not affect the actual location counter, which is the +place at which code will actually be loaded. They affect the value of the +location counter as seen by references to it from within the program. +The difference between LOC and assigning a value to "." is that LOC sets +the real location counter, whereas assigning "." sets the value of ".": +that is, it subtracts the offset and then sets the real location counter, +so that when the offset is added in again to get the value of "." it will +equal the value assigned. + + An offset can be cancelled by setting the offset to zero. + + A frequent use of the offset is for error checking. If there are a +series of symbols FOO, BAR, QUUX ... with values 0, 1, 2 ... intended to be +the values of a particular table index, with MAX being 1 larger than the +largest legal index, the table can be defined with + + TABLE: OFFSET -. + FOO:: + BAR::
+ QUUX::
, and the format of the +SBLK file symbol table in .INFO.;DDTORD >. + +MIDAS Node: Relocation, Previous: Output, Up: Top, Next: Symbols + +Relocatable Assemblies. Specifying the Type of Output. + + Like MACRO-10, MIDAS is capable of making both relocatable and +absolute assemblies. The type of assembly is controlled by pseudos +appearing in the program, with a default which varies with the operating +system. In an absolute assembly, all location counter values (and all +expression values, in fact) are completely known at assembly time, or else +are undefined. In a relocatable assembly, while some location counter +values and expression values may be known at assembly time, most depend on +an unknown relocation which will be determined only by the linking loader. +The location counter value is likely to be a known quantity plus the +unknown relocation. Symbol values can also have that form (and will, when +the symbol is defined as a label when the location counter has that form). +Expression values can take the form of a known quantity plus any number +times the relocation that number being the "relocation factor". Values +completely known at assembly time are called "absolute", and have a +relocation factor of 0. Simply relocatable quantities, such as typical +location counter values, have relocation factors of 1. MIDAS can handle +higher or negative relocation factors internally but cannot write them into +the output file except in STINK format output. + + Whether an assembly is absolute or relocatable is tied closely to +what output format is used. The formats that exist are + + SBLK Standard ITS absolute format. + This is the default on ITS. + RELOCATABLE STINK format (relocatable). + Used only on ITS, and not much. + .DECREL Standard DEC relocatable, for LINK10. + This is the default on non-ITS systems. + .DECTWO Standard DEC two-segment relocatable. + is the segment boundary, usually 400000 . + .DECSAV Standard DEC SAV file format. Absolute. + .FASL MACLISP FASL file format. Relocatable. + RIM Read-In Mode format for PDP-6. Absolute. + RIM10 Read-In Mode format for PDP-10. Absolute. + + The names of the formats are all pseudo-ops which you can put in +the program to specify those formats. If the format you want is the +default for your particular system, you don't need to specify it, but if +you can anticipate that your program will be assembled on other systems it +might be wise to do so anyway. + + A few functions are available for manipulation of relocatable +quantities. These include .ABSP, .RELP, and .RL1. .ABSP and .RELP return +the absolute and relocatable parts of a quantity (the relocatable part is +the relocation factor. .RL1 is a symbol whose value is a pure +relocatability of 1; that is, a relocatable zero. You can think of these +as analogous to the the complex number functions Re, Im and the constant i. +.RELP .RL1 is nonzero if the asembly is relocatable. + +MIDAS Node: Symbols, Previous: Relocation, Up: Top, Next: DDT + +Defining Symbols + + You have already been told how to use symbols and what names they +are allowed to have. Here is how to define them. + + A symbol can have these types of definition (or none at all): +numerically defined symbols, pseudo-op names (*Note Pseudos:Pseudos.), and +macroinstruction names (*Note Macros: Macros.). Here we are concerned only +with numerically defined symbols. New pseudo-ops cannot be defined by the +user, so the initial supply is all you get, but pseudo-op definitions can +be copied from one symbol to another using EQUALS. + + There are basically two ways to define a symbol numerically: as a +LABEL, and as a PARAMETER. + + 1. Labels. + + The primary use of symbols is to hold the address of an instruction +or variable in the program. MIDAS has a special construct, the LABEL, for +defining such symbols. A label is simply a symbol followed by a colon, and it +can appear at the beginning of any line. Its effect is to give the +symbol a value equal to the address where the next storage word will go. +A line can have several labels in it, but a label may not appear after +any other construct has begun. A label may be followed by anything at all, +or it may be the only thing on its line. An example is: + + FOO: MOVE A,TABLE(C) + +which assembles a storage word containing a MOVE instruction, and +also defines FOO as the address of that instruction. + + If a symbol is defined as a label, it can have only one value. +If anything in the program tries to define the symbol with a different +value, either before or after the symbol's appearance as a label, an +error message will be typed. It is legal to define the symbol again +with the SAME value. In fact, that happens to every label, since it +is seen on both passes of the assembly. + + The parameter assignment "=:." has the exact same +effect as the label ":", which is allowed for convenience's sake. + + 2. Parameters. + + There are other uses of numerically defined symbols besides +their use as labels. MIDAS also allows definition of symbols by +PARAMETER ASSIGNMENT. A parameter assignment is a line of the form + = or == +which tells MIDAS to compute the value of and make that the value +of . This is similar to the "assignment" statement of most +mathematical languages, such as FORTRAN. Using the == construction +makes the symbol half-killed in DDT (this is explained in the section +on OUTPUT; for now, suffice to say that the == form is the one you +probably want to use.) Here is one of the ways to use this feature: + + Say a programmer is writing a program which knows how to handle +four FOOBAR's. If in the future he should want to modify the program +to handle five or six FOOBAR's, there might be many places where the +program would have to be changed. Now if he had made the number of +FOOBAR's an assembly parameter, by defining a symbol as in: + NFOOBR==4 +and writing all of the program to work for NFOOBR FOOBAR's +Whenever there is a table or block of data whose length must +be referred to by the program, that length should be expressed +by a numeric symbol. + + Symbol definitions actually have a static scoping or block +structure as in Algol or PL/I. *Note Blocks: Blocks. + +MIDAS Node: DDT, Previous: Symbols, Up: Top, Next: Numbers + +Communicating Information about Symbols to DDT + + One of the most important things about symbols in assembler +programs is that they are passed to DDT. MIDAS has several features +designed specifically for communicating with DDT. + + If DDT, needing to print the value 205, chose at random a symbol +whose value was close to 205, it would be likely to find several names for +bits in various registers. It is essential to have a way to tell DDT which +symbols ought to be used for such type-out. This is done by "half-killing" +the symbols which ought not to be used. + + The most common way to half-kill a symbol is to duplicate the colon +or equal sign used to define it. Thus, FOO==200 says that FOO is to be +half-killed and should never be printed out, while FOO=200 allows FOO to be +printed out. FOO:: defines FOO as a half-killed label. + + If those methods of half-killing are not convenient, the .HKILL +statement is available. .HKILL followed by a list of symbols half-kills +those symbols. If the symbol .HKALL is nonzero, then all labels defined +are half-killed. + + .KILL can be used to avoid sending a symbol to DDT at all. It is +followed by a list of symbols to kill. MIDAS does not forget the value of +a symbol when you .KILL it, so .KILL is not the same as EXPUNGE. .KILL +causes the symbol to be forgotten only when the symbol table is written +into the output file. + + The NOSYMS statement can be used to avoid outputting any symbol +table at all. + +MIDAS Node: Numbers, Previous: DDT, Up: Top, Next: Literals + +Details of the Syntax of Numbers + + A string of digits in which no digit is preceeded by a period +forms an INTEGER, a type of syllable whose value is the value of the +number interpreted in the CURRENT RADIX (octal by default, but see +*Note PSEUDO-OPS:pseudo-ops.). + +However, an integer followed by ' (single quote) is interpreted as octal, +and one followed by . (period) is interpreted as decimal, regardless of +the current radix. A string of digits with a . (period) to the left of +some digit forms a FLOATING-POINT NUMBER, interpreted in decimal. + + Either of these may be followed by a ^ (uparrow) which works +something like scientific notation. An integer may be followed by an +integer as + + A^B + + which would have the value of + + B + A*R + +where R is the radix in which A is expressed. The result is fixed-point. +A floating point number may also be followed by a ^ and an integer, as in + + X.Y^A + +which is interpreted as + + A + X.Y*10. + +that is, as scientific notation. The result is still floating-point. + + Also, any of the preceeding numeric formats may be followed by a _ +(backarrow, or underscore) and an integer, which multiplies the value by + integer + 2 + The integer is interpreted in the current radix, but may +be forced to decimal or octal by terminating it with . or ' as explained +above. The result is always a fixed-point number, even if the first number +was floating-point! + +Examples of NUMBERS: + (the current radix is taken to be octal) + + Syllable Value + ======== ===== + + 23 23 octal + 23. 27 octal + 3^3 3000 octal + 3.^3 5760 octal (3000. decimal) + 1_3 10 octal + 23_10. 46000 octal + 3.5 3.5 floating-point + 3.5^4 35000.0 floating-point + 3^3_4 60000 octal + 1.5_3 14 octal (Note: NOT floating point!) + +MIDAS Node: Literals, Previous: Numbers, Up: Top, Next: Bytes + +Literals + + Normally, when you write a machine instruction in an assembler, you +specify the memory operand by its address. Sometimes, it is desirable to +refer to "a word containing X" without worrying about where that word is +going to be stored. The LITERAL is a construct that permits just this. + + A literal consists of any number of lines enclosed in square +brackets ("[" and "]"). MIDAS assembles the lines enclosed into locations +of its own choosing. The value of the literal, where it appears, is the +address of the location chosen by MIDAS to hold the first word of the +literal. For example, + + MOVEI A,[1 ? 2 ? 3] + +would load accumulator A with the address of a three-word table whose +contents are 1, 2 and 3 in successive words. It is equivalent to + + MOVEI A,FOO1 + .... +FOO1: 1 ? 2 ? 3 + +where FOO1 is a non-existent label by which you can imagine that MIDAS +connects the usage of the literal with the location of its contents. + + Unless you request otherwise, all literals will actually appear at +the end of your program (that is, at wherever the location counter was set +when the END statement was encountered). However, you can alter this with +the pseudo-op CONSTANTS. Whenever CONSTANTS appears, all saved-up literals +will be "dumped out" or assigned locations starting at the current location +counter. CONSTANTS may appear any number of times (up to 75 or so), but +must appear the same number of times and at the same locations on both +passes. + + On pass 1, MIDAS doesn't know where a literal is going to be +located until the CONSTANTS statement is seen. On pass 2, the location of +the CONSTANTS statement is known in advance (remember, it must be the same +as on pass 1), but the location of the literal is still not known until the +end of the literal (so that recursive literals can work). For these +reasons, labels inside literals cannot work, so they are not allowed. +The symbol "." inside a literal refers to the location from which the +literal is being referred to, not the location where the literal will +appear. + + If you set the variable .LITSW nonzero, any use of a literal is an +error (until you set the symbol to zero again). + +MIDAS Node: Bytes, Previous: Literals, Up: Top, Next: FileInfo + +Manipulating Bytes and Byte Pointers. + + MIDAS provides several built-in functions for making and using byte +pointers of the form suitable for the LDB and DPB instructions. + + When you want to make a byte pointer from a given numeric position and +size, simply write the byte pointer left half as an octal constant. There +is really no way to improve on that, given that you are going to be using +numbers. For example, 440700,,FOO is suitable for ILDB'ing the ASCII +string starting at word FOO. It is common practice to define symbols for +byte pointer left halves and then use them to represent fields, as in + +ASCBP==440700 +... + MOVE A,[ASCBP,,FOO] + + A more sophisticated symbolic way of referring to fields uses the .BP +function. .BP takes as an argument a mask for a field in a word, and +returns a byte pointer to that field (in address zero). Thus, <.BP 7770> +would return 031100,,000000. When the argument to .BP is terminated with a +comma, the comma is not eaten, as it would be with most functions. +Instead, the comma turns into a space. Thus, .BP 7770,FOO returns +031100,,FOO, a byte pointer to the 7770 field in address FOO. In addition, +parentheses inside the argument to .BP are part of the argument to .BP, not +part of the word in which .BP occurs. .BP is most useful with symbolic +names for fields or bits in a word. For example, + LDB A,[.BP (%TOERS),TTYOPT] +would get into A the contents of the %TOERS bit in the left half of TTYOPT +(%TOERS being a bit symbol suitable for use in a TLNE instruction). + + The reverse of .BP is .BM. It takes a byte pointer (ignoring the +address) and produces a mask for the specified byte. The left half of a +byte pointer may be passed in the right half of the argument word. This +Is useful when you have defined a symbol for a byte pointer left half and +want the corresponding mask. Unlike .BP, .BM follows the ordinary +conventions for arguments. Example: .BM 030600 returns 770. + + Bytes can be extracted from and deposited into quantities at assembly +time using the .LDB and .DPB functions. .LDB takes a byte pointer +(ignoring the address) or a byte pointer left half in the right half, and +also a quantity as second argument. It returns the contents in that +quantity of the specified byte. .LDB 030600,1234 returns 23. +.DPB takes as arguments a byte value, a byte pointer (or left half in right +half, etc) and a quantity, and returns a new quantity made by changing the +specified byte of the old quantity to contant the byte value. For example, +.DPB 11,030600,4444 returns 4114. + + The .IBP function increments a byte pointer. It accepts a byte pointer +and returns the incremented pointer. .IBP <440700,,> returns <350700,,>. +The address supplied with the byte pointer is part of the incrementing +process; thus, .IBP <440700,,FOO> returns <350700,,FOO> and +.IBP <010700,,FOO> returns <350700,,FOO+1>. If the left half of the +argument is zero, the argument is swapped, so .IBP 440700 returns +<350700,,>. + + Two functions related two byte manipulation are .LZ and .TZ, which return +the number of leading zero bits and trailing zero bits, respectively, in +their arguments. .LZ SETZ is 0 and .TZ SETZ is <35.>. When applied to +zero, both return <36.>. + + For assembling words into memory made by packing bytes together, you +could use .DPB, but a special feature exists for this purpose, called +.BYTE. .BYTE takes a list of byte sizes, and enters a special mode in +which "words" assembled at top level are stored, not into successive whole +words, but into successive bytes of the specified sizes. The sizes are +used in the order specified, over and over cyclically. Here is an example: + +.BYTE 12.,6 + 2222 + 33 + 1111 + 44 +.BYTE + +would assemble a single word, made up of a 12. bit byte, a 6 bit byte, a +12. bit byte, and a 6 bit byte. The contents would be 222233,,111144. +Note that .BYTE with no arguments is used to return to ordinary non-byte +mode. + + Byte mode inside literals and other bracketed groupings is independent +of what is going on outside the grouping. That is, groupings always start +out in ordinary (non-byte) mode, even if byte mode was in effect outside; +byte mode may be turned on inside the grouping, but when the grouping ends +the state of byte mode will be restored to what it was before the grouping. +For example, <.BYTE 7 ? ^M ? ^J> is a quantity whose value is a CRLF in +ASCII. It is equivalent to ASCII/ +/. + + While byte mode is in effect, the location counter is a byte pointer. +Its value is such that an ILDB instruction on it would fetch the next byte +to be assembled. This is historic; it may well be that a better +convention would be that the location counter be such that a LDB would +fetch the next byte to be assembled. As it is, you must use .IBP to get +such a byte pointer. It works to set the location counter to a different +byte pointer, though it is recommended that you make the size correct. +If the byte pointer is inconvenient for you, .BYTC may be more useful. Its +value is the total number of bytes assembled since byte mode was entered. +The insides of literals and groupings do not count. + + .WALGN (word-align, not wall-generate) in byte mode advances the location +counter to the beginning of a fresh word. It does nothing in normal +non-byte mode. .BYTE with no arguments automatically does a .WALGN. + +MIDAS Node: FileInfo, Previous: Bytes, Up: Top, Next: Terminal + +Obtaining Information on Filenames at Assembly Time. + + One of the most common things one wants to do is to assemble a program's +version number into the program. This can be done, on ITS and Twenex, +using the symbol .FVERS, whose value is the version number of the main +input file, and .IFVRS, whose value is the version number of the current +input file if that file has done no .INSRTs, or the version number of the +last file .INSRTed by the current input file. + + More information is available in the variables .FNAM1 and .FNAM2, which +hold the sixbit filenames 1 and 2 of the main input file, and .IFNM1 and +.IFNM2, which hold similar information for the same file as .IFVRS. +These variables are available on Bottoms-10, where there are no version +numbers, as well as on other systems. On ITS, the version number is a +function of the filename 2, made by taking all the digits in it and +converting them using base ten to a number. + + The names of the output file (in sixbit) can be found in .OFNM1 and +.OFNM2. The version number is not available, since on ITS it does not +exist. + +MIDAS Node: Terminal, Previous: FileInfo, Up: Top, Next: Macros + +Interaction with the Terminal. + + The simplest and standard way to print a message on the terminal is with +the PRINTX operation. It takes a string, delimited as for ASCII, and types +it out. For example, PRINTX /FOO/ will type FOO, with no carriage return. +.TYO is a function that takes a single character, as a number, and types +it. .TYO 101 will print an A. + + Another useful function is .TYO6, which takes an argument which is +interpreted as sixbit and printed out. .TYO6 is useful primarily with +.FNAM1 and .FNAM2. + + Error messages are printed on the terminal, of course. The .ERR function +signals an error, taking the rest of the line as error message. Along with +the error message will go the usual information of filenames, page and line +number, location counter both absolute and relative, and macro depth. +There are no special facilities for putting any variable information in the +error message because the macro features can be used to do this. + + There are two ways to request input from the terminal. You can ask a +specific question, or you can give the user the opportunity to enter any +MIDAS code he wants. To allow him to enter arbitrary text, do + .INSRT TTY: +which reads input from the terminal, ended by ^C or ^Z. If you want it to +be done only on pass 1, you must put it in an IF1 conditional. +The /T switch can be used in the command line to cause a .INSRT TTY: to be +done in a program which does not actually contain one. It will be done +right after the TITLE statement. + + To ask a specific question, use .TTYMAC, which a sort of macro that reads +its arguments from the terminal. .TTYMAC looks like a macro definition +except that there is no macro name in the define line; just an argument +list, followed of course by the macro body and a TERMIN. Instead of +defining a macro which must be called later with arguments specified +explicitly, .TTYMAC defines a nameless macro which is called immediately, +getting the arguments by reading as many lines as are necessary from the +terminal. *Note TTYMAC: Macros, for more information. Here is an example: + +PRINTX /Value of BAR = / +.TTYMAC FOO +BAR=FOO +TERMIN + +MIDAS Node: Macros, Up:Top, Previous:Terminal, Next:Loops + +MIDAS MACROS + +It is often useful, when the text to be assembled +has some pattern, to cause it to be computed, rather than +putting it all in the file to be assembled. This reduces the number +of possible typos and makes it easy to change all occurrences +of a particular construct. + +To do this, one needs to be able to define a function which will +be evaluated at assembly time, with the result being text to be assembled +in place of the call to the function. Such a function is called a MACRO. + +In this document, "EOL" means either CR or LF; +"open" means "<", "(", "{" or "["; "close" means ">", ")", "}" or "]". +"the EOL or CRLF is thrown away" means that the EOL encountered as +should have been previously described is thrown away, and if the EOL +is a CR and the following character is a LF, the LF is also thrown away. +Thus, either a CR alone, a LF alone, or a crlf may be used, and will be +flushed at that point. + +* Menu: + +* Definitions:: Macro Definitions. +* Calls:: Macro Calls. +* Examples:: Examples of macro definitions and calls. +* Remote:: The "REMOTE MACRO" construction. + +MIDAS Node: Definitions, Up: Macros, Next:Calls + +Macro Definitions + +A function definition must specify the name of the function, the +formal parameters (called DUMMY ARGUMENTS when macros are concerned) +and the expression to be evaluated when the function is +called - or in the case of a macro, the text to be assembled when +the macro is called. + +In MIDAS, a macro definition is introduced by the pseudoop +DEFINE, which should be followed by the macro name. +After that, on the same line, come the names of the dummy +arguments, perhaps followed by a comment. +The text of the macro starts on the next line, and continues +until the DEFINE is matched be a TERMIN. +The character that ends the TERMIN is gobbled up. + +* Menu: + +* Example: Macro Definition Example +* Define:: The Macro Define Line +* Body:: The Macro Body + +MIDAS Node: Macro Definition Example, Up: Definitions + +Macro Definition Example + +DEFINE FOOBR AA,B + MOVE A,AA + CAIL A,B + POPJ P, +TERMIN + +A call to that macro might be: + + FOOBR ZZZ,10 + +which would assemble into + + MOVE A,ZZZ + CAIL A,10 + POPJ P, + +MIDAS Node: Define, Up: Definitions + +THE MACRO DEFINE LINE + +The "DEFINE" line is the first component of a macro definition. +It begins with the "DEFINE" pseudo (which needn't actually be at the +beginning of a line). Next comes the name of the macro to be defined, +optionally preceded by an explicit block name (eg DEFINE FOO"BAR to +define a macro BAR in the block named FOO, rather than in the +current block). After the macro name come the dummy argument names, +followed optionally by a comment. In any case, the define line +extends through the first CRLF or EOL after the DEFINE. + + a. bindclasses - semantics. + +Most higher level languages have several bind classes. The function +definition specifies one of the bind classes for each formal parameter, +which is used in decoding a call to the function, to decide what value to +give to the formal parameter. Macro dummy arguments also have bind +classes, which say three things: +what to do if the dummy is UNSPECIFIED (that is, if, in a particular call, +the argument list runs out before this dummy is reached) or NULLSPECIFIED +(the argument for this dummy is left out), the alternatives being +NULLIFIED, GENSYMMED and DEFAULTED (see *Note UNSPEC:calls-8, for the +meanings of the three options); +which argument syntax to use for the dummy when processing calls to the +macro (There are 6 different argument syntaxes available in MIDAS: NORMAL, +WHOLELINE, BALANCED, STRUNG, KEEPSTRUNG, and EVALUATED. +See *Note SYNTAX:syntax-footnote, for descriptions of them.); +and how the actual arguments are to be associated with the dummies, the +alternatives being by ORDER and by KEYWORD. + + b. bindclasses - syntax. + +In MIDAS, it is not necessary to specify the complete bindclass +of each dummy with that dummy's name. Only the ways in which its +bindclass differs from that of the preceding dummy are specified, +by means of special delimiters between the names of the dummies. +The first dummy is given the default bindclass (nullified normal by order) +unless special delimiters precede it. The delimiters are: + {[(< which cause following dummies to be balanced, + >)]} which cause following dummies to have normal syntax, + * which causes following dummies to be strung, or, if + strung was already the selected syntax, causes them to + be normal (This is called "turning strungness on or off"), + & which turns keepstrungness on or off, + # which turns evaluatedness on or off, + ? which turns balancedness on or off, + - which turns wholelineness on or off, + \ which complements gensymmedness, + + which switches between by order and by keyword, + : which reverts to the default in all ways (normal syntax, + by order (not keyword), and not gensymmed). +"/" is a delimiter which is like "-" except that if it follows +a dummy immediately, wholelineness is complemented before the dummy +rather than after. That is, "FOO/" is equivalent to "-FOO". +This is mainly for compatability with older versions of MIDAS. +A dummy is defaulted iff its name is followed by "=". +The "=" should be followed by the desired default value, +whose syntax is that of a normal macro argument. +Beware: the dummy argument delimiters do not terminate default values, +and default values are read in with the normal argument syntax +regardless of the specified syntax of the dummy being defaulted. +Thus, DEFINE FOO \(A,B=100)C makes B's default value be 100)C, which +is probably not what you wanted. +If a dummy is specified as gensymmed, and is also given an explicit +default value, the explicit default overrides the gensymming. + + c. DEFINE line example. + +DEFINE FOBR \A#B\C:D,+E=BAR,F,G(H,I=X,)*J*+-K + +would give FOBR the dummies A,B,C,D,E,F,G,H,I,J,K as follows: + +dummy bindclass (argument syntax, what to do if unspecified). + the first few dummies are by order: + A normal, gensymmed + B evaluated, gensymmed + C evaluated, nullified + D normal, nullified + the next few dummies are by keyword: + E normal, defaulted to "bar" + F normal, nullified + G normal, nullified + H balanced, nullified + I balanced, defaulted to "X" + (note that the comma after "I=X" is necessary because + the ")" would otherwise be part of the default + value of I. after dummy names not given default values + a comma is not necessary, although an extra one can't hurt.) + J strung, nullified + the next dummy is by order. + K wholeline, nullified + +MIDAS Node: Body, Previous:Define, Up: Definitions + +THE MACRO BODY + +The macro body is the text string to be substituted in place +of a call to the macro. The macro body specified in a macro +definition starts with the first character after the CRLF or EOL +that ends the define line, and continues through the character +before the TERMIN that ends the macro definition. Remember that +the character ending the symbol "TERMIN" is thrown away. + +WARNING: ANY occurrence of "DEFINE" or "TERMIN" inside a macro body +will affect MIDAS's determination of where the body ends. This is +true regardless of whether you intended them to or not. Just because +the "DEFINE" was in a text string or a comment does not change this. +"Terminate" and "Terminal" must also be avoided. If you need to put a +"DEFINE" or "Terminal" into a macro body, use .QUOTE (*Note quote:quote.). +The same holds for any other MIDAS pseudo-ops that require a matching +TERMIN, such as IRP and .TTYMAC. + +* Menu: + +* Parameters:: Dummy Argument Substitution. +* Concatenation:: Concatenation. +* Quote:: The .QUOTE pseudo. +* Inner:: Inner Macro Definitions. +* Stopping:: The .STOP pseudo. +* Jumping:: The .TAG and .GO pseudos. + +MIDAS Node: Parameters, Up: Body, Next: Concatenation + +DUMMY ARGUMENT SUBSTITUTION. + +Whenever the name of one of the dummy arguments appears in the macro +body specified in the definition, it represents a request for the value +of that dummy to be inserted at that point when a macro call +is expanded. Dummy argument names are recognized only when surrounded +by non-squoze characters, so neither of the dummy names "A" and "B" occurs +in the string " AB ", but both occur in " A B ". The way dummy +argument substitution is implemented is that the dummy argument names +are recognized when the macro is defined, and replaced by special +characters. Therefore, if the name of a dummy argument is created by +the expansion of a macro call (perhaps part of the name came from the +substitution of the value of another dummy) that dummy-name will +not be replaced by the dummy's value. In other words, text produced +by substitution for dummy arguments is not rescanned for occurrences +of dummy argument names. + +MIDAS Node: Concatenation, Previous: Parameters, Up: Body, Next: Quote + +CONCATENATION. + +Suppose it is desired to have the substituted value of the dummy +argument FOO followed immediately by the squoze character X. +It will not do to put "FOOX" in the macro body, because "FOO" is +not considered to occur in "FOOX". "FOO X" will cause the value +of FOO to be substituted, but the space will remain between it +and the "X". The way to win is to use the concatenation +character "!". "!" can delimit the names of dummy arguments, as +any other non-squoze character can, but it alone is thrown away after +doing so. For example, "FOO!X" will cause FOO to be recognized, +but followed immediately by an "X". +Similarly, the TERMIN that ends the macro definition must be +preceded by a non-squoze character, which normally becomes part +of the macro definition. If it is desired for the macro definiton +to end with a squoze character, separate it from the TERMIN with +an "!", which will be thrown away. "!"'s that appear in the macro +body not adjacent to a dummy agument name, a .QUOTE, or the final TERMIN +are not thrown away; this makes it possible to put "!"'s in macros. + +MIDAS Node: Quote, Previous: Concatenation, Up: Body, Next: Inner + +.QUOTE + +It is possible to prevent recognition of dummy argument names +in a part of the macro body by using the .QUOTE pseudoop. The +pseudo is followed by a text string like the argument to ASCII et al., +which is not scanned for dummy argument names. The first character +of the text string will follow the character before the "." of the +.QUOTE, and the last character before the closing delimiter will +come before the character after tht delimiter, in the macro as it +will be defined. The .QUOTE, to be recognized, must be +preceded by a non-squoze character, so in order to make it +possible for a quoted string to follow a squoze character, an "!" +before a .QUOTE is deleted. +Not only dummy names, but TERMIN, .QUOTE, and the pseudos +matched by TERMINs (DEFINE, .TTYMAC, and the various flavors of IRP) +are not detected or treated specially when within a .QUOTE . + +MIDAS Node: Inner, Previous: Quote, Up: Body, Next: Stopping + +INNER MACRO DEFINITIONS. + +In order to make it possible to define a macro which will, when +called, define another macro, it is possible to insert matching +DEFINE - TERMIN pairs in a macro definition. A definition is +ended not by the first TERMIN after the DEFINE, but by the first +TERMIN that is unmatched by previous DEFINEs (or other pseudos +such as IRP and .TTYMAC that also expect to be matched by TERMINs). +(DEFINEs, TERMINs, etc. within .QUOTEs are ignored in the matching-up.) +Remember that when the outer macro is called and the inner one is +defined, its TERMIN will gobble up one character. +For that reason, when a macro definition ends with an inner +macro definition or an IRP, "TERMIN TERMIN" should be used, +rather than "TERMIN!TERMIN". If the latter is used, the main +macro will end with "TERMIN", so when it is called the inner +"TERMIN" will gobble an extra character after the call. +Using the space gives the inner TERMIN a character to gobble, +thus protecting all the other characters from being gobbled. + +MIDAS Node: Stopping, Previous: Inner, Up: Body, Next: Jumping + +.STOP + +The .STOP pseudo is used to exit from a macro. +At macro expansion time, when .STOP is executed, the +rest of the macro body will be ignored that time through. +execution will continue with the first character after the macro +call. For example, + + DEFINE FOO A,B + 1 + IFE A,.STOP + 2 + TERMIN + + FOO 1 +; 1 +; 2 ;note the .STOP isn't exectuted. + FOO 0 +; 1 ;and that's all, because of the .STOP. + +Beware of putting a .STOP inside brackets ("[" and "]"). +Because brackets are used for both literals and conditionals, +MIDAS must keep a stack with an entry for each unmatched "[" +saying what is was for. If a .STOP, which is like a jump to +the end of the macro body, is within brackets inside the macro, +then although those bracket pairs will be exited, the bracket +stack will not be updated because the closebrackets will +not be encountered. When a "]" is next seen, MIDAS may +treat it the wrong way (eg, may think it closes a literal +when it was supposed to close a conditional). +The way to win is to use braces +("{" and "}") instead of brackets when conditionalizing +a .STOP. Since braces are not used for anything but +conditionals, there is no need for MIDAS to maintain such +a stack, and thus no data base is invalidated if +the brace depth is changed. +Thus, this macro may cause problems: + + DEFINE FOO A,B + 1 + IFE A,[.STOP ] + 2 + TERMIN + +and this one should be preferred: + + DEFINE FOO A,B + 1 + IFE A,{.STOP } + 2 + TERMIN + +MIDAS Node: Jumping, Previous: Stopping, Up: Body + +.TAG and .GO + +These two pseudos provide arbitrary transfers at macro +expansion time. That is, they do not assemble into jump +instructions; rather, they tell MIDAS to jump around +while expanding the macro. That can cause parts of the +macro to be expanded more than once or not at all. +The way to use them is to put .GO at the place +MIDAS should transfer from, and .TAG at the +place it should transfer to. Thus, .GO FOO will +transfer to a .TAG FOO . Nonlocal transfers are +allowed; if a .GO does not find a matching TAG in the +macro it is in, it will exit that macro and search the macro +which called the macro containing the .GO. Any number +of levels may be popped up this way but popping into a +file will cause lossage. There should be a space after the + in both the .GO and the .TAG to prevent lossage. +Note that .GO and .TAG may be used in REPEAT's and +IRP's just as in macros, and nonlocal .GO's in macros +are allowed to find .TAG's in IRP's and REPEAT's, etc. +Transfering from one level in brackets to another has dangers +associated with it, just as with .STOP - see the detailed +explanation under *Note STOP:Stopping. +For example, + + DEFINE FOO + BAR==5 + .TAG BARF + BAR==BAR-1 + BLETCH + IFN BAR,.GO BARF + TERMIN + +when called, will do BLETCH 5 times +(of course, a REPEAT could have been used in this +case, and would have meant a simpler macro). + +MIDAS Node: Calls, Previous: Definitions, Up: Macros, Next: Examples + +MACRO CALLS. + +A macro call is a request for the body of a macro to be substituted +into the text to be assembled. The call must specify the name of the +macro and the values to be given to the macro's dummy arguments +(if it has any) + +* Menu: + +* Call: calls-1 Macro Call Syntax. +* Normal: calls-2 The "Normal" Argument Syntax. +* Balanced: calls-3 The "Balanced" Argument Syntax. +* Wholeline: calls-4 The "Wholeline" Argument Syntax. +* Strung: calls-5 The "Strung" Argument Syntax. +* Keepstrung: calls-6 The "Keepstrung" Argument Syntax. +* Evaluated: calls-7 The "Evaluated" Argument Syntax. +* Unspecified: calls-8 What Happens To Dummies That Are Unspecified. + +MIDAS Node: Calls-1, Up: Calls, Next: Calls-2 + +MACRO CALL SYNTAX. + +Every macro call begins with name of the macro. In order for +the macro name to be recognized as such, it must be evaluated. +Therefore, macro calls are possible only in those places where +a symbol will be evaluated. (For example, putting the macro's name +in the middle of an ASCII will not cause the macro to be called). + +* Menu: + +* Simple: calls-1a: Macros With No Dummies. +* Degenerate: calls-1b: Degenerate Calls. +* Normal: calls-1c: Normal Calls. +* Parens: calls-1d: Parenthesized Calls. + +MIDAS Node: Calls-1a, Up: Calls-1, Next: Calls-1b + +MACROS WITH NO DUMMIES. + +A call to a macro without dummies consists of just the macro name. +The character that terminates the name is left to be reprocessed after +the text of the macro is processed. + +MIDAS Node: Calls-1b, Previous: Calls-1a, Up: Calls-1, Next: Calls-1c + +DEGENERATE CALLS. + +A degenerate call to a macro with dummies consists of the macro +name followed by an EOL. The EOL or CRLF will be thrown away. +All the dummies of the macro will be unspecified (*Note UNSPEC:calls-8.). + +MIDAS Node: Calls-1c, Previous: Calls-1b, Up: Calls-1, Next: Calls-1d + +NORMAL CALLS. + +A normal call to a macro with dummies follows the macro name with +anything but an EOL or OPEN. The character immediately after the macro +name will be ignored. After it, the scanning for the values of the dummies +will commence. +MIDAS considers "by order" dummies one at a time, in the order +they appeared in the macro definition. Each dummy is given a value +obtained by scanning the text of the macro call according to the +argument syntax determined by the dummy's bindclass (which is +one of normal, balanced and wholeline). +(*Note SYNTAX:syntax-footnote, for descriptions of the argument syntaxes). +When a run of "by keyword" dummies is reached, MIDAS expects to +see in the macro call expressions of the form =. +MIDAS reads the dummy name and checks that the "=" is there; it then +finds the dummy with that name and reads in the using that +dummy's bindclass. When, instead of a dummy name, a terminator +(comma, EOL, semicolon, CLOSE, etc) is seen, all the "by keyword" +dummies in that particular run of them which have not been specified +in the macro call are considered to be unspecified. If there are +by order dummies after the run of by keyword ones, MIDAS then +proceeds to read in their values. If the scan for one dummy detects +the "end of the call" (*Note EOL/SEMI:calls-2d,) then the scan for +all following dummies becomes trivial: they are all unspecified, +regardless of their designated argument syntaxes, and no more +characters will be read from the input stream for any of them. +If a normal call is ended in this fashion by an EOL, +the EOL or CRLF is thrown away. + +MIDAS Node: syntax-footnote, Up: Calls-1c + +MACRO ARGUMENT SYNTAX + +* Menu + +* Normal: calls-2 +* Balanced: calls-3 +* Wholeline: calls-4 +* Strung: calls-5 +* Keepstrung: calls-6 +* Evaluated: calls-7 + +MIDAS Node: Calls-1d, Previous: Calls-1c, Up: Calls-1 + +PARENTHESIZED CALLS. + +In these calls, the macro name is followed by an OPEN. The assignment +of values to dummies procedes as in a normal call. At the end, though, +characters are thrown away until and including a CLOSE that matches the +OPEN. In the matching, parens and brackets within the values of +dummies are not considered. Also, only the number of brackets seen is +remembered - not what kind. There is nothing to stop a "(" from matching +a ">" at this stage. Parenthesized calls are most useful with macros whose +dummies are balanced - then the macro call is guaranteed +to terminate precisely at that closeparen that matches the initial +openparen, regardless of whether enough or too many argumentss +are present in between. Note that where. below, the macro call is said +to be "ended", in a parenthesized call that really means +that scanning for the matching closeparen will begin. + +MIDAS Node: Calls-2, Previous: Calls-1, Up: Calls, Next: Calls-3 + +THE "NORMAL" ARGUMENT SYNTAX. + +MIDAS begins scanning for a normal argument by examining +the first character. + +* Menu: + +* Bracket: calls-2a First Character is "[". +* Slash: calls-2b First Character is "\". +* Comma: calls-2c First Character is ",". +* EOL/SEMI: calls-2d First Character is an EOL or semicolon. +* Otherwise: calls-2e Otherwise. + +MIDAS Node: Calls-2a, Up: Calls-2, Next: Calls-2b + +FIRST CHARACTER IS "[". + +All the text up to the matching "]", not including either of them, is part +of the dummy's value, and the scanning of the next dummy +begins with the character after the "]". +If a normal argument is delimited by squarebrackets, +it is never unspecified or nullspecified, even if the value +between the squarebrackets is the null string. +Thus, when a dummy has a default value, it is possible to specify +the null string explicitly in the call, overriding the default. + +MIDAS Node: Calls-2b, Previous: Calls-2a, Up: Calls-2, Next: Calls-2c + +FIRST CHARACTER IS "\". + +A field is read (leading spaces ignored) +and the field's value, converted to a string using MIDAS's current +radix, is used as the value of the dummy. In this case the scan +of the next argument begins with the character after the field terminator. +Arguments specified in this way are never unspecified or nullspecified. + +MIDAS Node: Calls-2c, Previous: Calls-2b, Up: Calls-2, Next: Calls-2d + +FIRST CHAR IS ",". + +In this case, the dummy is nullspecified (see *Note UNSPEC:calls-8.). +The scan for the next dummy, or the text to be handled after +the macro call if there are no more dummies, starts after the comma. + +MIDAS Node: Calls-2d, Previous: Calls-2c, Up: Calls-2, Next: Calls-2e + +FIRST CHARACTER IS AN EOL OR SEMICOLON. + +This dummy is unspecified (*Note UNSPEC:calls-8,) and so are all +remaining dummies. The scan for the remaining dummies will not +attempt to read any characters. If the terminator was an EOL, +and the call is a normal one, the EOL or CRLF will be thrown away +at the end of macro call processing (*Note NORMAL:calls-1c.). + +MIDAS Node: Calls-2e, Previous: Calls-2d, Up: Calls-2 + +OTHERWISE. + +All text, including the first character, +up to the first comma, semicolon or EOL goes into the argument, +except that tabs and spaces before a semicolon are ignored. +Then, depending on the terminating character, action is taken as +in *Note COMMA:calls-2c, or *Note SEMI/EOL:calls-2d, except that in +neither case is the present dummy nullspecified or unspecified, +since a nonnull value has already been specified for it. + +MIDAS Node: Calls-3, Previous: Calls-2, Up: Calls, Next: Calls-4 + +THE "BALANCED" ARGUMENT SYNTAX. + +When a dummy uses the balanced syntax, MIDAS insists that its +value contain no unbalanced brackets. +That is, while scanning for the end of the argument, MIDAS counts +opens and closes, and will not let anything terminate the argument +when the count is nonzero. Also, unmatched closes will not be allowed +into the argument - they will terminate the argument and the macro +call. When the bracket count is zero - that is, when it is permissible +for the argument to terminate - a comma, semicolon, or EOL will +do it, just as if the dummy used the normal syntax. +That is, unspecification or nullspecification of the present dummy +or the remaining dummies may happen, as described in B.2.c-B.2.e. +Termination by an unmatched close is like termination by an EOL (B.2.d). +For balanced dummies, "[" or "\" as the first character have +no special significance. + +MIDAS Node: Calls-4, Previous: Calls-3, Up: Calls, Next: Calls-5 + +THE "WHOLELINE" ARGUMENT SYNTAX. + +The scan for a wholeline argument stops only when an EOL is +encountered. Thus, the value of a wholeline argument is everything +up to but not including the first eol. While an EOL that +terminates a normal or balanced argument ends the macro call, thus +making all remaining dummies unspecified, the EOL that ends a +wholeline argument does not do so. The EOL or CRLF is thrown away, +and scanning for the next dummy starts on the next line. +A wholeline dummy is never unspecified or nullspecified (except +that it will of course be unspecified if the macro call is terminated +by an EOL ending some previous non-wholeline dummy). + +MIDAS Node: Calls-5, Previous: Calls-4, Up: Calls, Next: Calls-6 + +THE "STRUNG" ARGUMENT SYNTAX. + +A strung argument looks just like the argument to ASCII or SIXBIT: +it is bounded on both sides by an arbitrarily chosen delimiter. +When the argument is scanned, first non-space character is taken +to be the delimiter, and everything up to the second occurrence +of that character is part of the argument's value. Semicolon, +EOL, comma, and closebrackets of various kinds, cannot be used as +the delimiter, because if they are seen when the opening delimiter +is expected they will nullspecify the argument and (except for comma) +end the macro call, as they would in the balanced syntax. The +closing delimiter should be followed by an appropriate argument +terminator such as comma, semicolon, EOL, or a closebracket (but +spaces and tabs may intervene); all except comma end the macro +call, while comma allows more arguments to follow. + +MIDAS Node: Calls-6, Previous: Calls-5, Up: Calls, Next: Calls-7 + +THE "KEEPSTRUNG" ARGUMENT SYNTAX. + +A keepstrung argument is exactly like a strung argument, except that the +delimiters are retained. This is useful for passing on such arguments +to other macros or pseudos, without having to worry about +what delimiters to use, since appropriate ones will be included with +the argument itself. + +MIDAS Node: Calls-7, Previous: Calls-6, Up: Calls, Next: Calls-8 + +THE "EVALUATED" ARGUMENT SYNTAX. + +An evaluated argument is passed by value instead of by name. +When it is time to scan for such an argument, a field is read +in and evaluated, and the value is converted to a string by +expressing it as a number in the current radix. This is exactly +like the treatment of a normal argument whose value starts with +"\", except that the "\" is not present itself in the call +(see *Note SLASH:calls-2b.). + +MIDAS Node: Calls-8, Previous: Calls-7, Up: Calls, + +WHAT HAPPENS TO DUMMIES THAT ARE UNSPECIFIED. + +Whether a dummy is unspecified in a particular +call depends on what came in the call before the place +where the dummy's value should have been, and on the variety of +argument syntax used by the dummy. Similarly, the criterion for +being nullspecified depends on the argument syntax used. However, +the consequences of being unspecified or nullspecified are independent of +the argument syntax used. Instead, they depend on the other part +of the bindclass of the dummy: whether it is to be nullified, +gensymmed, or defaulted to a pre-specified value. + +MIDAS Node: Calls-8a, Up: Calls-8, Next: Calls-8b + +nullified dummies. + +When a dummy defined as nullified is unspecified or nullspecified, +it is given the null string as its value. Most dummies of most macros +used are of bindclass nullified. + +MIDAS Node: Calls-8b, Previous: Calls-8a, Up: Calls-8, Next: Calls-8c + +gensymmed dummies. + +If a gensymmed dummy is unspecified, +its value will be a GENERATED SYMBOL +6 characters long - the first character "G"; the rest, +a number in the current radix whose value equals that of .GSCNT, +which starts out as 0 and is incremented before each gensymming. +Thus, in each call, an unspecified gensymmed dummy +will provide a unique label. +If nullspecified, a gensymmed dummy has the null string as a value. +Gensymmed dummies are treated differently when nullspecified +or unspecified for compatability with old versions of MIDAS. +In fact, the distinction between unspecification and nullspecification +is made only to handle this case. + +MIDAS Node: Calls-8c, Previous: Calls-8b, Up: Calls-8 + +defaulted dummies. + +If a defaulted dummy is nullspecified or unspecified, + its default value will be used as its value in that call. + + +MIDAS Node: Examples, Previous: Calls, Up: Macros, Next: Remote + +EXAMPLES OF MACRO DEFINITIONS AND CALLS. + +* Menu: + +* Normal: Example-1 Normal (Nullified And Defaulted) Arguments. +* Balanced: Example-2 Balanced Arguments. +* Gensymming: Example-3 Gensymming. +* Wholeline: Example-4 Wholeline Arguments. +* Keyword: Example-5 "By Keyword" Dummies. +* Strung: Example-6 Strung And Keepstrung Dummies. +* Evaluated: Example-7 Evaluated Dummies. + +MIDAS Node: Example-1, Up: Examples, Next: Example-2 + +NORMAL (NULLIFIED AND DEFAULTED) ARGUMENTS. + +DEFINE MACRO1 A,B=FOO,C ;3 DUMMIES; SECOND DEFAULTED. + A ? B ? C TERMIN + +MACRO1 1,2,3 +; 1 ? 2 ? 3 + +MACRO1 [FOO,,BAR]2,3 +; FOO,,BAR ? 2 ? 3 + ;Showing how to put commas, etc. in args. + +MACRO1 1,,3 ;2nd arg nullspecified and defaulted. +; 1 ? FOO ? 3 + +MACRO1 1,[]3 ;2nd specified as null, not nullspecified. +; 1 ? ? 3 + +MACRO1 1,2 ;3rd arg unspecified. +; 1 ? 2 ? + +MACRO1 1 ;2nd and 3rd args unspecified; 2nd defaulted. +; 1 ? FOO ? + +MIDAS Node: Example-2, Previous: Example-1, Up: Examples, Next: Example-3 + +BALANCED ARGUMENTS. + +DEFINE MAC2 ?A,B ;2 BALANCED DUMMIES. + A ? B ? BLETCH +TERMIN + +DEFINE MAC2(A,,B,,),, ;another way to define the same macro. + A ? B ? BLETCH +TERMIN + +DEFINE MAC2A A,B ;SIMILAR BUT DUMMIES NOT BALANCED. + A ? B ? BLETCH +TERMIN + +MAC2 , +; ? ? BLETCH + +MAC2A , +; ? BLETCH +; + ;Note that the first dummy was bound to "". + ;The "" wasn't even part of the call. + +MAC2(FOO,-1(P))+1 +; FOO ? -1(P) ? BLETCH+1 + ;A parenthesized call. Note that the closeparen + ;ends the second arg and the macro call, and is thrown away. + +MAC2 FOO,-1(P)+1 +; FOO ? -1(P)+1 ? BLETCH + +DEFINE SQR (X) +<*>TERMIN ;this macro squares its arg. + +1+SQR(2)*3 ;a parenthesized call. +;1+<<2>*<2>>*3 +;note that 1+SQR(2>*3 would have the same effect. + +3*<1+SQR 2>-4 +;3*<1+<<2>*<2>>>-4 + ;Here we have, not a parenthesized call, + ;but an ordinary call within parens. + ;The ">" ends the argument to SQR and is not thrown away. + +MIDAS Node: Example-3, Previous: Example-2, Up: Examples, Next: Example-4 + +GENSYMMING. + +DEFINE GENMAC \FOO,BAR + FOO,,BAR +TERMIN + +GENMAC X+1,Y ;Both args specified nonnull. +; X+1,,Y + +GENMAC X+1,, ;Second arg nullspecified. +; X+1,, ;Nullspecified args are not gensymmed. + +GENMAC X+1 ;Second arg unspecified. +; X+1,,G00001 + +GENMAC X+1 ;Note uniqueness of gensyms. +; X+1,,G00002 + +GENMAC() ;Both args unspecified +; G00003,,G00004 + + +GENMAC(,) ;First arg nullspecified; second, unspecified. +; ,,G00005 + +MIDAS Node: Example-4, Previous: Example-3, Up: Examples, Next: Example-5 + +WHOLELINE ARGUMENTS. + +DEFINE FOOWH A-B ;first arg normal; second, wholeline. + A + B +TERMIN + +FOOWH 1,2,3,4 +; 1 +; 2,3,4 + +FOOWH 1 +; 1 +; + +DEFINE BARWH -A B ;both args wholeline. + A + B +TERMIN + +BARWH 1,2,3 ;note that each arg requires a line. +4,5,6 ;a comment on the line is part of the arg. + ;that is, semicolon isn't special. +; 1,2,3 ;note that each arg requires a line. +; 4,5,6 ;a comment on the line is part of the arg. + +MIDAS Node: Example-5, Previous: Example-4, Up: Examples, Next: Example-6 + +"BY KEYWORD" DUMMIES. + +DEFINE KWDM +A,B,C=FOO,+ ;all three arguments by keyword. + A + B + C +TERMIN + +KWDM B=1, A =2 +; 1 +; 2 +; FOO + +KWDM C=1 +; +; +; 1 + +DEFINE KWD1 A=1,+B=2,C=3,+D=4 ;B and C are by keyword; A and D are by order. + A ? B ? C ? D +TERMIN + +KWD1 100,,200 ;both A and D but neither B nor C specified. +; 100 ? 2 ? 3 ? 200 + +KWD1 10,C=11 ;A and C specified. +; 10 ? 2 ? 11 ? 4 + +KWD1 ,B=20,C=21,,40 ;B, C and D specified; A was nullspecified. +; 1 ? 20 ? 21 ? 40 + +MIDAS Node: Example-6, Previous: Example-5, Up: Examples, Next: Example-7 + +STRUNG AND KEEPSTRUNG DUMMIES. + +DEFINE TYPEZ *STR* ;STR is strung. + OUTUUO [ASCIZ ^@STR +^@]TERMIN ;note ctrl-@ used as delimiter of ASCIZ. + +TYPEZ /UNDEFINED SYMBOL/ +; OUTUUO [ASCIZ ^@UNDEFINED SYMBOL +;^@] + +FOO== ;Here a closebracket follows the string. +;FOO==< OUTUUO [ASCIZ ^@WHY FOO? +;^@]> + +TYPEZ(:MYSTERIOUS ERROR:) ;A parenthesized call, and a strange delimiter. +; OUTUUO [ASCIZ ^@MYSTERIOUS ERROR +;^@] + +DEFINE ASCNT &KSTR& ; KSTR is keepstrung. +.LENGTH KSTR,,[ASCII KSTR]!TERMIN + +OUTUUO [ASCNT "String=^@"] ; Note that delimiters are kept with argument. +;OUTUUO [.LENGTH "String=^@",,[ASCII "String=^@"]] + + +DEFINE 2STRS *A=UGH,B* ;Two strung arguments, one defaulted. + ASCIZ /A,B/ +TERMIN + +2STRS =FOO= ;Call ended after 1st string +; ASCIZ /FOO,/ + +2STRS .FOO.,-BAR- +; ASCIZ /FOO,BAR/ + +2STRS ,/BAR/ ;Here no 1st argument is given +; ASCIZ /UGH,BAR/ + +2STRS //,/BAR/ ;Here an explicit null string is given. +; ASCIZ /,BAR/ + +MIDAS Node: Example-7, Previous: Example-6, Up: Examples + +EVALUATED DUMMIES. + +DEFINE TYPECH #CHAR ;CHAR is evaluated. + MOVEI A,CHAR + PUSHJ P,TYO +TERMIN + +TYPECH 40 ;Print a space. +; MOVEI A,40 +; PUSHJ P,TYO + +TYPECH "; ;Print a semicolon +; MOVEI A,73 ;73 is the value of ";. +; PUSHJ P,TYO ;This would not be possible with normal + ;or balanced syntax, since the ";" would + ;be an argument terminator. + +DEFINE TYPEI (CHAR) ;CHAR balanced instead of evaluated + MOVEI A,CHAR + PUSHJ P,TYO +TERMIN + +TYPECH "0(B) ;Print C(B) as a digit. +; MOVEI A,"0(B) ;This would not work with TYPECH, +; PUSHJ P,TYO ;Since CHAR would evaluate to B,,"0 + ;giving MOVEI A, = MOVEI A,"0. + +MIDAS Node: Remote, Previous: Examples, Up: Macros + +The "REMOTE MACRO" construction. + +It is often desirable to use a macro as if it were a string variable, +appending text to it little by little and then accessing the whole +text as accumulated at some time. A way to do this is as follows: + +;initialization: + + IF1 [DEFINE BNKBLK OP + OP + TERMIN ] ;BNKBLK accumulates text. + + DEFINE BLCODE NEWCFT + BNKBLK [DEFINE BNKBLK OP + OP]NEWCFT + TERMIN + TERMIN ;BLCODE adds its arg to the end of BNKBLK. + +;add some text: + + BLCODE [FOO] ;add FOO. + BLCODE [BAR] ;add BAR (note BLCODE inserts CRLF's, too). + +;assemble what has been accumulated: + + BNKBLK ;which expands into ... +; FOO +; BAR + +In understanding this example, it is necessary to realize that MIDAS +is a string-processing language that just happens to produce binary +output as a side effect. It does not matter whether an expression +appears to be properly nested with the various sorts of syntactic +bracket (such as [-] and DEFINE-TERMIN) because the order the brackets +are processed in may not be the order they appear in - especially +since not all phases of processing look for all types of bracket. +For example, when BLCODE is called, it calls BNKBLK with argument +"DEFINE BNKBLK OPOP". That there is an unmatched DEFINE in that +argument does not matter because DEFINE is not special at macro +call time or macro expansion time. Since BNKBLK substitutes its arg +in, there will be an unmatched DEFINE in the expansion of BNKBLK. +So, when MIDAS expands BNKBLK, it will begin processing the DEFINE, +and it will keep on reading for the new macro definition past the +end of BNKBLK. That is not a problem, because AFTER the call to +BNKBLK, within BLCODE, there is a TERMIN that will make MIDAS +end the new macro definition. The inner DEFINE and TERMIN appear +to match in a simple minded way, which is necessary since otherwise +it would be difficult to define BLCODE containing them, but when +BLCODE is called they actually match up in a much more complicated way. +To get a full understanding of exactly what expands into what, +assemble such a segment of program with the (L) switch. The listing +will show not only macro calls but what they expand into. + +Two other examples using this construct follow. +They use a modification of the remote-macro hack +to accumulate things in the reverse +of the order they are put in. + +;Backwards IRP: to get the backwards version of +;IRP FO,BA,[mumble] +; body!TERMIN +;use +;IRPB FO,BA,[mumble][body] + + DEFINE IRPB X,Y,Z,BODY ;IRP BACKWARDS + DEFINE 1IRPB1 FOO + FOO!TERMIN + DEFINE 2IRPB2 BAR + 1IRPB1 [DEFINE 1IRPB1 FOO + FOO + BAR]TERMIN + TERMIN + IRP X,Y,[Z] + 2IRPB2 [BODY] + TERMIN + 1IRPB1 + TERMIN + +;LISP-style PROGs in MIDAS - use these macros as follows: +; PROG [X,Y,Z] ;X, Y, and Z are the locals. +; body of subroutine +; ENDPROG + + DEFINE PROG VARS + IRP X,,[VARS] + PUSH P,X + TERMIN + DEFINE ENDPROG FOO + FOO + TERMIN + DEFINE 2PROG2 BAR + ENDPROG [DEFINE ENDPROG FOO + FOO + BAR]TERMIN + TERMIN + IRP X,,[VARS] + 2PROG2 [POP P,X] + TERMIN + TERMIN + +MIDAS Node: Loops, Up: Top, Previous: Macros, Next: Cond + +Midas Assembly-time Loops + +Loops are useful for many reasons. One might merely wish to +initialize the contents of a table in a simple pattern. +One might also use a loop in conjuntion with macros, in +all the ways loops are used in other programming languages. +The loops that exist in MIDAS are REPEAT and +the various kinds of IRP. Because MIDAS canned loops +all begin with pseudoops, they will only be recognized and +expanded where a symbol would be evaluated +(not within comments, failing conditionals, macro definitions, +text strings, etc.). + +* Menu: + +* REPEAT: loops-A +* IRP: loops-B +* Particulars: loops-C Particular Types Of IRP. + +Node: loops-A, Up: loops, Next: loops-B + +REPEAT. + +REPEAT is used to assemble a single string (called the REPEAT string) +several times - like a DO in PL-1 or MACLISP. The REPEAT string need +not assemble into the same thing each time, however, because each +assembly of the string may have side effects that alter the action of +the next. + +* Menu: + +* Syntax: loops-A1 Syntax of REPEAT +* Expansion: loops-A2 +* RPCNT: loops-A3 +* STOP: loops-A4 +* ISTOP: loops-A5 +* Jumping: loops-A6 .GO and .TAG inside REPEAT + +Node: loops-A1, Up: loops-A, Next: loops-A2 + +SYNTAX. + +The REPEAT pseudoop should be followed by a field whose +value is the number of times the REPEAT string is to +be repeated. That string follows immediately after the field. +The syntax of the REPEAT string is the same as that +of the string in a conditional. If the first character after +the space or comma that ends the field is a "[", then all +characters up to the matching "]", not including either of the +brackets, make up the string to be repeated. Otherwise, that +first character itself and all characters up to the next EOL +make up the REPEAT string. The EOL or CRLF is +thrown away, and a CRLF is added to the end of the REPEAT +string, in the case that square brackets are not used. + +Node: loops-A2, Previous: loops-A1, Up: loops-A, Next: loops-A3 + +EXPANSION. + +A REPEAT expands by substituting the REPEAT string +into the assembler input stream appropriately many times. For example, + + REPEAT 5, SETZ ? 500 + +is equivalent to + + SETZ ? 500 + SETZ ? 500 + SETZ ? 500 + SETZ ? 500 + SETZ ? 500 + +where the REPEAT string is "SETZ ? 500 ". +Each time through except the last, the last character +of the string will be followed immediately by the first character +of the string. To illustrate, + + 0,,REPEAT 3,[.+1 + 10,,]0 + +expands into + + 0,,.+1 + 10,,.+1 + 10,,.+1 + 10,,0 + +This example also shows that there is no need for the +boundary between one pass through the string and the +next to coincide with any logical +division in the resulting concatenated text (such as a word +or field boundary); the several passes through the string may +all be part of one syllable if they do not contain any syllable +separators! (for example, REPEAT 3,['A] = 'A'A'A = (SIXBIT/AAA/)). + +Node: loops-A3, Previous: loops-A2, Up: loops-A, Next: loops-A4 + +.RPCNT. + +During the expansion of a REPEAT, the symbol .RPCNT +has the value of the number of completed passes through the REPEAT; +that is, it is 0 the first time through, 1 the second, etc. +When nested REPEATs are used, .RPCNT always refers to the innermost REPEAT. +For example, + + REPEAT X,[.RPCNT+]0 is X*/2 for X >= 0. + REPEAT X,[<.RPCNT+1>*]1 is FACTORIAL(X). + +Node: loops-A4, Previous: loops-A3, Up: loops-A, Next: loops-A5 + +.STOP. + +When the pseudoop .STOP is executed in a REPEAT, the +pass through the REPEAT then in progress is ended. .STOP +is like a jump to the label on the END of a DO in PL-1. +The character after the "P" of .STOP is ignored; the next +character asembled will be the first character of the REPEAT +string (if there are more repetitions to go) or the one after +the "]", EOL or CRLF that ended the REPEAT string. +Thus, + + REPEAT 5,[ + FOO + IFE BAR,.STOP + + ] + +is equivalent to (but assembles faster if BAR is 0 than) + + REPEAT 5,[ + FOO + IFN BAR,[ + + ]] + +Note that it currently loses to put .STOP (or .ISTOP) inside a +bracketed conditional within the REPEAT. For details and reasons, +see *Note MACROS:macros. The way to avoid this problem is to use +braces instead of brackets in conditionals that surround .STOP's. +The same applies to .ISTOP, .GO and .TAG. + +Node: loops-A5, Previous: loops-A4, Up: loops-A, Next: loops-A6 + +.ISTOP. + +.ISTOP is like .STOP, but also inhibits all further +repetitions of the REPEAT string. It is like a jump to a +label after the END of a DO in PL-1. The character after +the "P" is ignored; the next character assembled is the one after +the "]", EOL or CRLF that ended the REPEAT string. +For example, + + REPEAT 36.,[ + FOO==.RPCNT + IFN BAR&<1_.RPCNT>,.ISTOP + ] + +sets FOO to the number of trailing zeros in BAR. + +Node: loops-A6, Previous: loops-A5, Up: loops-A + +.GO AND .TAG + +The pseudos .GO and .TAG may be used inside REPEAT's +just as in macros. See *Note JUMPING:jumping. + +Node: loops-B, Previous: loops-A, Up: loops, Next: loops-C + +IRP'S IN GENERAL. + +IRP's in MIDAS are somewhat analogous to MAPCAR +in LISP. In an IRP, a dummy name is supplied and also +a string to repeat (called the IRP BODY) and a string +(called the IRP STRING) to +take substrings from according to a prespecified syntactical +rule which depends on which IRP pseudoop is used. The IRP +body is assembled several times, with the dummy name bound to +successive substrings of the string being IRP'ed over. +For example, + + IRP X,,[1,4,5] + FOO+X ? TERMIN + +expands into + + FOO+1 ? FOO+4 ? FOO+5 + +X is the dummy, "1,4,5" is the IRP string, +"1", "4", and "5" are the substrings, +and "FOO+X ? " is the IRP body. + +Node: loops-B1, Up: loops-B, Next: loops-B2 + +SYNTAX OF IRP'S. + +All kinds of IRP have the same syntax (except that IRPNC is slightly +different). After the pseudoop itself come any number of IRP GROUPS, +which make up the IRP HEADER (most IRP's have only one group) then comes +the IRP body, which is just like a macro body (see *Note BODY:Body.). + +Node: loops-B2, Previous: loops-B1, Up: loops-B, Next: loops-B3 + +IRP GROUPS. + +Each IRP group specifies one repetition to be done. +It contains one string to take substrings from, and two +dummies to put them in. The dummy names come first, and +should be terminated by commas. If one of the dummies +would not be referred to in the IRP body, it may be omitted +from the IRP group, but the comma in its position may not +be omitted (if a comma is missing, MIDAS will sometimes be +able to detect that fact, in which case MIDAS will print an +error message and assume there is no second dummy. However, +a missing comma is not always detectable). The string to take +substrings from comes after the second comma, +and its syntax is that of a normal macro argument, +except that "\" is not special as the first character. +f the first character encountered after the string is read is +a squoze character or a comma, MIDAS assumes that it begins +another group. Otherwise, the group just ended is the last one. +This means that if the string is terminated by a "]" or comma, +the character following determines whether another group follows, +while if the string is ended by an EOL or ";", there are +automatically no more groups. +The EOL or ";", or whatever character follows the comma or "]", +is thrown away. If the next character is a LF, it too is discarded. +A comment following the IRP header will lose. The best possibility is +that it will merely go in the IRP body. The worst is that the ";" +will be one of the characters thrown away and, causing total lossage. +An example of an IRP with several groups is + + IRP X,,[1,2,3]Y,,[4,5] + ASCIZ \X+Y\ + TERMIN + +which expands into + + ASCIZ \1+4\ + ASCIZ \2+5\ + ASCIZ \3+\ + +Node: loops-B3, Previous: loops-B2, Up: loops-B, Next: loops-B4 + +THE IRP BODY. + +The body of an IRP is just like the body of a macro definition. +The dummy arguments mentioned in the IRP header may be used +in the IRP body, representing requests for the corresponding +substrings of the IRP strings to be substituted in. +Concatenation with "!", and .QUOTE, may be used as in +macro definitions. The IRP body is ended by a TERMIN, +just like a macro body. Because of this, the character after +the "N" of the TERMIN wil be discarded. Also for that reason, +IRP's are expected to be matched by TERMIN's within macro +bodies and IRP bodies. For example, in + + DEFINE INSIRP INSN,ADDR + IRP X,,[ADDR] + INSN,ADDR + TERMIN + TERMIN + +the first TERMIN matches the IRP; the second, the DEFINE. +When the DEFINE executes, it increments its counter on seeing +the IRP, and decrements it on seeing the first TERMIN, so the +second TERMIN ends the macro body. A call to INSIRP +expands into a string containing the IRP and the first TERMIN, +which closes the IRP body when the IRP executes. The result is that in + + INSIRP PUSH P,[A,B,C] + +NSN's value is "PUSH P" and ADDR's is "A,B,C". +The macro call expands into + + IRP X,,[A,B,C] + PUSH P,X + TERMIN + +which expands into + + PUSH P,A + PUSH P,B + PUSH P,C + +Node: loops-B4, Previous: loops-B3, Up: loops-B, Next: loops-B5 + +IRP EXPANSION + +An IRP should be thought of as first defining an internal +macro whose body is the IRP body, and whose dummy args are +the dummies mentioned in the IRP header, and then calling that +macro repeatedly with arguments which are substrings +of the IRP strings, chosen according to the rule for +the particular IRP pseudoop that was used. +Each call made to the internal macro constitutes one pass +through the IRP. +When an IRP has several groups, on every pass through the IRP +each group is stepped to its next substring, independently of +the other groups. The expansion of the IRP stops (that is, no +more passes through it are made) only when ALL of the groups +are exhausted (the ends of all the IRP strings have been +reached). + +Node: loops-B5, Previous: loops-B4, Up: loops-B, Next: loops-B6 + +.STOP, .ISTOP, .GO AND .TAG. + +These pseudoops, when executed in an IRP expansion, act the way they +do in REPEAT's. That is, .STOP ends only the current pass of the IRP, +while .ISTOP also prevents any future passes from starting. +See *Note WHOLELINE:Body-4(A.4) and *Note STRUNG:Body-5(A.5). + +Node: loops-B6, Previous: loops-B5, Up: loops-B + +.IRPCNT. + +While an IRP is being expanded, .IRPCNT has the value +of the number of completed passes through the IRP +(0 the first pass, 1 on the next, etc.). When nested +IRP's are used, .IRPCNT refers to the innermost one. Thus, + + IRP AC,,[NIL,A,B,C,D,E,F,G,H,I,J,K,L,M,N,P] + AC==.IRPCNT + TERMIN + +defines all the ACs with the specified names. + +Node: loops-C, Previous: loops-B, Up: loops + +PARTICULAR TYPES OF IRP. + +The previous section described what all the IRP pseudoops +have in common. This section describes the peculiar details +of each IRP pseudoop. The IRP pseudoops differ in how +they divide the IRP strings into substrings, and in how they +choose the values to be given to the two dummies of each group. + +* Menu: + +* C: loops-C1 IRPC (Indefinite Repeat on Characters). +* W: loops-C2 IRPW (Indefinite Repeat on Words). +* S: loops-C3 IRPS (Indefinite Repeat on Syllables). +* IRP: loops-C4 IRP (Indefinite Repeat (on elements)). +* NC: loops-C5 IRPNC (Indefinite Repeat on Characters). +* Example: loops-C6 A Complicated IRP Example. + +Node: loops-C1, Up: loops-C, Next: loops-C2 + +IRPC (INDEFINITE REPEAT ON CHARACTERS). + +IRPC scans the IRP strings a character at a time. +Each time through the IRP body, the first dummy of each group +is set to the next successive character of the group's IRP string, +(or to the null string if the IRP string is exhausted), and +the second dummy is set to the remainder of the IRP string - +the part that follows the character that the first dummy is set to. +For example, in + + IRPC X,Y,[ABCDE]A,B,1234,U,,[+-+-] + ASCIZ /X,Y,A!U!B/ + TERMIN + +the dummies are X and Y in the first group, A and B in +the second, and U in the third (which has no second dummy). +The IRP strings are "ABCDE", "1234", and "+-+-". +The expansion is + + ASCIZ /A,BCDE,1+234/ + ASCIZ /B,CDE,2-34/ + ASCIZ /C,DE,3+4/ + ASCIZ /D,E,4-/ + ASCIZ /E,,/ + +Node: loops-C2, Previous: loops-C1, Up: loops-C, Next: loops-C3 + +IRPW (INDEFINITE REPEAT ON WORDS). + +IRPW takes the IRP strings a line at a time (ignoring null lines). +On each pass, the next nonnull line of every IRP string is used up. +The first dummy of each group is set to the part of the line +up to the first semicolon, and the second dummy is set +to the part that follows the semicolon (or to the +null string if there is no semicolon on the line). +The semicolon, if any, does not become part of either dummy. +Unfortunately there +is no way to tell whether the line contained no semicolon, or there +was only one semicolon and it was the last character - in either case +the second dummy will be null. For example, + + IRPW X,Y,[ + FOO ;BAR + FOO1 ;MUMBLE + ] + [X] ;; Y + TERMIN + +expands into + + [ FOO ] ;; BAR + [ FOO1 ] ;; MUMBLE + +Node: loops-C3, Previous: loops-C2, Up: loops-C, Next: loops-C4 + +IRPS (INDEFINITE REPEAT ON SYLLABLES). + +IRPS attempts to scan the IRP strings a syllable at a time. +However, it is not smart enough to duplicate the actions of the +MIDAS syllable reader perfectly. In actuality, it divides the IRP +string into syllables which are strings of consecutive squoze characters separated +by strings of consecutive nonsquoze characters. On each pass, +the first dummy of each group is set to the next string of +consecutive squoze characters found in the IRP string of the group, +or to the null string if the group's IRP string is exhausted, +and the second dummy is set to the non-squoze character that +terminates the run of squoze characters (or to the null string +if there is none, because the first dummy's value reaches to the +end of the IRP string or the IRP string is exhausted). For example, + + IRPS X,Y,[A+B+C+ D+,E+ ,, &/!,F-G- H-I+] + X==Y!100 + TERMIN + +sets A, B, C, D, E, and I to +100 and F, G, and H to -100. +The extra spaces, commas, and "&/!" in the IRP string do not matter, because +only the first non-squoze character after each syllable becomes the +value of the second dummy Y. Extra CRLF's or + or - signs +could also have been inserted at the same places without effect. + +Node: loops-C4, Previous: loops-C3, Up: loops-C, Next: loops-C5 + +IRP (INDEFINITE REPEAT (ON ELEMENTS)). + +IRP regards the IRP string as a list of elements +separated by commas, and scans the IRP string an element at +a time. An EOL or CRLF will also separate elements but since +null elements are not ignored the CRLF or EOL should be used +instead of a comma, not in addition to one. +Square brackets are also special in the scan of the IRP string. +The actual algorithm used by IRP to find the end of the next +element is that a comma, EOL or CRLF (or the end of the IRP string) +ends the element, and an "[" +is flushed but causes commas and EOLs (and therefore CRLFs) +not to be special until the matching "]", which is flushed. +Note that this resembles but is distinctly different from the +normal macro argument syntax rules. +On each pass through the IRP, the first dummy of each group is set +to the next element in the IRP string of that group, and the second +dummy is set to the rest of the IRP string (starting after the +comma, EOL or CRLF that ended the element). Note that the commas, EOLs and +CRLFs that separate the remaining elements will be present in the second +dummy's value, as will square brackets that are doomed to be flushed when +the elements they are part of are reached by the scan. +For example, + + IRP X,Y,[123 4,56789 + ABCD[EF]GH,[IJ,],K] + ASCIZ /X:Y/ + TERMIN + +expands into + + ASCIZ /123 4:56789 + ABCD[EF]GH,[IJ,],K/ + ASCIZ /56789:ABCD[EF]GH,[IJ,],K/ + ASCIZ /ABCDEFGH:[IJ,],K/ + ASCIZ /IJ,:K/ + ASCIZ /K/ + +Node: loops-C5, Previous: loops-C4, Up: loops-C + +IRPNC (INDEFINITE REPEAT ON CHARACTERS). + +IRPNC is similar to IRPC, but more general. It allows the +characters of the IRP strings to be taken not only one at a time, +but any fixed number at a time. Also, it may be told to +ignore any number of characters at the beginning of each of the IRP +strings, or to limit the number of passes to be made to +a specified maximum value. IRPNC may be used to take an arbitrary +substring of a string, or to index into a string. + +* Menu: + +* Syntax: loops-C5a Syntactic Differences between IRPNC and Other IRP's +* Expansion: loops-C5b Expansion. +* Applications: loops-C5c Applications. + +Node: loops-C5a, Up: loops-C5, Next: loops-C5b + +Syntactic Differences between IRPNC and Other IRP's + +IRPNC's syntax differs from that described in B.1 in that after +the IRPNC pseudoop itself, before the first IRP group, there come +three numeric arguments, terminated by commas. +They specify the number of characters +to ignore at the beginning of each IRP string (to be referred to as +), the number of characters to take from each IRP string per pass +(to be referred to as ), and the maximum number of passes allowed +(to be referred to as

).

may be -1, meaning that the +number of passes is not numerically limited. If

is 0, +the IRPNC is not expanded at all. If is less than 1, it is +defaulted to 1. If is negative, it is defaulted to 0. + +Node: loops-C5b, Previous: loops-C5a, Up: loops-C5, Next: loops-C5c + +Expansion. + +On each pass, the first dummy of each group is set to the next + characters of the group's IRP string (or the whole remainder +of the IRP string if fewer than characters remain). +On the first pass, instead of using the first characters of +the IRP string, which would be like all the other kinds of IRP, + characters are skipped and the next are used. (If the IRP string +contained fewer than characters to begin with, it is considered to +be exhausted starting from the first pass). The second dummy +is set to the remainder of the IRP string, following the characters +forming the first dummy's value, but containing only those +characters that will eventually get into the first dummy. That is, if +the number of passes has been limited, the characters of the IRP +string that will never appear in the first dummy because it +would take too many passes to get that far, will not appear in the +value of the second dummy on any pass. + +Node: loops-C5c, Previous: loops-C5b, Up: loops-C5 + +Applications. + +To take an arbitrary substring of a string, limit the IRPNC to +a single pass. To select characters +FOO through FOO+10 of the dummy name BAR, + + IRPNC FOO,11,1,X,,[BAR] + ;in here, use X to refer to the desired substring + TERMIN + +To convert a SIXBIT value to text, index into a string of all +the SIXBIT characters in order. This IRPNC will +type on the terminal the version number of the program (using .FNAM2). + + REPEAT 6,[ + IFE .FNAM2_<6*.RPCNT>,.ISTOP + ;GIVE UP IF ONLY SPACES REMAIN. + TEMP==77&<.FNAM2_<6*<5-.RPCNT>>> + ;ISOLATE THE NEXT CHAR TO BE TYPED + IRPNC TEMP,1,1,X,,[ !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_] + PRINTX aXa ;NOTE LOWER CASE "a" IS NOT SIXBIT + TERMIN + ] + +To XOR together all the words of an ASCII string, +use this macro: + + DEFINE FOO STRING + < + IRPNC 0,5,-1,BAR,,[STRING] + ASCII /BAR/#TERMIN + >TERMIN + +Node: loops-C6, Previous: loops-C5, Up: loops-C + +A COMPLICATED IRP EXAMPLE + +This shows how to assign several symbols default values (that is, +set them only if they haven't already been set). It allows +each symbol to accompany its value, and either = or == may be +used for each symbol independently. + + IRPW X,,[ + FOO==1 ;mumble + BAR==500 ;bletch + ] + IRPS Y,,[X] + IFNDEF Y,X + .ISTOP + TERMIN TERMIN + +expands into + + IRPS Y,,[ FOO==1 ] + IFNDEF Y, FOO==1 + .ISTOP + TERMIN + IRPS Y,,[ BAR==500 ] + IFNDEF Y, BAR==500 + .ISTOP + TERMIN + +which expands into + + IFNDEF FOO, FOO==1 + IFNDEF BAR, BAR==500 + +Note that the expansion is described as a two-step process only +to make it easier to understand the effects of the various IRP's. +In fact, it all goes on at once, coroutine-style. The flow of +control is approximately: read in the IRPW's arguments, +set up the first pass through the IRPW, encounter the IRPS +and read its arguments (which come out of the IRPW's body), +begin the first pass through the IRPS, perform the IFNDEF, +hit the .ISTOP which exits from the IRPS, preventing further +passes through it, try again to read from the IRPW body, reach +the end of it and then set up for the next pass through the IRPW. + +MIDAS Node: Cond, Up: Top, Previous: Loops, Next: Arithmetic + +Conditional Assembly in MIDAS + +Maybe someday this node will be INFO-ized. + +@. OVERVIEW. + +It is often desirable to decide at assembly time, rather than at +editing time, whether a particular piece of code is to be +assembled. One might wish to assemble different versions of a +program, usually based on the value of some symbol. Also, in +order for arbitrary functions to be expressed by macros, +conditionals are needed. When thinking about MIDAS conditionals, +one should always remember that MIDAS is a string-processing +language which simply happens to output the values of most +expressions evaluated into the binary file. + + +A. CONDITIONALS IN GENERAL. + + 1. SYNTAX OF CONDITIONALS. + +Every MIDAS conditional construct begins with a pseudo which +introduces the condition. This pseudo may require arguments +which are part of the condition - a given conditionalizing +pseudo always requires a particular number of arguments. After +those arguments, if any, comes the text to be conditionalized, +in a format independent of which condition was tested. + + 2. WHERE CONDITIONALS MAY BE USED. + +Because the constructs begin with pseudos, they are only +recognized as such in places where symbols' values are being +examined. Those are exactly the places in which macro calls will +be recognized. explicitly, something that looks like a +conditional but appears inside a macro definition, a text +string, a comment, a macro call, etc. will not be treated as a +conditional but as part of the macro body, text string, comment, +or macro argument, etc. Of course, if the conditional appears +inside a macro definition, when the macro is called the +conditional will be recognized unless there is something else to +stop it. The point is that in + + DEFINE FOO + IFN 0,TERMIN + +the TERMIN shown does end the definition of FOO even though it +is inside what appears to be a failing conditional, because that +conditional is not recognized at macro definition time. The +definition of FOO is "IFN 0,". When the macro FOO is called, it +will expand into a conditional, which WILL be recognized that +time. Thus, + + FOO BAR + +will not assemble the BAR because the BAR will be inside a +failing conditional. + + 3. SYNTAX OF THE CONDITIONALIZED TEXT. + +The conditional pseudo, together with arguments if any, are +usually arranged to end with a field-terminator (SPACE or +COMMA). The first character after that field-terminator is the +beginning of the conditionalized text. The extent of the +conditionalized text is determined in one of three ways, depending +on whether that first character is one of "[" and "{". + + a. one line conditionals. + +If the first character is not "[" or "{", then the +conditionalized text is the rest of the line containing the +conditional. For example, + + IFN X,FOO+BAR + +conditionalizes the string "FOO+BAR" on the value of X. It does +not matter how many "["'s or "]"'s there are in the line. There +may be other conditionals in the line, but it isn't wise to have +any multi-line bracketed ones start in the conditionalized line. + + b. bracketed conditionals. + +If the first character is "[", the conditional is called +"bracketed". In this case, the conditionalized text runs up to +the "]" that matches the "[". The opening "[" and the closing +"]" are ignored except for their function as delimiters of the +conditionalized text. Other "["'s and "]"'s in the +conditionalized text act as normal, as well as being counted to +find the end of the conditional. The conditional may span many +lines, or may be only a part of a line. For example, + + IFN X,[BAR-]FOO + +assembles either FOO or BAR-FOO depending on the value of X. +However, + + IFN X, [BAR-]FOO + +conditionalizes the string " [BAR-]FOO" because the first +character of the conditionalized text is not a "[". + +Note that though when the conditional fails, the brackets inside +the conditional are just those that are visible, since macros, +etc., are not expanded if the condition fails, if the condition +succeeds the expansion of macros may cause other brackets to +appear inside the conditionalized text. If such brackets are +unbalanced, they may cause the opening "[" of the conditional to +match a bracket other than the intended one, which may in +obscure circumstances ruin the assembly. + +If the "]" of a failing bracketed conditional is missing, the +assembly will by a complete loss. In that case, the error +message will say where the beginning of the conditional was +located. If the "]" of a successful bracketed conditional is +missing, no harm results unless a literal was in progress. +However, it means that if in another assembly the same +conditional failed (perhaps due to different parameter +settings), lossage would occur. Therefore, MIDAS prints a +message at the end of the assembly stating that there was +an unterminated successful conditional, and says where the +first one was. Fixing that one and reassembling will cause +MIDAS to find the second one, if there are any more. + +The reason that MIDAS must remember unterminated successful +bracketed conditionals is that a "]" in MIDAS may terminate +a literal or a conditional, and MIDAS has to be able to +decide which whenever a "]" is seen. This means that when +a .STOP, .ISTOP, .GO or .TAG is inside "[" - "]" pairs, +lossage can result because brackets are skipped over, +causing the "[" stack to get out of phase with the position +in the macro or loop. For this reason, bracketed conditionals +should never be used to conditionalize those four pseudos. +Braced conditionals should be used instead. + + c. braced conditionals. + +Braced conditionals look just like bracketed conditionals +except that braces ("{" and "}") are used instead of brackets. +Braced conditionals count ONLY braces when matching up - +brackets have no effect on them. + +Semantically, braced +conditionals are almost the same as bracketed conditionals +but the few differences are important in some situations. +The differences come from the fact that MIDAS does not keep +a stack of all unterminated successful braced conditionals, +whereas for bracketed conditionals it does. MIDAS can get away +without such a stack because braced conditionals cannot be +confused with literals, unlike brackets. This has two +consequences: first, MIDAS cannot warn the user about +unintentionally unterminated successful braced conditionals; +second, intentionally unterminated braced conditionals are +possible. If that boggles your mind, note that in + + IFE X,{.STOP } + +the conditional is unterminated if it is successful. +Also, because brackets do not interfere with braced +conditionals, constructions such as + + IFE X,{ASCII/ + [/} + +are possible. While overall unbalanced brackets are unwise, +it may be reasonable to have such constructions +in parts of a macro which as a whole has balanced brackets. + +There are reasonable constructions which can sometimes +result in unmatched braces/brackets, and for which therefore +only braces should be used. An example is the hack for OR'ing +two condions: + + IFN X,{IFNDEF A,} + +If the IFN succeeds but the IFNDEF fails, the "}" will not +be assembled. If brackets were used, that might cause trouble. + + 4. .SUCCESS, .ALSO, .ELSE. + +After the testing of the condition, when it has been decided +whether the conditional has succeeded or failed, the symbol +.SUCCESS is given a value automatically - 0 if the conditional +failed, and -1 if it suceeded. Also, after the "]" terminating a +bracketed conditional, .SUCCESS is again set to the same value. +The conditionals .ALSO and .ELSE test the symbol .SUCCESS's +value, and may be used to generate IF-THEN-ELSE constructs as +follows: + + IFN X,FOO + .ELSE BAR ;assembles either FOO or BAR. + + IFN X,[ FOO ] + .ELSE [ BAR ] + ;similar, but now it works even if + ;"FOO" is a macro containing conditionals + ;that clobber .SUCCESS. + + IFN X,IFN Y,FOO + .ELSE BAR + ;assembles FOO if both X and Y are nonzero. + ;assembles BAR otherwise + + IFN X,[IFN Y,[FOO]] + .ELSE BAR ;if X=1 and Y=0, assembles nothing. + + IFN X,FOO ;assembles either FOO and MUMBLE, or BAR + .ELSE BAR ;because .ELSE sets .SUCCESS. + .ELSE MUMBLE + + IFN X,FOO + .ALSO BAR ;assembles FOO and BAR, or nothing. + +B. THE CONDITIONS AVAILABLE. + +This section describes all the conditional pseudos in MIDAS and +their conditions and arguments. + + 1. ARITHMETIC CONDITIONALS. + +These conditionals all test the sign of an expression. They are: + + IFN X,FOO ;assemble FOO if X is nonzero + IFG X,FOO ;assemble FOO if X is positive + IFGE X,FOO ;assemble FOO if X is nonnegative + IFL X,FOO ;assemble FOO if X is negative + IFLE X,FOO ;assemble FOO if X is nonpositive + IFE X,FOO ;assemble FOO if X is zero + + 2. STRING CONDITIONALS. + +These take two string arguments and compare them for equality. +IFSE succeeds if the strings are equal; IFSN, if they are not. +The case of alphabetic characters is ignored, so "a" and "A" match. +The syntax of the string arguments is the same as that of normal +macro arguments except that "\" is not special as the first +character. Examples: + + IFSE FOO,BAR,[BLETCH] + ;assembles BLETCH if FOO and BAR are equal + ;strings (which obviously can't be the case + ;unless either FOO or BAR is a macro dummy + ;argument which will be replaced by something). + + IFSE FOO,[BAR][BLETCH] + ;has the same meaning, but now "[]" are used to + ;delimit the second string argument. This makes + ;it possible to win if BAR contains commas or + ;CRLF's. Note that, as with bracketed macro + ;arguments, a comma is not needed after [BAR]. + ;In fact, a comma there would be wrong: + + IFSE FOO,[BAR],[BLETCH] + ;conditionalizes the string ",[BLETCH]", because + ;the first character of the conditionalized text + ;is the comma, so the "[" in front of the + ;"BLETCH" is not recognized. + + IFSE [FOO][BAR][BLETCH] + ;this is just like the first example, but now + ;FOO and BAR may contain commas or CRLF's. + + 3. CONDITIONALS ON SYMBOL DEFINITION. + +These conditionals test whether a specified symbol is defined. +The symbol should follow the conditional name, ended by a +field-terminator, which is followed by the conditionalized text. +The pseudos are IFDEF, which succeeds if the symbol is defined, +and IFNDEF, which has the opposite sense. For example, + + IFNDEF FOO,FOO=1 + ;defines FOO to be 1 if it isn't defined + ;already. it is a good idea to define all the + ;assembly parameters of a program in this way so + ;that it is not necessary to edit the program to + ;assemble it with different settings - instead, + ;just assemble the program with the "T" switch + ;in the command string and then type the desired + ;definitions in from the TTY. + + IFNDEF FOO,.M"FOO=1 + ;if FOO isn't defined, defines it in the main + ;block (the previous example would define it in + ;the current block. + + IFNDEF XX"FOO,XX"FOO=1 + ;if FOO isn't defined in block XX, defines it to + ;be 1. + + IFDEF FOOBAR,PUSHJ P,FOOBAR + .ELSE JFCL + ;call the FOOBAR routine if the user has one. + ;this might appear in a package that is + ;.INSRT'ed by several programs. + ;The .ELSE is needed because on pass 1 it will + ;not in general be known yet whether the user + ;has a FOOBAR routine. + + 4. "BLANKNESS" CONDITIONALS. + +These conditionals take a single string argument, using macro +argument syntax (just like IFSE), and test whether it contains +any SQUOZE characters (letters, digits, and ".", "$", "%"). The +string is "blank" if it has no SQUOZE characters. The +conditionals are IFB "If Blank" and IFNB "If Not Blank". +Examples: + + IFB X,FOO + ;assembles FOO unless X contains a SQUOZE + ;character. Since "X" IS a SQUOZE character, the + ;conditional will always fail unless X is a + ;macro dummy argument. + + IFB [X]FOO + ;has the same semantics, but X may now contain + ;commas, CRLF's, etc. + + 5. SQUOZENESS CONDITIONALS. + +These conditionals are somewhat like the blankness conditionals, +but instead of testing whether any of the characters in the argument +is squoze, they test whether all of the characters are squoze. The +conditionals are IFSQ "If all SQuoze" and IFNSQ "If Not all SQuoze". +Examples: + + DEFINE FOO X + 1+< IFSQ X,[1] > + TERMIN + + FOO BAR ;assembles 2 + FOO BAR BLETCH ;assembles 1 + + 6. PASS CONDITIONALS. + +These two conditionals allow different things to be assembled on +pass 1 and pass 2. IF1 succeeds only on pass 1, and IF2 only on +pass 2. Note that the conditionalized text starts with the +character after the space or comma that ends the name of the +pseudo. One use is to avoid defining macros on pass 2: if a +macro is never to be redefined, there is no need to define it on +pass 2, because it already has the correct definition, given to +it on pass 1. Thus, + + IF1 [ DEFINE FOO + .... + TERMIN ] + +Another use might be: have a macro to make entries in the FOO +table. On pass 1, simply have the macro count up the number of +times it is called. Then, at the end of the file, allocate +enough words for the table. From then on, the address of the +table is known, so on pass 2 the macro can actually assemble +values into the words of the table. +Caution is needed when using pass conditionals, because, by +assembling more words on one pass than on the other, it is easy +to cause all the labels in the rest of the program to yield +"MDT" errors, because their addresses on pass 2 are not the same +as they were on pass 1. Also, one should avoid using any literals +on pass 2 that were not used on pass 1 (but doing the opposite +can't do worse than make the constants area waste some space). + + 7. .ELSE AND .ALSO. + +.ELSE and .ALSO exist to make a generalized IF-THEN-ELSE +construction possible. They act just like "IFE .SUCCESS" and +"IFN .SUCCESS" respectively. The conditionalized text starts +after the space or comma that terminates the pseudo itself. See +section A.4. for more details. + +MIDAS Node: Arithmetic, Up: Top, Previous: Cond, Next: FASL + +The arithmetic-statement pseudo-ops: .I and .F + B.K.P. Horn + + This is a feature of MIDAS which facilitates the rapid writing + and debugging of programs involving much nmerical calculation. + The statements used are ALGOL-like and easy to interpret. + +[ Note: This was originally written as AI Memo #179, Aug 1969, and +has been copied into this file with as much versimilitude as possible] +--------------------------------------------------------------------------- + +An arithmetic-statement expander: + +Since the Incompatible Timesharing System (ITS) does not support an ALGOL +style compiler, it is very tedious to perform even the simplest algorithms +of numerical analysis. To alleviate this problem without an inordinate +amount of effort, two pseudo-ops were added to MIDAS (the macro-assembly +language). + +The pseudo-ops are .F and .I. The first of these will have the arithmetic +in the arithmetic statement following it performed in floating point, +the latter in fixed point. + +Each statement is treated without reference to any of the others. Spaces +may apear in a statement almost everywhere and are ignored. Exceptions are +in the continue part of a continuation statement and in a subscript. (see later +on) + +Arithmetic statements are combinations of variable names, numbers, function +names and operators. Normally each statement specifies the calculation of +one or more values and where they are to be stored. + +The operators are: + = ( ) < > ^ / * + - # $ , + +A number is a character-string starting with a numberic character (0, 1 ... 9) +followed by non-operators. This number should make sense to MIDAS. The +operator ^ is permitted to appear in the number, being the separator used +in MIDAS for the exponent of a number. + +A variable (or function) name is a character-string starting with a character +which is neither numeric nor a operator and consists of up to six non- +operators. + +/ * + - have the usual meaning of divide, multiply, add and subtract. ^ is +used for exponentiation. ( and ) are used to force the precedence as usual, +ie normal evalutaion proceeds from left to right, with exponentiation +being performed first, then multiplications and divisions, and additions and +subtractions last, except that expressions in parentheses are evaluated first. +This is strictly adhered to and thus A^B^C = (A^B)^C unlike the FORTRAN +convention A**B**C = A**(B**C). Nested pairs of parentheses are evaluated from +the inside out. + +Intermediate results are kept in a stack which has to be in the accumulators +and is defined by the user. These accumulators are called A0, A1, ... A9. +If fixed point arithmetic is used, Ai must not be = Aj+1 if i surround the arguments of a function. The arguments are separated by +commas. Thus a name as defined above is a function name if it is followed by +a <. For example: + + MAX and RANDOM<> + +If used not directly following a name, < and > act exactly like ( and ). + +Functions return a single value in A0. The assembled code includes a PUSHJ P, +to the function, the user being responsible for providing a subroutine which +accepts the arguments as presented in A0, A1, etc., does not disturb any +accumulators other than those in which the arguments were passed and returns +the result in A0 before executing a POPJ P, . + +A variable name followed directly by a ( is considered to be a vector. The +subscript between the ( and the matching ) can be of the following form: + + ACxNUM + xNUM+AC where "x" is either "+" or "-". + +Where AC is the variable name of an accumulator in which the subscript is +assumed to have been loaded. NUM is a number, acting as a displacement. + += indicates that the value available at this point (as calculated by the +portion of the arithmetic statement to he right) is to be stored as the +value of the variable name to its left. More than one = may thus appear +in one arithmetic statement. Fo example: + +.F A=B=ARM-LOSS=FOO*BARF + +This invokes the multiplication of FOO by BARF, storage of the result in LOSS. +Next LOSS is subtracted from ARM and the result stored in both A and B. More +complicated constructs are possible by making use of parentheses. Some care +is required in arranging the right sequence of storage operations so as not +to overwrite values needed further on. (perhaps a more intuitive structure +could be given to multiple equals if one did not adopt the FORTRAN like +convention of having the statement follow the equals). + += permits the passing of arguments by name rather than value, ie it performs +a quoting action. This is particularly useful for subroutines operating on +vectors (dotproduct for example), or subroutines executed for their effect +rather than their value. It also permits the passing of a function address +as a argument. This is achieved by surrounding the variable name with [ and ]. + +$ indicates a continuation and must be directly followed by a carriage-return +and linefeed (usually supplied by TECO anyway) and either .I or .F +(which is ignored), a space or tab and the continuation of the statement. +For example: + +.F ZANSWER=273.0/T $ +.F -IN*VEST*MENT + +Unitary + and * are ignored. Unitary / and - are interpreted as 1.0/ and 0.0- +respectively. = and ^ may not appear unitarily. + +Since @ and ' may be part of a variable name, one can make full use of MIDAS's +indirect addressing and automatic variable storage assignment conventions. The +use of @ comes in very handy when working with multi-dimensional arrays +addressed through margin-arrays. + +^ normally generates a call to a function called EXPLOG, which gets two +arguments. To facilitate generation of fast inline exponentiation one may +follow the ^ directly by the single digits 1, 2, 3, or 4. For example: + +.F R=SQRT + +MIDAS Node: FASL, Up: Top, Previous: Arithmetic, Next: Blocks + +Assembling Files to be Loaded by MacLisp + + Midas can now assemble FASL files that can be loaded +by LISP in the same manner as LAP FASL output. This mode is +entered by the .FASL pseudo op, which must appear at the +beginning of the file before any storage words. + After .FASL has been seen, the assembly becomes a +two pass relocatable assembly. However, certain +restrictions and "changes of interpretation" apply. + Global symbols (declared as usual with " or .GLOBAL) +are persmissible. However, since the output is to be loaded +with FASLOAD using DDT's symbol table instead of STINK, +there are quite a few differences in detail. + For symbols defined within the current assembly, the +only effect of being declared GLOBAL is that the GLOBAL +information is passed on to FASL when the symbol table is +written at the end of pass 2. This in combination with the +SYMBOLS switch in FASLOAD determines whether the symbol gets +loaded into DDT's symbol table. If SYMBOLS is NIL, no +symbols will be loaded; if SYMBOLS is EQ to SYMBOLS, only +globals will be loaded; and if SYMBOLS is T, all symbols +(local and global) will be loaded. Once the symbol is +loaded (or not), the information as to its GLOBALness is +lost and, of course, makes no further difference. The +initial state when LISP is loaded is NIL. + GLOBAL symbols not defined in the current assembly +are also legal, but there are additional restrictions as to +where in a storage word they may appear and what masking may +be specified (as compared to a normal relocatable assembly). +Briefly, they may appear as in a storage word as a full +word, a right half, a left half, or an accumulator. They may +be negated, but can not be operated on with any other +operator. Error printouts will be produced if they appear +elsewhere. When the symbol is encountered by FASLOAD, DDT's +symbol table is consulted. If it is defined at that time, +OK, otherwise FASLOAD will generate an error. + Any sort of global parameter assignment or location +assignment is Forbidden. .LOP, .LVAL1, .LVAL2, etc are not +available. + + +New Pseudo OPs Available only in FASL assemblies. + + The following pseudos are available to facilitate +the communication between MIDAS assembled programs and LISP +(particularily with regard to list structure). + +.ENTRY function type args + + Function is an atom and is taken as the name of + a function beginning at the current location. Type + should be one of SUBR, FSUBR or LSUBR, and has the + obvious interpretation. Args is a numeric-valued field + which is passed thru to FASLOAD and used to construct + the args property of the function. If it is zero, no + args property is created. Otherwise it is considered to + be a halfword divided into two 9 bit bytes, each of + which is converted as follows: + byte result + 0 nil + 777 777 + otherwise n n-1 + These two items are then CONSed and from the + args property. + +The following pseudos may appear in constants!! + +.ATOM atom + + followed by a LISP atom in "MIDAS" format (see below). + May only appear in right half (or entire word) of a + storage word. Assembles into a pointer to the atom + header of the specified atom. + +.SPECI atom + + similar to .ATOM but assembles into a pointer to the + SPECIAL value cell of the specified atom. + +.FUNCT atom + + similar to .ATOM, but invokes special action by FASLOAD + in case the PURESW is on. Normally used in function + calls. Briefly, if FASLOAD is going to purify the + function it is loading, it must "snap the links" first. + If .FUNCT is used, the location will be examined by + FASLOAD and the link snapped if possible before + purification. + Typical usage: + CALL 2,.FUNCT EQUAL ;calls equal as a function of 2 args + ; note: the CALL is not defined + ; or treated specially by MIDAS. + +.ARRAY atom + + similar to .ATOM, but assembles into a pointer to the + Array SAR. + +.SX S-expression + + similar to .ATOM, but handles a LISP S-expression. + (See below). + +.SXEVA S-expression + + reads S expression. This S expression is EVALed (for + effect presumably) at FASLOAD time. The resulting + value is thrown away. Does not form part of storage + word. + +.SXE S-expression + + Similar to .SX but list is EVALed at FASLOAD time. The + resulting value is assembled into storage word. + + +The MIDAS "LISP READER" + + By a conspiracy between MIDAS and FASLOAD, a version +of the LISP reader is available. However, due to historical +reasons (mostly, i.e. the FASLOAD format was originally +intended only to deal with COMPLR type output), there are a +number of "glitches" (see below for list). These will +probably tend to go away in the fullness of time. + +a) numeric ATOM + + The first character of a LISP atom is examined +specially. If it is a # or &, the atom is declared to be +numeric and either fixed (#) or floating (&). Midas then +proceeds to input a normal numberic field (terminated, note, +by either space or comma). This value is then "stored" in +the appropriate "space" (fixnum space or flonum space). + +b) other ATOMs (also known as PNAME atoms or (LISP) SYMBOLS) + + If the first character of the atom is not # or &, +the atom is a "PNAME" atom. / becomes a single character +quote character as in LISP. The atom may be indefinitely +long. The atom will be terminated by an unquoted space, +carrige return, tab, (, ), or semicolon. Unquoted linefeeds +are ignored and do not become part of the atom. The +character that terminates the atom is "used up" unless it is +a ( or ). Note that period is a legal constituent of a atom +and does not terminate it or act specially. + +c) lists. + + Work normally, but note following caution relative +to dot notation: . does not terminate atoms. Thus, to +invoke dot notation, the dot must be left delimited by a +space, tab, parenthesis, or other character that does +terminate atoms. + +Glitches: + + 1) Restriction on pass dependant list + structure -- In any list reading operation, no new + atoms not previously encountered may be + encountered for the first time on pass 2. + However, this restriction does not apply to + atom-only reading operations (.ATOM, .SPECI, + .FUNCT etc). + 2) Single quote for quoting does not exist (no + other macro characters exist either.) + 3) Numbers must be flagged as above always. + MOVEI A,.ATOM 123 ;LOSES - gives pointer + ; to PNAME type atom + ; with PNAME 123. it is + ; not numeric. + use: + MOVEI A,.ATOM #123 ;WINS + 4) No provision exists to reference "GLOBALSYMS" + in FASLOAD. This mostly means only that DDT must + be present to load a MIDAS assembled FASL file. + (some simple COMPLR and LAP FASL files can + successfully be FASLOADed by, for example, a + disowned LISP running without a DDT. + 5) LOC is illegal in a FASL assembly. BLOCK of a + non-relocatable quantity is ok. + 6) Currently, symbol loading is VERY slow. Thus + use SYMBOLS nil, (the initial state) unless + symbols are necessary. + 7) Midas does not know about any LISP symbols or + UUOs specially. Use them as globals until someone + gets around to fixing up a .INSRT file with the + appropriate defs. + 8) .ATOM "should" be a special case of .SX . + However, it is handled separately because of the + following "reasons": + a) The previously noted restriction on pass + dependent LISTS. + b) Midas can do constants optimization on + atoms ppearing in constants (on both pass one + and pass two) but not on LISTS. Therefore, + each list is guaranteed to take a separate + word in the constants area even if it is + identical to some other list which also + appears in a constant. + c) Each list takes an additional entry in + FASLOAD's "atom" table. This is a temporary + table that is flushed after the FASLOADing is + complete. Of course, .SX still works for + atoms modulo the above noted restrictions and + inefficencies. + +MIDAS Node: Blocks, Up: Top, Previous: FASL, Next: Constructs + +Symbol Table Block Structure + + The MIDAS symbol table allows blocks of code to be defined within +which local definitions of symbols can be made. Local definitions are +normally visible within the blocks they belong to, including other smaller +blocks included in them, but are normally invisible outside. However, it +is possible to examine or set the local value of any symbol in any block +explicitly, whether inside the block or outside it. The intended +application of block structure is for libraries that are to be assembled +into other programs with .INSRT. Because there is a natural tendency to +use block structure in assemblers for purposes that do not merit it, any +temptation to use block structure for any other reason should be +entertained only with great self-restraint. + + A block is entered with a .BEGIN and exited with a .END. Both the +.BEGIN and the .END should be followed by the name of the block. It is +not usually wise for two blocks to have the same name, although it is legal +if the two are contained in different blocks. .BEGINs and .ENDs must +match. .BEGINs and .ENDs serve as a sort of parentheses, and impose a tree +structure on all blocks, so that each block has a direct superior and any +number of direct inferiors. Initially, even if you never use .BEGIN and +.END, there are two blocks in the structure: .INIT, which contains the +predefined MIDAS symbols, and .MAIN, which is the one which your program is +in. .MAIN is a subblock of .INIT, and any other blocks you .BEGIN are +direct or indirect inferiors of .MAIN. .END should not be confused with +END, which ends the whole assembly. Block names do not conflict with any +other kinds of names. + + A simple example of block structure will explain much: + + A=1 + A ;Value of A is now 1. + .BEGIN FOO ;Enter a block named FOO. + A ;Value of A is 1 on pass 1, but 2 on pass 2. + A=2 + A ;Value of A is now 2. + .END FOO ;Exit block FOO. Now back in main block. + A ;Value of A is now 1 again. + END + +This program will assemble four words: 1, 2, 2 and 1. This is because, on +pass 2, the local definition of A in block FOO becomes visible as soon as +the .BEGIN FOO is passed, and ceases to be visible when the .END FOO is +passed. The definition of A as 1 in the main block is always visible, +except that within FOO it is "shadowed" by a more local one. + + Whenever a symbol's value is used, the most local definition which +is visible determines the value. That is, within block FOO, where both the +local definition in FOO and the definition in the main block are visible, +the more local one (in FOO) wins out. When a symbol is defined, however, +it is always defined in the current block unless you specify otherwise. +All operations that affect the symbol's value in any way are counted as +definitions in this regard; this includes such things as .HKILL, .KILL, +EQUALS, DEFINE, :, and =. + + When you wish explicit control of shadowing, you can use .BIND. +.BIND is followed by a list of symbols, and forcibly markes them as local +to the current block, if they were not already defined locally therein. +Definitions in outer blocks are hidden by this, so that a symbol defined +outside the current block can become undefined inside it, after a .BIND, +until a definition in that block is seen. .BIND can be used to force +shadowing of some predefined symbols which it is normally an error to +shadow. + + One use of .BIND is to force forward references in a one pass +assembly to a symbol defined in an outer block which is going to be defined +locally in the current block later on. One pass assemblies and block +structure are a can of worms anyway. Normally, a symbol defined in an +outer block is NOT visible in lower blocks, unless it is a macro or pseudo, +or you mention it in a .DOWN statement. If it is a macro, and you don't +want to see it in an inner block, you must .BIND it. + + The distinctive feature of MIDAS block structure is the ability to +look at or set the definition of any symbol in any block at any time. This +makes it possible for a block to define symbols in its containing block, or +in the main block (a practice whose wisdom is currently a subject of +debate). It also allows an outer block to define and refer to symbols in +an inner block, which is the main way of communicating with .INSRTed +libraries, and is essential. + + The way to refer to a symbol in a specific block is to prefix the +symbol's name with the block name and a doublequote. Thus, FOO"BAR means +the value of BAR in block FOO. This construct can be used wherever a +symbol name can appear, in both references and definitions. If there is or +might be more than one block named FOO, it can be qualified by the name of +the containing block, as in UGH"FOO"BAR, which means the value of BAR in +that block named FOO which is directy inside a block named UGH. In +addition, there are a few special "block names": .C signifies the current +block, and .U signifies the direct superior of the current or specified +block. Thus, .U"BAR means the value of BAR in the block containing the +current one. FOO".U"BAR means the value of BAR in the direct superior of +the block FOO. .U"FOO"BAR means the value of BAR in the block FOO which is +a sibling of the current one (that is, it and the current one have the same +direct superior). + +MIDAS Node: Constructs, Up: Top, Previous: Blocks, Next: Pseudos + +MIDAS constructs, in alphabetical order: + +! is the concatenation character inside macro definitions, + IRP bodies, and .TTYMAC's. An ! next to either a dummy name + or the final TERMIN will be thrown away. For example, + inside DEFINE FOO A,B, A!!B will concatenate A's value and B's, + as will just A!B. A!!!B will leave one ! between them (the + middle ! is not adjacent to either A or B). That may be what + you want to do if you are expanding an inner macro definition + and A or B wil expand into one of that definition's dummies. + +" has four constructs: + + " + makes the global, as well as referring + to the 's value. + " + refers to the value of in the specified + block. Also, .C refers to the current block, + .M to the main block, and .U to the block containing + the current one. Multiple use of this construct is + allowed: FOO".U"BAR"BLETCH refers to BLETCH + in the block named BAR which is contained in the + block which is the father of the block FOO. + " + assembles right-justified ASCII for . + contains at least one character in any case, + and all following squoze characters. + This construct exists only if .QMTCH is zero + (as it initially is); otherwise, the next construct + exists instead: + "" + assembles right-justified ASCII for . + may contain anything; doublequotes may be + put in using the PL/1 quoting convention + ("""" gives the ASCII for a doublequote). + +# XOR operator. + + # gives the XOR of and . + # gives the complement of . + ## therefore gives "neither nor ". + +& AND operator. + +' has several constructs, syntactically distinguished. + + ' + makes a variable; like + < .SCALAR ? > + This construction is a bad one because it makes + it easy to assign a storage word without commenting + what its contents will mean. It exists for historical + reasons. + + ' + forces the use of base 8 in the number, regardless + of the current radix. + + ' + like ", but generates SIXBIT instead of ASCII. + + '' + like "", but generates SIXBIT instead of ASCII. + +(,) () has the value of with its halves + swapped, if preceded by an arithmetic operator. + Otherwise, it takes that halves-swapped value and adds it into + the current word, and is invisible to its neighbors. + For example, 1(2)+3 == 1+3(2) == 4(2), and all are the same as + 4 except that 2 is added to the left half of the current word. + +* Multiplication operator. + ++ Addition operator. + +, Field terminator. It is used for separating the fields of a word, + and also terminates the arguments to many pseudos and macros. + +- Subtraction operator, and unary negation operator. + +/ Division operator. + +: indicates a label. + + : + defined to be equal to the current value of ".", + which is equal to the location being loaded into + plus the offset (normally 0, but see .OFFSET). + There may not be any spaces before the colon. + Once a symbol has been defined as a label, it is an error + to give it a different value in any way. + :: + is similar but "half-kills" , so DDT will not + use it for type-out. + +; begins a comment, which is ended by the following carriage return. + That carriage return is not gobbled; it has its normal effect. + ";", like all other MIDAS constructs, is not recognized inside + of text strings; also, it is recognized in macro argument scanning + only in certain specific situations (see MACROS >). + +<,> in MIDAS are like parentheses in algebra. + They for a "grouping" (other groupings are made by (,) and [,]). + They are generalized to allow more than one expression to be + within them; the last one's value is the value of the grouping. + This makes it possible to do assignments, etc. before computing + the ultimate value. + += is the assignment operator. + + = + sets 's value to 's. + If there are undefined symbols in the + assignment is not performed. + This construct is illegal where a value is needed, + but if it is the last thing in a grouping it does + supply the value of the grouping. Thus, + FOO= is legal, though FOO=BAR=1 is not. + == + is similar but half-kills + =: + is like "=" but makes it an error if ever + gets (or previously had) a different value (this is + what labels do; =:. is just like :). + ==: + makes half-killed and unredefinable. + +? separates words. ? is just as good as a carriage-return + for most purposes, the exceptions being termination of + macro arguments and conditionals (? does not terminate them). + That facilitates constructs like + IFN FOO, MOVE A,B ? JRST BAR + which conditionalizes both instructions. + +@ sets the indirect bit of the word it is in. + +[,] delimit a literal. Their value is the address of the space + MIDAS allocates to contain whatever is assembled inside them. + There may be any number of lines or words in the literal. + Example: MOVEI A,[.BYTE 7 ? ^M ? ^J] + loads A with the address of a word containing the ASCII + for carriage-return linefeed. + +\ Inclusive-or operator. + +^ has several constructs: + + ^ + has the value of the control-character associated + with . Thus, ^M is 15 . + + ^ + + multiplies by 's own radix to the + power. Thus, 1.^6 is 1 million. + 777^11 is the op-code field. + This construct works for floating point numbers as well: + 1.0^6 = 1000000.0 . + +_ left-shift operator. + NOTE: this is an arithmetical, not logical, shift! + +MIDAS Node: Pseudos, Up: Top, Previous: Constructs, Next: Outformats + +Alphabetical list of MIDAS pseudo-ops + +$. Location being loaded into. Works only via STINK. +$L. REAL LOCATION (WITHOUT OFFSET) (only in STINK format) +$O. GLOBAL OFFSET (only in STINK format) +$R. The relocation factor (only in STINK format) +. = address of current code word. In a literal, . refers + to the location of the word containing the literal, not the + word in the literal. + The offset is included in the value of .. +.1STWD put before a text-generating pseudo (SIXBIT, ASCII, + ASCIZ, ASCIC, .ASCII) to throw away all but the first + word of text. +.ABSP , + returns the "absolute part" of . +.ALSO conditional: "If the previous conditional succeeded". + (See *Note Cond: Cond, for conditional info) +.AOP is like .OP, but returns no value. However, all the + information is still available in .AVAL1 and .AVAL2. +.ARRAY reference a lisp array (.FASL feature) +.ASCII /text/ + Like ASCIZ, but when the character "!" is encountered in the + text, the following it is evaluated and the value + inserted into the assembled string as a sequence of digits in + the current radix, replacing the "!" and the expression. + Terminate with a space or comma, which unfortunately will become + part of the assembled string. +.ASCVL / + (Yes, only one "/") returns the ascii value of . +.ASKIP -1 if instruction executed by most recent .OP or .AOP + skipped; 0 if it didn't skip. +.ATOM + refer to header of named LISP atom (see *Note Fasl: Fasl.) +.AUXIL does nothing - it exists for the sake of the listing program "@". +.AVAL1 What was left in the ac by the instruction executed by + the most recent .OP or .AOP +.AVAL2 What was left in the memory location by the .OP or .AOP. +.BEGIN + begin a symbol-scope block. defaults to + most recent label. +.BIND ,... + Create bindings for these symbols in the current block. + Must be used when it is desired to shadow a built-in + symbol under certain circumstances. Also sometimes needed + in 1-pass assemblies when symbol is defined in higher block + and will be defined later in current block, to force a + forward reference to be made. +.BM , + returns a mask to the byte pointed to by the specified + byte pointer (address field ignored). If arg's LH is 0, + the arg will be swapped first to get a byte pointer. + The comma is thrown away except for ending the arg. +.BP , + returns a byte pointer to the byte which the argument is + a mask to. The address field of the value is 0. The comma + which terminates the argument is not flushed, so that + .BP , will produce a byte pointer to in + location . For those who understand .FORMAT, that + contrives to use the format field-space-field rather than + the problematic field-comma-field format, which many users + like to redefine. +.BYTC The number of bytes assembled since .BYTE mode was entered. +.BYTE N assemble N bit bytes. That is, take the assembled "words" + and pack them into N-bit bytes to get what is really output. + When another byte won't fit in the current word, the word is + output and a new one is started. +.BYTE M,N,O,P,... + assemble an M bit byte, then an N bit one, then an O bit one, etc., + returning to an M bit one after using the last of the specified sizes. + If a negative "byte size" is specified, it causes a block of zero bits + to be assembled right after the previous byte; the number of zero bits + is the abs. value of the specified number. This can cause an extra + zero word to be assembled if .byte mode is left right away. + In byte mode, "." is a byte pointer which could be ILDB'd to get + the next byte. +.BYTE with no arg leaves byte mode, returning to the initial state. +.C Current block (as in .C"FOO). +.CRFIL +.CRFOFF CREF off +.CRFON CREF on +.CURLN current line number minus 1 +.CURPG current page number minus 1 +.DECREL selects DEC relocatable output format +.DECSAV selects DEC/TNX SAV output format. Symbols are deposited + where the location counter points when END is reached, + and location 116 (.JBSYM) given a pointer to them. + Location 120 (.JBSA) is given the start address unless + the instruction furnished to the END pseudo has something + in the LH, in which case it is treated as an entry vector pointer + (only meaningful on TNX systems). +.DECTW + Two-segment DEC relocatable output format. + Arg is address of bottom of high segment (normally 400000). +.DECTXT /text/ + Like .TEXT in MACRO. .DECREL format only, outputs an ASCIZ REL + block consisting of the given text, which LINK interprets as a + command string. +.DOWN ,... + Causes the symbols to be visible in subblocks in 1PASS mode. + In 2-pass assemblies, symbols are always visible in subblocks + of the blocks they are defined in. In 1PASS mode, they are + usually not (except for macros), in case the same name is + defined later on in the subblock itself. +.DPB ,,, + deposits into the byte in specified by , + and returns the result. Thus, .DPB 0,30300,-1, returns -1,,777707 +.ELDC End a load-time conditional - STINK format only. + Any storage words appearing between a load-time conditional (e.g. + .LIFS, .LIFE, etc) and its matching .ELDC are passed on to the + loader, which will load them only if the conditional is true at + the time it is encountered during loading. .ELDC should always + be followed by a location assignment (eg LOC pseudo). Sometimes + if there is a series of load-time conditionals with no intervening + non-conditional words the LOC need only be used after the last. + Notice that LOC $." may be used to continue loading storage words + into subsequent locations where the effect of the load-time conditional + is not necessarily known. Load-time conditionals may be nested. +.ELSE conditional: "If the previous conditional failed". (*Note Cond:Cond.) +.END + terminate symbol-scope block, if its name is . Error + if the current block's name isn't . +.ENTRY .FASL feature - declare a LISP entry point (SUBR beginning, etc). +.ERR + Causes an error with error message +.ERRCNT Number of errors seen in entire assembly thus far. +.F floating mode Fortran arithmetic statement. + *Note .F: Arithmetic, for details. +.FASL Selects FASL output format, loadable by MACLISP. +.FATAL + Causes a fatal error with as the error code. + The output buffers are written out and the output files + are closed, though only the error output file is renamed. +.FNAM1 numeric value of sixbit for first file name of main input file. +.FNAM2 numeric value of sixbit for second file name of main input file. +.FORMAT fno,fval Specify interpretation of fields in a word. + See description in *Note Forma: Words. +.FUNCT + refers to the specified function, in FASL format. *Note Fasl: Fasl +.FVERS version number of main input file. +.GLOBAL ,... + Makes the specified symbols global. +.GO + assembly continues at .TAG tag (within macro body) + Non-local .GO's outward are allowed. +.GSCNT The value of the generated symbol counter - may be read or set. +.GSSET + same as .GSCNT= +.HKALL If nonzero, causes ":" to be treated as "::". +.HKILL ,... + Half-kills the specified symbols. Does not define them. + Acts only on the last pass. + Does shadow definitions in outer blocks, like .BIND. +.I integer mode Fortran arithmetic statement + *Note .I: Arithmetic, for details. +.IBP + returns incremented a la IBP instruction. +.IFNM1 numeric value of sixbit for first file name of insert file + (the file most recently .INSRT'ed by the current input file, + or the current file's name if it hasn't .INSRT'ed any others yet). +.IFNM2 numeric value of sixbit for second file name of insert file +.IFVRS version number of insert file. +.INEOF In an .INSRT file, acts just like EOF. +.INIT The outermost block (as in .INIT"MOVE). All the predefined + symbols are defined in this block. Symbol definitions in this + block are not output to the binary file. +.INSRT + Pushes the current input file and begins reading from the + specified file. After the end of that file, reading from + the inserting file will resume. If the sname of the file to + be inserted is not specified, that of the file being read + will be used. If the file is not found, the user will be + asked to respecify the names. .INSRT'ing the TTY is a + good way to let the user make arbitrary redefinitions at + some point in the assembly. +.IRPCNT # of completed iterations of innermost indefinite repeat +.ISTOP stop REPEAT or IRP - see *Note loops: Loops +.KILL ,... + The specified symbols will not go in the symbol table. +.LDB ,, + returns as a value the contents of the byte in + specified by . may be either a byte pointer + or the left half of one, as in .BM. +.LENGTH /text/ + returns the number of characters in the specified string. +.LIBRA namelist (linking loader pseudo - STINK format only) + This must occur before any storage words. It tells the loader + that the program to follow is a "library program". The entries + in the namelist, separated by commas, are either (a) names, or + (b) groups of names separated by space, +, and -. An entry is + said to be "satisfied" by a list of symbols if either (a) the entry + is a name and that name appears in the list of symbols; or (b) the + entry is a group of names, ALL of which names preceded by space or + + are in the lst of symbols, and NONE of which names preceded by + = are. STINK will omit to load a library program unless one or + more entries in its namelist are satisfied by the list of + undefined global symbols used in programs already loaded. +.LIBRQ nam1,nam2,... (linking loader pseudo - STINK format only) + This will output the given names to STINK such that the loader + "sees" them in this program when queried by load-time conditionals. + No definition is given to the loader, and a use of .LIBRQ does not + cause the names to be seen at all by the assembler. +.LIFE word Load if word = 0. (Load-time conditional, see .ELDC) +.LIFG word Load if word > 0. (Load-time conditional, see .ELDC) +.LIFGE word Load if word >= 0. (Load-time conditional, see .ELDC) +.LIFL word Load if word < 0. (Load-time conditional, see .ELDC) +.LIFLE word Load if word =< 0. (Load-time conditional, see .ELDC) +.LIFN word Load if word not 0. (Load-time conditional, see .ELDC) +.LIFS namelist Load If Seen. (Load-time conditional, see .ELDC) + This conditional is true only if one or more entries in the namelist + are satisfied by the list of defined AND undefined global symbols + used in programs already loaded. See .LIBRA for an explanation of + the namelist. +.LITSW if nonzero, using a literal causes an error message. +.LNKOT (linking loader pseudo - STINK format only) + If output is relocatable (STINK) format, causes immediate output + of all accumulated linking pointers. +.LOP ,, + like .OP, but the instruction is executed in STINK rather + than in MIDAS. Has no value in MIDAS. The loader sets the value + of the global symbols .LVAL1 and .LVAL2 to the resulting contents + of AC and memory respectively. (Initially .LVAL1 and .LVAL2 have + value 0). +.LSTOF listing off +.LSTON listing on +.LVAL1 .LOP value left in accumulator. +.LVAL2 .LOP value in memory location. +.LZ , + the number of leading zeros in the value of . + The comma serves only to terminate . +.M Main block (as in .M"FOO) +.MLLIT set positive to allow multi-line [], (), and <>. + Set negative for the old-fashioned mode where they didn't + need to be terminated. Zero selects "error mode" useful + in converting an old-fashioned program to multi-line mode. + Now initially positive. +.MRUNT MIDAS's runtime so far, in milliseconds. +.NSTGW sets .STGSW to cause error message if any storage words are assembled. +.NTHWD , + returns the 'th word of the text string. + Thus, .NTHWD 1, is equivalent to .1STWD. By + is meant an invocation of ASCIZ, ASCII, ASCIC, .ASCII or SIXBIT. +.OFNM1 = SIXBIT// +.OFNM2 = SIXBIT// +.OP ,, + executes on an AC containing and a memory + location containing , and returns what this leaves + in the AC. Thus, <.OP SUB,5,2> equals 3. This value is also + made the value of .AVAL1, while .AVAL2 contains what was left + in the memory location: .OP SUBM,5,2 sets .AVAL2 to 3, and + returns 5. .ASKIP will be nonzero if the instruction skipped. + If an instruction is supplied with a nonzero AC field, that + AC field will be used unchanged, and the number of the AC + used for the argument and value will not be substituted. + Similarly, if the address field or index field in is + nonzero, the address of .AVAL2 will not be substituted. + This is useful for immediate instructions, including such + ITS UUOs as .RDATE which equals .OPER 46: ASDATE=.OP .RDATE + sets ASDATE to today's date in SIXBIT. + Note that is read in as a field, and thus cannot contain + any spaces or commas (unless they are inside brackets). +.OSMIDAS + is the sixbit name of the operating system MIDAS is running + under. It is SIXBIT of ITS, TENEX, SAIL, CMU or DEC. + Twenex is considered the same as Tenex. + Programs that have versions for more than one operating + system should by default assemble to run on the one + in .OSMIDAS, but they should make it possible to override + that default with the use of the T switch: + IFNDEF RUNOS, RUNOS==.OSMIDAS + DEFINE IFITS + IFE RUNOS-SIXBIT/ITS/TERMIN +.PASS is 1 or 2, depending on which pass MIDAS is in. +.PPASS is 1 in a 1-pass assembly; 2, in a 2-pass assembly. +.QMTCH if set nonzero, causes ' and " text constants to use the newer + fail-style syntax. +.QUOTE /text/ inhibit checking for TERMIN and macro dummies. +.RADIX ,, + evaluates , using as the radix. +.RELP , + returns 's relocation. Always 0 in an absolute + assembly. + For any X, X = .ABSP X,+.RL1*.RELP X, +.RL1 in a relocatable assembly, returns a relocatable 0. + In an absolute assembly, returns 0. + .ABSP .RL1 is always 0. .RELP RL1 is 0 iff the assembly is + absolute. +.RPCNT = # iterations of REPEAT completed +.RSQZ , + generates right-justified SQUOZE such as the DEC system likes. +.SBLK Specifies ITS SBLK output format. Same as SBLK but doesn't type + warning message. For details on format, see ITSDOC;BINFMT > + and the "Symbol table format" section of .INFO.;DDTORD >. +.SCALAR (),,... + makes the symbols "variables", like the ' construct, + causing them to have storage words allocated for them later + (at the time of the next VARIAB or END). An optional + may be specified in parentheses after a symbol, reserving that + many words for it rather than the default of just one. + See also .VECTOR, which is identical except for the way sizes default. +.SEE ,... + Has no effect except to make cref entries for the specified symbols. +.SITE + returns word (origin 0) of a SIXBIT string that says + the name of the machine MIDAS is running on. If is + out of range 0 is returned. The format of the string is + operating system dependent; on I.T.S. .SITE 0, will return + the standard I.T.S. "machine name" which is SIXBIT of + "AI", "ML", "DM", or "MC". + Programs with different versions for different sites should + by default assemble to run on the one specified by .SITE, + but they should make it possible to override that default + using the T switch: + IFNDEF RUNSITE,RUNSITE==.SITE 0, + then later on + IFE RUNSITE-SIXBIT/ML/,... +.SLDR selects SBLK output format, but outputs a loader in front + of the file. +.SPECI .FASL special variable reference. +.STGSW set nonzero => it is illegal to generate storage words. + .NSTGW and .YSTGW act by setting this flag. +.STOP stop current iteration of REPEAT or IRP, go on to next. +.STPLN Set to line # to break assembly at (see below) +.STPPG Set to page # to break assembly at. By setting .STPLN and .STPPG + you can break assembly (i.e. .INSRT the TTY) at an arbitrary point. +.SUCCESS + flag, used to make .ELSE and .ALSO work. +.SX .FASL quoted S-expression reference. +.SXE .FASL S-expression load time evaluated and value assembled in. +.SXEVA .FASL S-expression load time evaluated and value thrown away. +.SYMCNT returns the number of symbol table entries in use. This is the + number of user-defined symbols plus the number of initial symbols + (not counting symbols that have been expunged). It is useful for + determining what argument to give to .SYMTAB (below); +.SYMTAB , + makes sure the symbol table can hold symbols + and the literal table can hold words of literal. + If either table actually needs to be enlarged, both are + re-initialized, so that all user symbol definitions are lost. + For this reason, a .SYMTAB should come at the beginning of the + program. If both tables are already big enough (for example, + when the same .SYMTAB is seen on pass 2), .SYMTAB is a no-op. + The normal version of MIDAS starts out with space for 2700. + symbols, and has about 1200. initial symbols, so only + programs using more than 1500. symbols need a .SYMTAB. + To decide what symtab you need, try a very large value (10000.). + The number of symbols including initial symbols, printed at + the end of the assembly, is the minimum value you can use; + for best results choose an arg at least 20% larger. + The literal table size you need is usually the size of the largest + constants area; this can be computed from the constants + area addresses printed at the end of the assembly. + Sometimes, that size may cause a "Constants Global Table Full" + error, and a larger size must be used. +.TAG see .GO +.TTYFLG if greater than zero, TTY typeout is inhibited + (but not output to error output file if any). +.TTYMAC allows the program to read a few arguments from the TTY at + assembly time, and refer to them as dummy arguments. + .TTYMAC is used the way DEFINE is used (see *Note macros: Macros.) + but without a macro name; the macro definition is read in and + then immediately evaluated, with arguments read in from the TTY. + Try .TTYMAC FOO + BAR=FOO TERMIN +.TYO , + Like TYO n MACLISP; prints on the TTY the character whose ASCII + code is . Thus, .TYO 61 prints a "1". +.TYO6 , + Prints the word, regarded as a sixbit. + Try .TYO6 .FNAM1,.TYO 40,.TYO6 .FNAM2,PRINTX/ + / +.TYPE , Find definition status of symbol. + Value is one of the following: + -1 is really a number + 0 common + 1 pseudo or macro + 17 not seen (except in this .TYPE) + 12-16 either impossible or not documented yet. + + Defined/Undefined + 2 3 Local symbol (not global, not a var) + 4 5 Local variable + 6 7 Global variable + 10 11 Global symbol (not a var) +.TZ , + is the number of trailing zeros in the value of . +.U containing block (as in .U"FOO) +.VECTOR (), (),... + Makes be the name of a vector words long. + The space is actually allocated by the next VARIAB, or by + the END statement. Like .SCALAR, more than one vector can + be specified at a time. If no size is specified, or size is zero, + the default size is used (initially 1, always set to last size used). + e.g. in ".VECTOR FOO(3),BAR" the vector BAR will have size 3. + This defaulting scheme is the only difference from .SCALAR. +.WALGN word-align; in byte mode, move up to a word boundary. +.XCREF ,... + Suppress creffing of the specified symbols. +.YSTGW OK to generate storage words +1PASS one pass assembly. Implies RELOCA +ASCIC /text/ like ASCIZ but fill with ^C. +ASCII /text/ generate ascii character string. +ASCIZ /text/ ascii character string, 0 byte at end. +BLOCK + reserve words - increment "." by . +COMMEN /text/ + ignores the text. +CONSTA dump out literals seen so far. +DEFINE define a macro. See *Note macros: Macros +END + terminates tha assembly, and sets the program starting address + to the argument (which is optional). +EQUALS , + sym1 gets same meaning as sym2. +EXPUNGE ,... + forgets the definitions of the specified symbols. The symbols are + actually deleted from the symbol table altogether. +IF1 ifbody Assemble if pass 1. +IF2 ifbody Assemble if pass 2. +IFB string,ifbody Assemble if string blank (has no squoze chars). +IFDEF sym, ifbody Assemble if sym defined. +IFE exp, ifbody Assemble if = 0. +IFG exp, ifbody Assemble if > 0. +IFGE exp, ifbody Assemble if >= 0. +IFL exp, ifbody Assemble if < 0. +IFLE exp, ifbody Assemble if <= 0. +IFN exp, ifbody Assemble if ^= 0. +IFNB string, ifbody Assemble if string not blank. +IFNDEF sym, ifbody Assemble if sym not defined. +IFNSQ string, ifbody Assemble if string is not all squoze chars. +IFSE string,string,ifbody Assemble if strings equal. +IFSN string,string,ifbody Assemble if strings not equal. +IFSQ string, ifbody Assemble if string is all squoze chars. +IRP indefinite repeat (like macro args sort of). See *Note loops: Loops +IRPC indefinite repeat (characters). +IRPNC indefinite repeat (groups of characters). +IRPS indefinite repeat (symbols). +IRPW indefinite repeat (words - i.e. code lines). +LOC + set value of "." to . +NOSYMS don't put symbols in output. +NULL ifbody + This a "conditional" that always fails. +OFFSET + offset . and labels by specified amt (code to be moved before run). +PRINTC /text/ type out the text. +PRINTX /text/ Same as PRINTC, but ignores any "!" chars in the text. +RADIX + set number radix to . +RELOCA relocatable assembly. +REPEAT ,[] repeat times. See *Note loops: Loops +RIM Readin mode output format. This is what the PDP-6 used. + A series of 2-wd pairs (DATAI PTR,loc ? val); last pair is a + transfer block with 1st wd an instruction taken from END stmt + and executed when transfer block is read. 2nd wd is a dummy. +RIM10 Readin mode output format, for KA-10 hardware bootstrap readin. + RIM10 format is a single block where the 1st word is IOWD n,,loc and + n = # words in rest of block, loc = location to load these words at. + Last loaded word is executed after readin is complete, so it should be + a JRST somewhere. MIDAS makes it unnecessary to do anything about + this as its strategy for RIM10 is to first output a + RIM10-format SBLK loader, followed by the code in normal SBLK format, + except that no symbols are provided. +SBLK Simple Block loader output format (this is the default). + Starts with a SBLK loader in RIM (not RIM10) format, followed by + code in SBLK format. +SIXBIT /text/ generate sixbit character string. +SQUOZE , + value is a word containing the squoze-code for + with /4 put in the top 4 bits. +SUBTTL + ignores the line. This pseudo is for @'s sake. +TERMIN terminate macro body or indefinite repeat. +TITLE + specify name of program as (relocatable only). + Types and on the TTY. + It is at the TITLE that TTY will be .INSRT'ed by + the (T) switch. +VARIAB leave space for, and define, the "variables" seen so far. + "Variables" are symbols not defined and seen with singlequotes + and symbols seen in .SCALAR and .VECTOR pseudos. +WORD + outputs the argument directly to the binary file. + Allows writing of nonstandard binary formats. +XWD , + returns a word with the specified halfwords. + +MIDAS Node: Outformats, Up: Top, Previous: Pseudos, Next: Changes + +This node documents some obscure details of assembler output formats. +Much of the wording is taken from old DEC manuals. + +----------------- RIM ----------------- + + This format is (was) primarily used in PDP-6 systems and +consists of a series of paired words. The first word of each pair is +a paper-tape read instruction giving the memory address of the second +word. E.g. + DATAI PTR, + +The last pair of words is a transfer block; the first is an +instruction obtained from the END statement and executed when the +transfer block is read, and the second is a dummy word to stop the reader. + +The loader that reads this format is normally toggled into memory and +started at location 20: + LOC 20 + CONO PTR,60 + A: CONSO PTR,10 + JRST .-1 + DATAI PTR,B + CONSO PTR,10 + JRST .-1 + B: 0 + JRST A + +----------------- RIM10 ----------------- + + The PDP-10 has a hardware readin mode which can read in one +block of data. Programs which can be loaded using this readin mode +are said to use RIM10 format. The format of this block is: + -n,,loc-1 ; equiv to IOWD n,,loc + ; the last data word is executed after readin. + +In MIDAS, "RIM10" causes the output binary to start with a RIM10-format +SBLK loader provided by MIDAS. The assembled code then follows in SBLK +format. Only data blocks and the final transfer block are output (no +symbol blocks or anything else). This is very similar to MACRO's "RIM10B" +(see below). The RIM10 loader code can be found at label LDR10 in MIDAS. + +In MACRO, "RIM10" causes the assembled code to be output exactly as it +is produced; i.e. the first data word is the first output word. No +blocking, checksumming, or anything else is done; in particular, no +loader is furnished by MACRO. This functionality can be achieved in +MIDAS by means of the WORD pseudo-op, which writes an arbitrary word +to the output file. + +----------------- RIM10B ----------------- + + This is a MACRO format, not MIDAS, but is documented here anyway. +It is very similar to what MIDAS produces for "RIM10". That is, MACRO will +first output a loader in RIM10 format, followed by the assembled code in a +"simple-block" format. This simple-block format is identical to DECSAV +except that there is a checksum word following each block. In this respect +it is similar to SBLK, however it also differs in the way the checksum is +computed; RIM10B just adds words, whereas SBLK rotates the checksum 1 bit +before each add. + +The following is the loader inserted by MACRO for RIM10B: + R1BLDR: + PHASE 0 + IOWD $ADR,$ST + $ST: CONO PTR,60 + HRRI $A,$RD+1 + $RD: CONSO PTR,10 + JRST .-1 + DATAI PTR,@$TBL1-$RD+1($A) + XCT $TBL1-$RD+1($A) + XCT $TBL2-$RD+1($A) + $A: SOJA $A, + $TBL1: CAME $CKSM,$ADR + ADD $CKSM,1($ADR) + SKIPL $CKSM,$ADR + $TBL2: JRST 4,$ST + AOBJN $ADR,$RD + $ADR: JRST $ST+1 + $CKSM: + DEPHASE + +----------------- SBLK ----------------- + + When SBLK format is selected, MIDAS will (presumably for historical +reasons) first output a SBLK loader in RIM (not RIM10!) format, followed by +the assembled code in SBLK format. The latter consists of data blocks, a +transfer block, symbol table blocks, and any extra blocks. + SBLK is to ITS what DECSAV is to DEC systems. + SBLK format is documented in ITSDOC;BINFMT >, and the format of the +SBLK file symbol table in .INFO.;DDTORD >. The RIM loader code can +be found at label SLOAD in MIDAS. + +----------------- DECSAV ----------------- + + DECSAV is a simple absolute format which can be used for +immediately executable programs on TOPS-10, TENEX, and TOPS-20. +It consists only of data blocks followed by a 2 word transfer block. +Each data block has the format: + IOWD n,,loc + +The transfer block is: + JRST start-address ; This word is specified by END + JRST reenter-address ; MIDAS always leaves this 0 + +----------------- DECREL ----------------- + + This format produces DEC relocatable format (.REL) files +which the DEC linking loader (LINK) can then use to put a program +together. It is not necessary to use this unless you need to load +in some already assembled modules or use other loader features; if the +MIDAS program is self-contained it is easier to use DECSAV format. + DEC relocatable format is documented in the DEC LINK Reference +Manual (TOPS-20 version is AD-4183C-T1). + +----------------- STINK ----------------- + + The MIDAS "RELOCA" pseudo generates ITS relocatable format, +also known as STINK format because STINK is the name of the ITS linking +loader. This format is not well documented anywhere, which is partly +why very few people use STINK or RELOCA any more, especially when MIDAS +is fast enough that it is much easier and simpler to always produce +self-contained absolute assemblies. (Library routines are shared by +using .INSRT) + +MIDAS Node: Changes, Up: Top, Previous: Outformats, Next: (MIDAS ARCHIV)* + +Changes are catalogued in an uninfo-ized file. Do "L" to get back here. + +* Menu: + +* Changes: (MIDAS ARCHIV)* MIDAS changes in chronological order. + + + +Local Modes: +Fill Column:75 +Page Delimiter:  +End: diff --git a/src/midas/midas.458 b/src/midas/midas.458 new file mode 100755 index 00000000..9a2e8f37 --- /dev/null +++ b/src/midas/midas.458 @@ -0,0 +1,12013 @@ +; -*-MIDAS-*- +; The canonical source for MIDAS (and directory of supporting files) is +; [MIT-MC] MIDAS;MIDAS > + +IFE .OSMIDAS-SIXBIT/DEC/,.SYMTAB 4973.,2000. ;THIS MANY ON DEC SYSTEM +.ELSE .SYMTAB 10007. ;Assemble faster elsewhere. + +TITLE MIDAS +SUBTTL Instructions and assembly conditionals + +COMMENT | HOW TO ASSEMBLE MIDAS + +The procedure for assembling MIDAS depends primarily on whether you are +building a new MIDAS for your own system, or for a different system. If +it is your own system, you can normally just assemble it, following the +directions below. Building MIDAS for a different system is more +complicated and you will have to read farther. + + ITS + :MIDAS MIDAS;_MIDAS ; Assemble MIDAS + :JOB MIDAS + :LOAD MIDAS;MIDAS BIN + PURIFY$G ; This will dump to SYS;TS MIDAS + ; if you confirm with CR. + + TNX (TENEX, T20) ; This example is for TOPS-20 + [@]CD ; Connect to source file directory + [@]CVTUNV ; Run CVTUNV to generate TNXDFU.MID + [@]MIDAS MIDAS ; Assemble MIDAS + [@]GET MIDAS + [@]START PURIFY ; Optional - Start it at "PURIFY" + [@]SAVE MIDAS ; Then save as sharable file + + DEC (SAIL, CMU, T10) + ; This will have to be provided by those who do it. + + + HOW TO ASSEMBLE MIDAS FOR A DIFFERENT SYSTEM + +To build MIDAS for a different system (not your own), you will need +to do two things. First, symbol definition files for the target system +must be provided; second, when assembling MIDAS the /T switch must be +given to enable initial input from the TTY, and the appropriate +conditional flag then defined. The allowed flags are listed below, along +with the files needed for each. + +Target Flags Files needed Files needed + Op-System (set ==1) (if CVTSW==0) (if CVTSW==1) +ITS ITSSW ITSDFS,ITSBTS - +TENEX/TOPS-20 TNXSW TNXDFS,TWXBTS TNXDFU +TOPS-10 DECSW DECDFS,DECBTS DECDFU + SAIL " + SAILSW " , " ,SAIDFS " + CMU " + CMUSW " , " ,CMUDFS " + + +Other miscellaneous flags (all 1 to enable described action) + CVTSW makes a MIDAS using a DECDFU or TNXDFU file generated by the + CVTUNV program, which reads a MONSYM.UNV file and makes a TNXDFU.MID + file. There is no separate DECBTS or TWXBTS file when using CVTUNV. + NOTE: this should be hacked to read UUOSYM and make DECDFU too; + currently it does not, so CVTSW==1 will not yet work for TOPS-10!! + Normally on for TNX. + + DECDBG (TOPS-10 only) leaves space for the assembler's symbol table + to be moved to after execution is started. This is useful when + debugging MIDAS with DEC DDT. Normally off. + + DECBSW (TOPS-10 only) puts the DECBTS definitions in the predefined + symbol table. Normally on except for SAIL. + + SMALSW builds a "small" MIDAS. This is normally only for random + TOPS-10 DEC sites which have severe core usage restrictions. + + +Some words about SYMBOLS and SYMBOL TABLES + + When talking about "symbols" or "symbol tables", remember that +there can be several different contexts. Normally the reference is to +"THE" symbol table that MIDAS builds while assembling a program, which +contains all the symbols available to or defined by the program being +assembled. References to the "initial symbol table" also mean this +table; when starting to assemble a program, MIDAS has an unhashed table of +"initial symbols" which it uses to create an initial symtab for the +program. + However, MIDAS is itself a program and has its own symbol +table, which can be used by DDT to debug MIDAS. When talking about +this table the words "MSYMTAB" or "M symbol table" will be used, to +differentiate it from the symtab that MIDAS maintains for the program +it is assembling. + Remember that on ITS, a program's symbol table is (quite +rightly) NOT part of the program core image, although it is written +out in the same output file. On TNX and DEC however, the symbol table +must unfortunately be stored somewhere in the program's address space +and is pointed to by an AOBJN pointer at location 116 (.JBSYM). Generally +this area is set up by the linking loader, but MIDAS .DECSAV output can +force this to be wherever the location counter is when the "END" is seen. +| + +IF1,[ ; Clean up initial flags defined from the TTY, if any +IFDEF SAILSW,IFN SAILSW,DECSW==1 +IFDEF CMUSW,IFN CMUSW,DECSW==1 +IFDEF DECDBG,IFN DECDBG,DECSW==1 +IFDEF DECSW,IFN DECSW,DECSW==1 ? ITSSW==0 ? TNXSW==0 +IFDEF ITSSW,IFN ITSSW,ITSSW==1 ? DECSW==0 ? TNXSW==0 +IFDEF TNXSW,IFN TNXSW,TNXSW==1 ? DECSW==0 ? ITSSW==0 +] ; IF1 + + ; Select system to assemble for +IFNDEF ITSSW,ITSSW==IFDEF .IOT,[1] .ELSE 0 ;NON-ZERO => ITS VERSION +IFNDEF TNXSW,TNXSW==IFDEF GTJFN,[1] .ELSE 0 ;NON-ZERO => TENEX VERSION +IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0 ;NON-ZERO => DEC VERSION + ; COND. ON TNXSW SINCE OLD VERSIONS OF TENEX MIDAS HAD + ; DEC UUOS DEFINED TOO ONCE UPON A TIME +IF1 IFN ITSSW+DECSW+TNXSW-1,.FATAL So what monitor is MIDAS supposed to run under? +IFN DECSW,[ +IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0 ;NON-ZERO => SAIL VERSION. +IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0 ;NON-ZERO => CMU VERSION. +] +IFE DECSW,SAILSW==0 ? CMUSW==0 ;CAN'T BE SAIL OR CMU FOR ITS OR TENEX VERSION + + +IFNDEF CVTSW,CVTSW==TNXSW ;NON-ZERO => BITS DEFINITIONS COME FROM FILES + ; MADE USING CVTUNV +IFNDEF SMALSW,SMALSW==DECSW- ;NON-ZERO => SMALL MIDAS + ; (NORMALLY FOR RANDOM DEC SITES ONLY) +IFNDEF DECBSW,DECBSW==DECSW*<1-SAILSW>*<1-SMALSW> + ;NON-ZERO => INCLUDE DECBTS +IFNDEF DECDBG,DECDBG==0 ;NON-ZERO => DEC VERSION TO RUN WITH DEC DDT. + +IFN ITSSW\DECSW\TNXSW,TS==1 +IFNDEF TS,TS==1 ;NON-ZERO => TIME-SHARING VERSION +IFE TS,1PASS +IFNDEF A1PSW, A1PSW==TS ;NON-ZERO => 1PASS END-OF-PROGRAM AUTO-REASSEMBLY +IFNDEF BRCFLG, BRCFLG==0 ;NON-ZERO => BRACES { AND } ARE SPECIAL IN MACRO + ; ARGS, ETC. JUST LIKE BRACKETS. BRACES ARE SPECIAL + ; IN CONDITIONALS REGARDLESS OF BRCFLG. +IFNDEF CREFSW, CREFSW==ITSSW ;NON-ZERO => ALLOW C SWITCH TO CAUSE CREF OUTPUT. +IFNDEF LISTSW, LISTSW==1 ;NON-ZERO => ALLOW L SWITCH TO CAUSE A LISTING. +IFNDEF RCHASW, RCHASW==TS ;NON-ZERO => INCLUDE TTY AS POSSIBLE INPUT DEVICE +IFNDEF PURESW, PURESW==TS-SAILSW ;NON-ZERO => SEPARATE PURE CODING FROM IMPURE AND + ; DO PAGE SKIPS. TWO SEGMENTS HURTS EFFICIENCY AT SAIL. +IFNDEF FASLP, FASLP==1-SMALSW ;NON-ZERO => INCLUDE FASL OUTPUT CAPABILITY + ; NOTE!! IF RUNNING UNDER 10/50 THIS MAKES THINGS + ; SEVERAL K BIGGER THAN OTHERWISE. +IFNDEF .I.FSW, .I.FSW==1-SMALSW;NON-ZERO => INCLUDE .I, .F +IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!) +IFNDEF RUNTSW, RUNTSW==1 ;NON-ZERO => TYPE OUT RUN TIME AT END OF ASSEMBLY +IFNDEF WRQTSW, WRQTSW==1 ;WRQOTE (MACRO DEFINITION READER) VERSION + ; ^ 0 => SLOW, 1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED +IFE TS,IFNDEF MACL,MACL==6*2000 ;MACRO TABLE SIZE +IFN TS,[ +IFN ITSSW,IFNDEF MACL,MACL==6000;DEFAULT MACL SIZE FOR ITS. IF WE HAVE DECBTS OR +IFN TNXSW,IFNDEF MACL,MACL==16*2000 ; TWXBTS, THIS GETS INCREASED, CAUSE THEY ARE HUGE! +IFN DECSW,IFNDEF MACL,MACL==0 ;NON-ITS: WE WANT MACL TO JUST COVER THE INIT CODE. +IFNDEF MXMACL,MXMACL==32.*2000 ;MAXIMUM LENGTH MACTAB +] +IFNDEF MACRUM,MACRUM==4 ;# WORDS NOT USED AT END OF MACTAB +IFNDEF STRL,STRL==20 ;LENGTH OF STRING STORAGE (USED BY GSYL) +IFNDEF DMDEFL,DMDEFL==40 ;MAX NO OF DMY ARGS IN DEFINE +IFNDEF DMYAGL,DMYAGL==400 ;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED +IFNDEF MPDLL,MPDLL==300 ;MACRO PDL LENGTH +IFNDEF DSSIZ,DSSIZ==40 ;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL) +IFNDEF BKTABL,BKTABL==100 ;MAX NUM .BEGIN BLOCKS. +IFNDEF BKPDLS,BKPDLS==10 ;MAXIMUM .BEGIN BLOCK NESTING DEPTH. +IFNDEF BSIZE,BSIZE==37 ;PREFERRED SIZE BLOCK MAX SIZE-3 +IFN SMALSW,IFNDEF LPDL,LPDL==200. +IFNDEF LPDL,LPDL==1500. ;LENGTH OF PDL +IFN SMALSW,IFNDEF CONMIN,CONMIN==1000 +IFNDEF CONMIN,CONMIN==3300 ;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES. +IFNDEF CONMAX,CONMAX==20000 ;MAXIMUM SPACE USER CAN ASK FOR. +IFNDEF NCONS,NCONS==100. ;MAXIMUM NUMBER OF CONSTANTS AREAS +IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS. +;; MUST INCLUDE TONS OF SYSTEM DEFS + IFN DECBSW,IFNDEF SYMDSZ,SYMDSZ==4973. ;666.th prime + IFN TNXSW,IFNDEF SYMDSZ,SYMDSZ==7919. ;1000.th prime +IFN SMALSW,IFNDEF SYMDSZ,SYMDSZ==2003. +IFNDEF SYMDSZ,SYMDSZ==2707. ;DEFAULT # SYMS IN SYMTAB. +IFNDEF SYMMSZ,SYMMSZ==11657.*2 ;# SYMS IF JNAME IS MMIDAS. +IFNDEF SYMMAX,SYMMAX==60000 ;MAX SYMTAB SIZE (# SYMS) +IFNDEF FASBL,FASBL==400 ;WORDS USED FOR FASL OUTPUT BUFFER + ; MUST HOLD STUFF ASSOC WITH ONE GROUP OF 9 CODE BYTES +IFNDEF FASATL,FASATL==2000 ;WORDS USED FOR FASL ATOM TABLE + ; HOLDS PNAMES ETC OF ALL ATOMS AS WILL BE IN FASLOAD'S + ; SYMTAB AT LOAD TIME +IFNDEF MINWPS,MINWPS==3 ;MIN # WORDS IN SYMTAB ENTRY +IFNDEF MAXWPS,MAXWPS==3 ;MAX # ALLOWED (WILL BE BIGGER SOME DAY) +IFNDEF NRMWPS,NRMWPS==3 ;DEFAULT #. 2 WDS FOR VALUE & FLAGS, 1 FOR NAME. + +SUBTTL INITIAL DEFINITIONS + +; AC definitions. FF and P must be 0 and 17 respectively, otherwise the +; only constraints are those expressed as sequential orderings, e.g. B+1 etc. +; Also, +.SEE R1 + +FF=:0 ; FLAGS. MUST BE AC 0. +AA=:1 ; GENERAL PURPOSE REGS, MUST BE SEQUENTIAL. +A=:AA+1 ; 2 +B=:A+1 ; 3 +C=:B+1 ; 4 +D=:C+1 ; 5 +T=:6 ; NOT SO TEMP AS IN MOST PROGS W/ T +TT=:T+1 ; 7 +I=:10 ; INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF +SYM=:11 ; FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR +LINK=:SYM+1 +F=:13 +CH1=:14 ; MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH +CH2=:CH1+1 ;" " " +TM=:16 ; SUPER TEMPORARY +P=:17 ; PDL AC, MUST BE 17. AS WELL AS RANDOM CROCKS IN PROGRAM, 20X ERCAL + ; ASSUMES P=17. + + +IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T + +; VERSION, FLAGS, ETC. + +IF1 [ + +IFNDEF MIDVRS,[ +IFGE .FVERS,[ +DEFINE XXX VRS + MIDVRS=SIXBIT/VRS/ +TERMIN +RADIX 10. +XXX \.FVERS +RADIX 8 +EXPUNGE XXX +] +.ELSE [ +PRINTX /What is MIDAS version number? / +.TTYMAC VRS + MIDVRS=SIXBIT/VRS/ +TERMIN +] +] + +; OSMIDAS gets the sixbit name of the type of op. sys. this version of MIDAS +; is being assembled to run under. It will be the value of .OSMIDAS when +; programs are assembled with this MIDAS. Note that the TNX version actually +; sets it at runtime startup to "TENEX" or "TWENEX" as appropriate. + +IFNDEF OSMIDAS,OSMIDAS==IFE TS,[SIXBIT/BARE/] .ELSE IFN ITSSW,[SIXBIT/ITS/] .ELSE IFN CMUSW,[SIXBIT/CMU/] .ELSE IFN SAILSW,[SIXBIT/SAIL/] .ELSE IFN TNXSW,[SIXBIT/TENEX/] .ELSE SIXBIT/DEC/ + +;FF FLAGS NOT PUSHED +;LEFT HALF +FL==1,,525252 +FLPPSS==400000 ;ONE IF PUNCHING PASS; MUST BE SIGN +FLHKIL==100000 ;ONE IF SYM TO BE SEMI KILLED IN DDT + +FLVOT== 40000 ;ALL RCH S MUST GO THRU RCH + ; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR) +FLMAC== 20000 ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN +FLTTY== 10000 ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN +$FLOUT== 4000 ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC) +FLPTPF== 2000 ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP +FLUNRD== 1000 ;=> RE-INPUT LAST CHARACTER (SEE RCH) +FL20X==400 ; IN TENEX VERSION, 1= RUNNING ON TOPS-20, 0 = TENEX. + +;FF RIGHT HALF FLAGS + +FR==525252 +FRFIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK +FRSYMS==200000 ;ONE IF SYM PUNCH DESIRED +FRLOC==100000 ;ONE BETWEEN ABS LOC ASSIGN AND + ;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.) + +FRNPSS==40000 ;ONE IF TWO PASS ASSEMBLY +FRPSS2==20000 ;ONE ON PASS 2 + +FRINVT==4000 ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL) +FRNLIK==2000 ;TEMPORARILY SUPPRESS ADR LINKING +FRGLOL==1000 ;ONE IF LOCATION PLUS OFFSET IS GLOBAL + +FRBIT7==400 ;SET IF LAST TIPLE OF CODEBITS WAS 7. +FRMRGO==200 ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV) + +FRCMND==40 ;SET WHILE READING CMD, TELLS RFD TO NOTICE (, _, COMMA. +FRNNUL==20 ;SET ON RETURN FROM RFD IFF NONNULL SPEC. +FRARRO==10 ;TELLS RFD THAT 1ST NAME IS FN1, NOT FN2. +FRFN1==4 ; TELLS RFD THAT 1ST NAME WAS READ. + + + ; FLAGS TO ZERO AT BEGINNING OF PASS 1 ONLY, BY $INIT. +FFINIT==<-1-FLVOT-FLPTPF-FLTTY-FL20X,,-1> + +] ;END IF1 + +;INDICATOR REGISTER + +IF1 [ + +;LEFT HALF +IL==1,,525252 +ILGLI==1 ;SET ON " CLEARED EACH SYL +ILVAR==2 ;SET ON ' " " " +ILFLO==4 ;FLOATING NUM, SET ON DIGIT AFTER . +ILDECP==10 ;DECIMAL PREFER, SET WHEN . SEEN. +ILUARI==20 ;1 => RIGHT OPERAND TO UPARROW BEING READ +ILLSRT==40 ;RETURN FROM < +ILWORD==400 ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD +ILNPRC==1000 ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW +ILMWRD==4000 ;SET ON MULTIPLE WORD +ILPRN==10000 ;SET DURING MACCL IF MACRO NAME WAS FOLLOWED BY (. +ILMWR1==20000 ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST + ;WORD OF MULTI-WORD CONSTANT +ILNOPT==40000 ;CONSTANTS OPTIMIZATION SUPPRESSION FLAG; SHOULD BE SET BY + ;VALUE-RETURNING PSEUDO DURING NOT PUNCHING PASS TO KEEP ITSELF OUT OF + ;CONSTANTS OPTIMIZATION + +;RIGHT HALF + +IR==525252 +IRFLD==1 ;SET IF FLD NOT NULL +IRSYL==2 ;SET IF SYL NOT NULL +IRLET==4 ;SET IF SYL IS SYMBOL +IRDEF==10 ;SET IF CURRENT EXPR DEFINED +IRNOEQ==20 ;SET IF = ISN'T ALLOWED IN CURRENT CONTEXT. +IRCOM==40 ;SET IF CURRENT QUAN IS COMMON +IRPERI==100 ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER +IREQL==200 ;ONE DURING READING WORD TO RIGHT OF = +IRIOINS==400 ;FIRST FIELD OF CURRENT WORD HAS IO INST +IRCONT==1000 ;SET IF NOT OK TO END BLOCK +IRPSUD==4000 ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO +IRGMNS==20000 ;SET IF ILUARI OR BAKARI HAS GOBBLED MINUS +IROP==200000 ;SET IF OPERATOR SEEN IN CURRENT FIELD + +CALL==PUSHJ P, +RET==POPJ P, +;SAVE=PUSH P, ;DON'T USE SAVE! IT'S A JSYS ON TENEX AND TWENEX +REST==POP P, +PJRST==JRST ; FOR JRST'ING TO A POPJ'ING ROUTINE. + +ETSM=1000,, ;ERROR, TYPE SYM. +ETR=2000,, ;ERROR, ORDINARY MESSAGE. +ERJ=3000,, ;ERROR, NO MESSAGE, RETURN TO ADDR. +ETI=4000,, ;ERROR, IGNORE LINE, RET. TO ASSEM1. +ETA=5000,, ;ERROR, RET. TO ASSEM1. +ETASM=6000,, ;ERROR, TYPE SYM AND RETURN TO ASSEM1 +ETF=7000,, ;FATAL ERROR. +TYPR=(37000) ;UUO, TYPE OUT ASCIZ STRING +TYPCR=(36000) ; LIKE TYPR BUT ADDS CR AT END. +] ;END IF1 + +IF1 [ +;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT +;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE +;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE) + +;ACTUAL ENTRIES IN GLOTB: +;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED +;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE) +;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1 + ;GLOBAL SHOULD BE MULTIPLIED BY IT +;REST OF LH FLAGS: + +;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD +ACF==40000 ;AC LOW OR HIGH (SWAPF => HIGH) +HFWDF==100000 ;MASK GLOBAL TO HALFWORD +SWAPF==200000 ;SWAP +MINF==20000 ;NEGATIVE OF GLOBAL + +IFNDEF LBRKT,LBRKT=="[ ;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC. +IFNDEF RBRKT,RBRKT=="] ;RIGHT " +IFNDEF WPS, WPS==3 ;# CONTIG. WDS /STE. IFNDEF FOR DEBUGGING. +IFNDEF BKWPB,BKWPB==3 ;# WDS/BKTAB ENTRY. +IFNDEF EOFCH,EOFCH==3 ;EOF CHAR, BEWARE DISPATCH TABLE ENTRIES. +IFNDEF LBRACE,LBRACE==173 +IFNDEF RBRACE,RBRACE==175 + +;3RDWRD LH. SYM TAB BITS + +3REL==600000 ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS +3RLL==400000 ;R(LH) +3RLR==200000 ;R(RH) +3RLNK==100000 ;R(LINK) +3KILL==40000 ;FULLY-KILLED SYM (DON'T GIVE TO DDT). +3VP==20000 ;VALUE PUNCHED +3SKILL==10000 ;SEMI KILL IN DDT +3LLV==4000 ;LINKING LOADER MUST INSERT VAL +3VAS2==2000 ;VAR SEEN ON PASS TWO WITH ' +3VCNT==1000 ;USED IN CONSTANT +3MAS==400 ;THIS ISN'T THE LAST DEFINITION OF A SYM WITH THIS NAME + ;(SO ES MUST KEEP SEARCHING). +3NCRF==200 ;DON'T CREF THIS SYMBOL. +3MACOK==100 ;OK TO (RE)DEFINE THIS SYM AS MACRO. + ;(IE IS A MACRO OR SEEN ONLY IN .XCREF) +3LABEL==40 ;ILLEGAL TO REDEFINE THIS SYM TO DIFFERENT VALUE +3MULTI==20 ;THIS SYM IS MULTIPLY DEFINED, SO FLAG ALL DEFINITIONS. +3DOWN==10 ;THIS DEFINITION SHOULD BE SEEN BY SUBBLOCKS IN 1PASS MODE. + +3DFCLR==737110 ;BITS IN LH TO CLEAR ON REDEFINITION. + +; FLAGS IN "CONTROL" VARIABLE +.SEE CONTRL + ;LEFT HALF +TRIV==400000 ; 1 IF OUTPUT FORMAT IS FOR TRIVIAL LOADER (ABSOLUTE) + ; ELSE RELOCATABLE (NOTE THIS CROCKISHLY ONLY MEANS + ; STINK FORMAT, SINCE DEC RELOC FORMAT HAS THIS FLAG SET) + + ;RIGHT HALF +ARIM== 2 ; 1 => OUTPUT FORMAT IS RIM +SBLKS== 10 ; 1 => OUTPUT FORMAT IS SBLK (SIMPLE BLOCKS) +ARIM10== 20 ; 1 => OUTPUT FORMAT IS PDP-10 RIM +DECREL== 40 ; 1 => DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS) +FASL== 100 ; 1 => LISP FASL COMPATIBLE RELOCATABLE FORMAT ( " " ") +DECSAV==200 ; 1 => DEC SAV FORMAT (ABSOLUTE) ALSO WINS ON 10X, 20X + +PTR==104 ;DEVICE CODE FOR PAPER TAPE READER. + +] ;END IF1 + +IF1 [ + +;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE + +CMMN==0 ;COMMON (NOT USED) +PSUDO==40000 ;PSEUDO OR MACRO, VALUE RH ADDR OF RTN (MACCL FOR MACRO), + ; LH WILL BE IN LH OF B WHEN RTN CALLED. +SYMC==100000 ;SYM, VALUE IS VALUE OF SYM. +LCUDF==140000 ;LOCAL UNDEF +DEFLVR==200000 ;DEF LOC VAR, VALUE IS VALUE. +UDEFLV==240000 ;UNDEF LOC VAR, VALUE IS 1+ IDX IN VARIAB. AREA, BUT IGNORD IF VAR AREA GLOB. +LGBLCB==300000 ;CODE BITS EQUAL TO THIS OR HIGHER REPRESENT GLOBAL QUANTITIES +DEFGVR==300000 ;DEF GLO VAR, VALUE IS VALUE +UDEFGV==340000 ;UNDEF GLO VAR, VALUE LIKE UNDEF LOCAL VAR. +GLOETY==400000 ;GLO ENTRY +GLOEXT==440000 ;GLO EXIT +NCDBTS==GLOEXT_<-18.+4>+1 ;# CODE BIT TYPES + +DEFINE CDBCHK TBLNAM +IFN .--NCDBTS,.ERR TBLNAM LOSES +TERMIN + +;LOADER BLOCK TYPES LINK +LLDCM==1 ;LOADER COMMAND BLOCK +LABS==2 ;ABSOLUTE +LREL==3 ;RELOCATABLE +LPRGN==4 ;PROG NAME +LLIB==5 ;LIBRARY BLOCK +LCOMLOD==6 ;LOAD INTO COMMON +LGPA==7 ;GLOBAL PARAMETER ASSIGN +LDDSYM==10 ;LOCAL SYMS +LTCP==11 ;LOAD TIME COND ON PRESENCE +ELTCB==12 ;END LOAD TIME COND +LPLSH==22 ;POLISH FIXUP + +;LOADER COMMANDS +;IN ADR OF LDCMD BLK +LCJMP==1 ;JUMP +LCGLO==2 ;GLOBAL LOC ASSIGN +LCCMST==3 ;SET COMMON BENCHMARK +LCEGLO==4 ;END OF GLOBAL BLOCK +LDCV==5 ;LOAD TIME COND ON VALUE +LDOFS==6 ;LOADER SET GLOBAL OFFSET +LD.OP==7 ;LOADER .OP + +;LOADER CODEBITS SECOND SPEC AFTER 7 +CDEF==0 ;DEF +CCOMN==1 ;COMMON REL +CLGLO==2 ;LOC-GLO REC +CLIBQ==3 ;LIBREQ +CRDF==4 ;GLO REDEF +CRPT==5 ;REPEAT GLOBAL VALUE +CDEFPT==6 ;DEFINE SYM AS $. + +;DEC RELOCATABLE BLOCK TYPES. +DECWDS==1 ;STORAGE WORDS. +DECSYM==2 ;SYMBOL DEFS OR GLOBAL ADDITIVE RQS. +DECHSG==3 ;LOAD INTO HIGH SEG (FOR .DECTWO) +DECENT==4 ;ENTRY NAMES +DECEND==5 ;END BLOCK, HAS PROGRAM BREAK. +DECNAM==6 ;PROGRAM NAME. +DECSTA==7 ;STARTING ADDRESS BLOCK. +DECINT==10 ;INTERNAL REQUEST +DECRQF==16 ;REQUEST LOADING A FILE +DECRQL==17 ;REQUEST LOADING A LIBRARY +] ;END IF1 + +IF1 [ + +DEFINE GOHALT ; Instruction invoked for MIDAS internal error (fatal) + JSR HALTER +TERMIN + +DEFINE TYPE &STR +TYPR [ASCIZ STR] +TERMIN + +DEFINE TYPECR &STR +TYPCR [ASCIZ STR] +TERMIN + +DEFINE PRINTA A,B,C,D,E,F +IF1,[PRINTC ~A!B!C!D!E!F +~] +TERMIN + +IF1 [DEFINE BNKBLK OP +OP +TERMIN ] + + ;ADD A LINE TO BNKBLK, ACCUMULATED CONTENT OF + ;WHICH IS DUMPED OUT AT END OF ASSEMBLY + ;ARG TO BLCODE SHOULD BE FREE OF STORAGE WORDS + +DEFINE BLCODE NEWCFT +IF1 [BNKBLK [DEFINE BNKBLK OP +OP]NEWCFT +TERMIN ] +IF2 [IRPW X,,[ +NEWCFT +] +IRPS Y,,X +Y=Y +.ISTOP TERMIN TERMIN ] TERMIN + + ;3RDWRD MANIPULATING MACROS + ;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3GET A,B + MOVE A,ST+2(B) + TERMIN + + ;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD + +DEFINE 3GET1 A,B + MOVE A,2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3PUT A,B + MOVEM A,ST+2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD + +DEFINE 3PUT1 A,B + MOVEM A,2(B) + TERMIN + +] ;END IF1 + +;RANDOM MACRO DEFINITIONS + +IF1 [ + + ;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE + +DEFINE SKPST A + CAIL A,ST + CAML A,MACTAD +TERMIN + + ;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP) + +DEFINE INSIRP A,B + IRPS %ADR,,[B] + A,%ADR + TERMIN +TERMIN + +DEFINE NOVAL + TDNE I,[ILWORD,,IRNOEQ\IRFLD] + ETSM ERRNVL +TERMIN + +DEFINE NOABS + SKIPGE CONTRL + ETASM ERRABS +TERMIN + +] ;END IF1 + +ERRNVL==[ASCIZ /Returns no value/] +ERRABS==[ASCIZ /Allowed only for STINK relocatable format/] + +IF1 [ + +DEFINE MOVEIM B,C + MOVEI A,C + MOVEM A,B +TERMIN + +DEFINE MOVEMM B,C + MOVE A,C + MOVEM A,B +TERMIN +] ;END IF1 + +IF1 [ +IFN 0,[ +;THESE ARE SOME MACRO DEFINITIONS FOR THE UNFINISHED MULTI-WORD +;SYMBOL NAME FEATURE. FOR COMPATIBILITY, THEY ALL NOW HAVE DEFINITIONS +;THAT ONLY HANDLE ONE WORD. THOSE OTHER DEFINITIONS COME AFTER THESE. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +IFSN X,SYM,SKIPE A,X+1 +.ELSE SKIPE A,SYMX + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y + MOVE Z,X+1 + MOVEM Z,Y+1 +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y + MOVE Z,AC!X + MOVEM Z,Y+1 +TERMIN +] + +.ELSE [ +;THESE ARE THE DEFINITIONS OF THE MACROS THAT DO NOT IMPLEMENT +;MULTI-WORD SYMBOL NAMES. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y +TERMIN +] + +DEFINE USING X +X,TERMIN + +] ;END IF1 + +SUBTTL DEFINE SYS DEPENDENT SYMBOLS & SELECT OUTPUT FORMAT + +; THIS DEFSYM MACRO IS FOR COMPILING MIDAS ON ANOTHER OPERATING SYSTEM. THIS +; AVOIDS SAME-NAME SCREWS (IE, "LOCK" IS SOMETHING DIFFERENT ON TWENEX, SAIL, +; AND DEC). + +IF1 [ +; Expunge symbol unless it's a pseudo or macro, in which case the redefinition +; will complain about it. +DEFINE DEFSYM X/ + IRPS Z,,[X] + IFN <1-.TYPE Z,>, EXPUNGE Z + .ISTOP + TERMIN + X +TERMIN +]; IF1 + +IFN DECSW\TNXSW,[ +IF1 [ + +IFN TNXSW, EQUALS TEM,.SYMTAB ; Preserve definition in case def files lose + ; This is currently the only symbol conflict + ; between MIDAS and TOPS-20. +IFE CVTSW,[ + +; INSERT UUO DEFINITIONS FILES AS APPROPRIATE. +IFE CMUSW\SAILSW\TNXSW,.INSRT DECDFS +IFN SAILSW, .INSRT SAIDFS +IFN CMUSW, .INSRT CMUDFS +IFN TNXSW, .INSRT TNXDFS + +;ACTUALLY DEFINE THE UUOS USING THE MACROS READ FROM THE FILES. +IFN DECSW,.DECDF DEFSYM +IFN TNXSW,.TNXDF DEFSYM + +;INSERT THE BITS DEFINITION FILES AS APPROPRIATE. +;THESE MUST BE INSERTED EVEN IF THEY ARE PREDEFINED, BECAUSE +;THE MIDAS SYMBOL TABLE IS CONSTRUCTED FROM THE DEFINITIONS IN THIS ASSEMBLY +;OF THOSE SYMBOLS, AND THAT MEANS WE NEED THE LATEST VERSION ASSEMBLED IN. + +IFN TNXSW, .INSRT TWXBTS +IFN DECBSW,.INSRT DECBTS + +];IFE CVTSW + +; If using CVTUNV then there is just one file which is the converted +; contents of the MONSYM.UNV file for the system; the xxxDFS and xxxBTS files +; are not needed. There are no special SAIL or CMU versions. +IFN CVTSW,[ + IFN DECSW, .INSRT DECDFU + IFN TNXSW, .INSRT TNXDFU +] ;IFN CVTSW + +IFN TNXSW,[ ; AC DEFS FOR DIRECT REFERENCE TO JSYS ARGS +R1==:1 ; SOMEDAY MAYBE THE SYMBOLS A,B ETC WILL CORRESPOND... +R2==:2 +R3==:3 +R4==:4 +R5==:5 +] + +IFN TNXSW, EQUALS .SYMTAB,TEM + +] ;IF1 + +IFN DECSW,[ ; SELECT OUTPUT FORMAT FOR DEC VERSION +IFN PURESW,.DECTWO +IFE PURESW,.DECREL + RL0==. +] +IFN TNXSW,[ ; SELECT OUTPUT FORMAT FOR TNX VERSION +IFNDEF DECSVF,[ ; NORMALLY, USE .DECSAV IF AVAILABLE, ELSE .DECREL, + DECSVF==0 ; BUT USER CAN OVERRIDE THAT BY SPECIFYING DECSVF. + IFDEF .DECSAV,DECSVF==1 +] +IFN DECSVF,.DECSAV +.ELSE [ IFN PURESW,.DECTWO + .ELSE .DECREL + ] + RL0==0 +] +] ;IFN DECSW\TNXSW + +IFN ITSSW,[ +IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS + .ITSDF DEFSYM + ] ;IFNDEF .IOT +IFNDEF %PIPDL,.INSRT SYS:ITSBTS + EXPUNG .JBTPC,.JBCNI + +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] +TERMIN +] ;IF1 + +IFDEF .SBLK,.SBLK ; SELECT OUTPUT FORMAT FOR ITS VERSION + RL0==0 +] ;IFN ITSSW + +IFE PURESW,[ ;FOLLOWING IF NOT ASSEMBLING PURE CODING + +DEFINE PBLK +TERMIN + +DEFINE VBLK +TERMIN +] + +IFN PURESW,[ ;FOLLOWING IF ASSEMBLING PURE CODING + +; MIDAS MEMORY ORGANIZATION + +; General +; First come several pages of impure coding (no dynamic allocation). +; The BLCODE macro accumulates "blank" (zero wd) coding to be put at end of +; impure coding; no non-zero storage words allowed. +; Then comes the symbol table at ST, followed by the literals tables, followed +; by the macro table. The latter two are peculiar because they can both +; be shifted upwards if the symbol table size is increased at the start of +; assembly. +; The macro table initially starts at MACTBA (actual addr in MACTAD) +; and is even more peculiar because there is a lot of symbol initialization +; coding there, including a unhashed table of "initial symbols", which is +; wiped out by the first macro definition. +; Finally there is a "gap" of unused pages, followed by the pure +; code of MIDAS at location MINPUR*2000. + +; Page(addr) End+1 + +; 0 (BBKCOD) Impure coding (VBLK) +; MINBNK 1st completely blank page (above BBKCOD) +; (BBKCOD) (EBKCOD) Blank code (BLCODE) all zeros +; (ST) varies Symbol table starts here +; *(CONTAB) Literal table +; MINMAC Page # that MACTBA starts in +; *(MACTBA) Start of initialization coding + initial syms +; MXICLR MXIMAC Empty pages above initial coding reserved +; for initial macro table. +; MXIMAC MAXMAC Unused pages but can expand into. +; MAXMAC 1st page macro table prevented from using +; "gap" Never-used pages between impure and pure +; MINPUR MAXPUR Pure code (PBLK) +; - +; 1STBFP/2 varies TNX only, input file page buffers + +; * - the literal and macro tables are subject to being shifted by symtab +; expansion. The macro table can dynamically expand up to MAXMAC. + + +IFN DECSW\TNXSW,MINPUR==200 +IFN ITSSW,MINPUR==200 ; Page number beginning pure coding + +;PURE CODING UNTIL MAXPUR*2000-SOMETHING +;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY +;TO SEPARATE PURE CODING FROM IMPURE + +CKPUR==0 ;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE + + ; PBLK - SWITCH TO CODING ABOVE THE GAP +DEFINE PBLK +IFN CKPUR,.ERR PBLK +IFE CKPUR,[VAR.LC==. +LOC PUR.LC +]CKPUR==1 +TERMIN + + ; SET INITIAL LOCATION COUNTER FOR ASSEMBLING PURE CODE ABOVE GAP. +IFN ITSSW, PUR.LC==MINPUR*2000 +IFN DECSW, PUR.LC==MINPUR*2000+RL0 +IFN TNXSW,[ + IFN DECSVF,PUR.LC==MINPUR*2000 + .ELSE PUR.LC==MINPUR*2000+20 ;SKIP VESTIGIAL JOBDAT AREA. +] + + ; VBLK - SWITCH TO CODING BELOW THE GAP +DEFINE VBLK +IFE CKPUR,.ERR VBLK +IFN CKPUR,[PUR.LC==. +LOC VAR.LC +]CKPUR==0 +TERMIN + +IFN TNXSW,IFE DECSVF,LOC 200 + +PBLK ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK + +] ;END PURESW CONDITIONAL + +.YSTGW ;SET UP NOW, STORAGE WORDS OK + +FOO==. +LOC 41 + JSR ERROR +IFN ITSSW,JSR TSINT +IFN DECSW,[ +LOC .JBAPR + TSINT1 +] +LOC FOO + + ;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS + ;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB) + ;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL + +DSYL==400000 ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN) +DFLD==200000 ;FIELD OPERATOR, GETFD +DWRD==100000 ;WORD OP, GETWD +DSY1==1000 ;SET ONLY IF DSYL SET, + ;SET IF OP MIGHT BE 1ST CHAR OF NONNULL SYL. +DSYL1==DSYL+DSY1 +DSY2==400 ;SET FOR _ ONLY. + +;ALL CLEAR => WORD TERMINATOR, NO DISPATCH + +DTB: DWRD,,SPACE ;40 SP, TAB, RUBOUT + DSYL1,,RRL2 ;EXCLAIM AND OPEN-BRACE + DSYL1,,DQUOTE ;" + DFLD,,XORF ;NUM SIGN + DSYL,,RBRAK2 ;CLOSE-BRACE. + 0 ;(USED TO BE PERCENT SIGN) + DFLD,,ANDF ;AMPERSAND + DSYL1,,SQUOTE ;' + DFLD,,LEFTP ;( 50 + DSYL,,RPARN ;) + DFLD,,MULTP ; STAR TIMES + DFLD,,PLS ;+ PLUS + DWRD,,COMMA ; , + DFLD,,MINUS ;- + DSYL1,,CTLAT ;^@ (56) + DFLD,,DIVID ;/ + DSYL1,,COLON ;COLON 60 + DSYL,,SEMIC ;SEMI + DFLD,,LSSTH ;< + DSYL1,,EQUAL ;= + DSYL,,GRTHN ;> + 0 ;? + DSYL1,,ATSGN ;AT SIGN + DFLD,,LBRAK ;[ + DFLD,,IORF ;BACKSLASH 70 + DSYL,,RBRAK ;] + DSYL1,,UPARR ;^ + DSYL+DSY2,,BAKAR ;BACKARR + 0 ;CR + 0 ;(USED TO BE TAB) + 0 ;ALL OTHER + DSYL,,LINEF ;LF (DSYL TO HACK CLNN) + DSYL,,FORMF ;FORM FEED (") 100 + +;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS +;EXCEPT FOR EOFCH + +GDTAB: POPJ P,56 ; ^@ GETS IGNORED. + REPEAT 2,POPJ P,76 ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF + ;ON OLD FILES) +IFN .-GDTAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH GDTAB. +IFE TS,[POPJ P,76] IFN TS,[JRST RREOF] + REPEAT 5,POPJ P,76 + POPJ P,40 ; TAB + POPJ P,77 ; LF + POPJ P,76 ; VERT TAB + POPJ P,100 ; FORM FEED + POPJ P,74 ; CR + REPEAT "!-16-1,POPJ P,76 + POPJ P,40 ; SPACE + POPJ P,41 ; ! + POPJ P,42 ; " + POPJ P,43 ; # + ADD SYM,%$SQ(D) ; $ + ADD SYM,%%SQ(D) ; % + POPJ P,46 ; & + POPJ P,47 ; ' + POPJ P,50 ; ( + POPJ P,51 ; ) + POPJ P,52 ; * + POPJ P,53 ; + + POPJ P,54 ; , + POPJ P,55 ; - + JSP CH1,POINT ; . + POPJ P,57 ; / + REPEAT 10.,JSP CH2,RR2 ; DIGITS + POPJ P,60 ; : + POPJ P,61 ; ; + POPJ P,62 ; < + POPJ P,63 ; = + POPJ P,64 ; > + POPJ P,65 ; ? + POPJ P,66 ; @ +IFDEF .CRFOFF,.CRFOFF +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN + POPJ P,67 ; [ + POPJ P,70 ; \ + POPJ P,71 ; ] + POPJ P,72 ; ^ + POPJ P,73 ; _ + POPJ P,76 ; NOW LOWER CASE GRAVE ACCENT + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN +IFDEF .CRFON,.CRFON + POPJ P,41 ;{ + POPJ P,76 ;| + POPJ P,44 ;} + POPJ P,76 ;~ + POPJ P,40 ; RUBOUT, LIKE SPACE + IFN .-GDTAB-200,.ERR GDTAB LOSES + +NSQTB: IFDEF .CRFOFF,.CRFOFF +IRPC Q,,0123456789 + ADD SYM,%!Q!SQ(D) +TERMIN + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%. +%!Q!SQ: 0 + SQUOZE 0,Q/50/50/50/50/50 + SQUOZE 0,Q/50/50/50/50 + SQUOZE 0,Q/50/50/50 + SQUOZE 0,Q/50/50 + SQUOZE 0,Q/50 + SQUOZE 0,Q +TERMIN +IFDEF .CRFON,.CRFON + +;FORMAT TABLE(S) +;4.9-4.4 ETC SPECIFY SHIFT +;4.4-3.6 ETC SPECIFY NUMBER BITS +;FIELD SPECS IN REVERSE ORDER + +IFORTB: 0 ;NCNSN 10 , + 0 ;NCNSF 11 IMPOS + 0 ;NCNCN 12 ,, + 2200,, ;NCNCF 13 ,,C + 2200000000 ;NCFSN 14 ,B + 0 ;NCFSF 15 ,B C + 0 ;NCFCN 16 ,B, + 0 ;NCFCF 17 ,B,C + 4400000000 ;FSNSN 20 A + 0 ;FSNSF 21 IMPOS + 0 ;FSNCN 22 IMPOS + 0 ;FSNCF 23 IMPOS + 2200440000 ;FSFSN 24 A B + 2200220044 ;FSFSF 25 A B C + 270400440000 ;FSFCN 26 A B, + 2227040044 ;FSFCF 27 A B,C + 4400000000 ;FCNSN 30 A, + 0 ;FCNSF 31 IMPOS + 22220000 ;FCNCN 32 A,, + 2200002222 ;FCNCF 33 A,,B + 2200440000 ;FCFSN 34 A,B + 0 ;FCFSF 35 A,B C + 0 ;FCFCN 36 A,B, + 0 ;FCFCF 37 A,B,C +FRTBL==.-IFORTB ;LENGTH OF FORMAT TABLE +VBLK +FORTAB: BLOCK FRTBL ;ACTUAL FORMAT TABLE +FRTBE=.-1 +PBLK + +;VARIABLE STORAGE + +VBLK + +RETURN: JRST . ;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2) +CDISP: 0 ;CURRENT DISPATCH CODE +PPRIME: 0 ;PUSH DOWN LIST MARKER (GETFLD) +SCNDEP: 0 ;DEPTH IN SUCCESSFUL BRACKET CONDITIONALS INSIDE INNERMOST LITERAL. +CONDLN: 0 ;LINE NUMBER AT WHICH LAST TOP LEVEL SUCCESSFUL CONDITIONAL ENCOUNTERED +CONDPN: 0 ;PAGE NUMBER-- PRINT THESE IF REACH END AND CONDITIONAL NOT TERMINATED +CONDFI: 0 ;SIXBIT FN1 OF FILE CONTAINING LAST TOP LEVEL SUCCESSFUL CONDITIONAL. +A.SUCC: 0 ;NONZERO IFF LAST CONDITIONAL SUCCEEDED. +ASMOUT: 0 ;0 NORMAL, 1 WITHIN <>, 2 IN (), 3 IN []. +ASMDSP: ASSEM3 ;PLACE TO JUMP TO FROM ASSEM1 LOOP. + ;ASSEM3 NORMAL. ASSEMC IF WITHIN <>, () OR [] + ;AND .MLLIT ISN'T POS. LSSTHA AFTER > OR ) SEEN. + ;[ ;CONND AFTER ] SEEN. +ASMDS1: 0 ;ASMDSP SAVED HERE DURING ASCII, SIXBIT PSEUDOS. +ASSEMP: 0 ;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL. +ASMI: 0 ;REINIT I AT ASSEM2 FROM ASMI. +GLSPAS: 0 ;RESTORE GLSP1 AT ASSEM1. SAVED OVER LITERAL. +GLSP1: 0 ;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR +GLSP2: 0 ;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR +FORMAT: 0 ;ACCUMULATES FORMAT WORD +FORPNR: 0 ;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB +FLDCNT: 0 ;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD +WRD: 0 ;ACCUMULATES VALUE OF WORD +WRDRLC: 0 ;RELOC OF WRD, MUST COME RIGHT AFTER WRD. +T1: 0 ;TEMP +T2: 0 ;TEMP +PBITS1: 0 ;CURRENT CODE BITS +PBITS2: 0 ;NO OF SPECS LEFT IN CURRENT WORD +PBITS4: 0 ;POINTER TO WHERE CURRENT CODE BITS WILL GO +OPT1: 0 ;POINTER FOR STORING IN BKBUF (OUTPUT BUFFER) +CONTRL: 0 ;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS +CDATBC: 0 ;CURRENT DATA BLOCK CODE TYPE +SCKSUM: 0 ;CKSUM FOR SIMPLE BLOCK FORMAT +IFN A1PSW,[ +PRGC: -1 ;ONE LESS THAN # TIMES END HAS BEEN ENCOUNTERED +OUTN1: -1 ;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED) +OUTC: -1 ;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY +] +LINKL: 0 ;SAVE LIMIT OF GLOTB GETWRD +STRCNT: 0 ;COUNT OF CHARS READ (INCL. DELIM) BY GSYL +STRPNT: 0 ;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE +ISYMF: -1 ;-1 IF ISYMS HAVE NOT BEEN SPREAD +SMSRTF: -1 ;-1 BEFORE SYMTAB IS COMPACTED AND SORTED. + ;AFTER COMPACTING, HOLDS NUMBER OF SYMS THAT WERE THERE BEFORE COMPACTING. +BITP: 0 ;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK +LDCCC: 0 ;DEPTH IN LOADTIME CONDS +PARBIT: 0 ;0 OR 4 FOR : OR = (IN GENERAL, TEMP AT P7X) +LABELF: 0 ;-1 IN COLON, SOMETIMES IN EQUAL. CAUSES 3LABEL TO BE SET. +STGSW: 0 ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS +HKALL: 0 ;NONZERO => HALF-KILL ALL LABELS (.HKALL'S VALUE) +LITSW: 0 ;-1 => USING A LITERAL GIVES AN ERROR +QMTCH: 0 ;-1 => ' AND " NEED MATCHING CLOSINGS (A LA FAIL, MACRO-10) +STARTA: 0 ;STARTING ADDRESS FOR SBLK, RIM, DECSAV +DECSYA: 0 ; ADDRESS TO LOAD SYMBOLS AT (FOR DECSAV FORMAT) +DECBRK: 0 ;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT) +DECBRA: 0 ;LARGEST ABS. ADDR LOADED INTO. +DECBRH: 0 ;LIKE DECBRK BUT FOR ADDRS IN HI SEG. +DECTWO: MOVE ;NOT = MOVE => .DECTWO WAS DONE, AND THIS WD HAS + ;ADDR START OF HISEG. +ISAV: 0 ;I FROM FIELD AT AGETFLD +A.PASS: 0 ; .PASS INTSYM, # OF THIS PASS. +A.PPAS: 0 ;.PPASS INTSYM, # OF PASSES. +WPSTE: NRMWPS ;# WORDS PER SYMTAB ENTRY +WPSTE1: NRMWPS-1;ONE LESS THAN WPSTE - FOR SPEED. +WPSTEB: ,-NRMWPS(B) ;RH HAS - # WORDS PER SYMTAB ENTRY; LH HAS INDEX OF B. +SYMSIZ: 0 ;#WDS IN SYMTAB = WPS* +SYMLEN: SYMMSZ ;SYMTAB SIZE (# SYMS) + ;ASSEMBLED-IN VALUE USED AS DEFAULT, ONLY IF NON-TS. +SYMAOB: 0 ;-<# SYMS>,,0 +INICLB: 0 ;-1 IF INITIALIZATION CODE CLOBBERED. +TTYINS: 0 ;AT START OF ASSEMBLY, -1 => .INSRT TTY PASS1, -2 => PASS2 ALSO. +IFN FASLP,[ +FASBP: 0 ;PNTR TO FASL OUTPUT BUFFER +FASATP: 0 ;PNTR TO FASL ATOM TABLE +FASAT1: 0 ;PNTR TO FASL ATOM TABLE AFTER READING IN NEW ATOM + ; (MAYBE UPDATE FASATP TO THIS IF ATOM WAS UNIQUE9 +FASAT2: 0 ;BYTE PNTR USED TO STORE ATOM IN +FASIDX: 0 ;INDEX NEXT ATOM LOADED INTO FASAT WILL BE +FASPCH: 0 ;AMOUNT OF FASAT "PUNCHED" +FASCBP: 440400,,FASB ;BYTE PNTR TO FASL CODE BIT WORD +FASPWB: 0 ;FASL CODE AT PWRD +FASBLC: 0 ;LOSING BLOCK "COUNT" +FASBLS: 0 ;LOSING BLOCK "SYMBOL" +AFRLD: 0 ;LIST READ CURRENT DEPTH +AFRLEN: 0 ;LIST READ CURRENT LENGTH +AFRDTF: 0 ;LIST READ DOT CONTEXT FLAG (0 NORMAL, 1 SAW DOT, 2 SAW "FROB AFTER DOT" +AFRFTP: 0 ;LIST READ SAVED STATE OF FASATP +AFLTYP: 0 ;TYPE LIST OP IN- 0 EVAL AND THROW AWAY VALUE + ;1 "RETURN" LIST + ;2 "RETURN" VALUE OF LIST +] +PBLK + +;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS + +;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES +;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS. + +;EXITS FROM THE ASSEMBLER: +;TPPB OUTPUT BINARY WORD IN A +;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE + ;SPECIFIED BY B, MAY CLOBBER A AND B +;GO9 RETURN POINT FROM FATAL ERRORS +;TYO TYPE OUT CHARACTER IN A +;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE) +;RCHTBL SEE THE RCH ROUTINES + +;ENTRIES + +;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES +;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P) +;INIT INITIALIZE +;PS1 PASS 1 +;PLOD IF APPROPRIATE, PUNCH OUT LOADER +;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION) +;PSYMS PUNCH OUT SYMBOL TABLE + +;OTHER ENTRIES + +;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE +;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE +;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE +;MIDVRS .FNAM2 OF MIDAS ENGLISH + +;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN + +;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME +;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO +;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO +;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY) + +;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE +;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN, +;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB +;ALSO RCHTBL ONLY EXIT + +;LISTING FEATURE GLOBALS: +;PILPT PRINT CHAR IN A +;LISTON LISTING ON/OFF FLAG, -1 => ON +;LISTP SAME WORD AS LISTON. +;LISTP1 POSITIVE => LIST EVEN ON NON-PUNCHING PASS. +;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT + +;CREF FEATURE GLOBALS: +;CRFOUT OUTPUT WORD IN A. +;CREFP -1 => REQUEST GENERATION OF CREF OUTPUT. +;THE RUBOUT-B-^W HEADER, THE SET-SOURCE-FILE BLOCK, AND THE EOF BLOCK +;ARE THE RESPONSIBILITY OF THE COMMAND PROCESSOR. + +;;RCH ;CHARACTER INPUT ROUTINES + +IFN RCHASW\MACSW,[ + ;SAVE LIMBO1 STATUS AND RH(B) + ;THEN SET UP FOR NEW INPUT MODE (DESCRIPTOR IN A) + ;CALLED BY PUSHEM AND PUSHTT + +PSHLMB: HRL B,LIMBO1 ;LAST CHARACTER INPUT + TLZE FF,FLUNRD ;RE-INPUT CHARACTER ON RETURN? + XCT LSTPLM ;SET B'S SIGN; IF LISTING, JRST PSHLML. +PSHLMN: EXCH A,RCHMOD ;GET OLD MODE IN A + DPB A,[360500,,B] ;STORE IN 5 OF HIGH 6 BITS IN B + PUSH F,B ;SAVE RESULTANT CRUD + CAMN A,RCHMOD ;COMPARE NEW WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + MOVE A,RCHMOD ;NOW GET NEW MODE + JRST PSHLM1 ;SET UP INSTRUCTIONS FOR NEW MODE + +IFN LISTSW,[ +;IF LISTING, LSTPLM HOLDS JRST PSHLML +PSHLML: AOSN PNTSW + JRST PSHLMM ;LAST WAS BREAK CHR + REPEAT 4,IBP PNTBP + SOSA PNTBP +PSHLMM: SETOM LISTBC + TLO B,400000 + JRST PSHLMN +] + + ;UNDO A PSHLMB (NOTE: IN COMMENTS BELOW, "NEW" MODE IS ON PDL, OLD IN RCHMOD) + +POPLMB: POP F,A ;GET WORD THAT PSHLMB PUSHED + HLRZS A ;JUST INTERESTED IN LEFT HALF + TRZE A,400000 ;SIGN BIT SET? + TLOA FF,FLUNRD ;YES, SET FLAG TO RE-INPUT LAST CHAR + TLZA FF,FLUNRD ;NO, CLEAR FLAG. + XCT POPLML ;JFCL\IDPB A,PNTBP ;THE LATTER IFF LISTING. + SETZM LIMBO1 ;INITIALIZE FOR DPB + DPB A,[700,,LIMBO1] ;RESTORE LIMBO1 + LSH A,-<18.-6> ;RIGHT JUSTIFY RCHMOD DESCRIPTOR + CAMN A,RCHMOD ;COMPARE NEW MODE WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + JRST RCHSET ;SET UP FOR NEW MODE AND RETURN +] + +FOO==0 ;INITIALIZE COUNTER FOR FOLLOWING + +DEFINE RCHBLT SIZE,ADR/ + MOVSI T,FOO(A) + HRRI T,ADR + BLT T,-1+ADR +FOO==FOO+ +TERMIN + +DEFINE RCHMOV ADR/ + MOVE T,FOO(A) + MOVEM T,ADR +FOO==FOO+1 +TERMIN + + ;SET UP FOR INPUT OF MODE TYPE SPECIFIED IN A, CLOBBER A ONLY + +RCHSET: MOVEM A,RCHMOD ;STORE NEW RCHMOD +PSHLM1: TLZ FF,FLMAC\FLTTY ;CLEAR FLAGS (MAYBE DEVICE ROUTINE SETS ONE) + XCT RCHTBL(A) ;GET IN A A POINTER TO A DESCRIPTOR TABLE (MAYBE ALSO SET FLAG) + PUSH P,T ;SAVE T, NEED IT FOR TEMP + RCHBLT 3,RCH2 ;FIRST 3 WORDS RCH2 + TLNE FF,FLVOT + JRST POPTJ ;ALL RCH'S TO GO THROUGH RCH, DON'T DO ANYTHING ELSE +MDSST1: RCHBLT 3,RR1 ;NEXT 3 RR1 + RCHMOV RRL1 ;NEXT WORD RRL1 +RCHPSN==FOO ;# WORDS IN ALL TABLES BUT LAST (NOT OF CONSTANT LENGTH) + RCHBLT 6,SEMIC ;LAST N SEMIC +POPTJ: POP P,T + POPJ P, + +IFN LISTSW,[ + ;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH) + +MDSSET: TLO FF,FLVOT ;SET FLAG + MOVEI A,MDSSTB-3 ;SET UP AC + PUSH P,T ;SAVE T FOR RESTORATION + JRST MDSST1 ;NOW SET UP + +MDSSTB: JRST RRL1 ;RR1 + GOHALT + PUSHJ P,RCH ;RREOF + + PUSHJ P,RCH ;RRL1 +IFN .--RCHPSN,.ERR LOSSAGE AT MDSSTB. + PUSHJ P,RCH ;SEMIC + CAIE A,15 + JRST SEMIC + JRST SEMICR + + ;CLEAR OUT DISPLAY MODE + +MDSCLR: TLZ FF,FLVOT ;CLEAR FLAG + MOVE A,RCHMOD + JRST RCHSET ;NOW SET UP FOR REAL IN CURRENT MODE +] ;END IFN LISTSW, + +IFN TS,[ ;TABLE FOR RCHSET, INDEXED BY MODE + ;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE + +RCHTBL: MOVEI A,RCHFIL ;0 => INPUT FROM FILE +IFN MACSW,PUSHJ P,RCHMAC ;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR) +IFN RCHASW,[IFE MACSW,GOHALT + PUSHJ P,RCHTRC ;2 => TTY, QUIT ON CR + PUSHJ P,RCHARC ;3 => TTY, DON'T QUIT ON CR +] + ;TABLE FOR INPUTTING FROM FILE + ;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED + +RCHFIL: ILDB A,UREDP ;GETCHR, GET CHARACTER + CAIG A,14 ;SKIP IF TOO BIG TO BE SPECIAL + XCT RPATAB(A) ;SPECIAL, DO THE APPROPRIATE THING + + JRST RRL1 ;RR1 + GOHALT + PUSHJ P,[ MOVEI A,0 ;^C IN SYMBOL TREATED LIKE A ^@, + JRST INCHR3] ;BUT ALSO SEE IF REALLY END OF BUFFER. THIS GOES IN RREOF. + + ILDB A,UREDP ;RRL1 +IFN .-RCHPSN-RCHFIL,.ERR RCHFIL LOSES. + LDB CH1,[360600,,UREDP] ;SEMIC; FIND WHERE IN ITS WORD UREDP POINTS + IDIVI CH1,7 + JRST @SEMIC3(CH1) ;AND ENTER THE CR-SCANNING LOOP AT THE APPROPRIATE + JFCL ;PLACE (IT IS A WORD-BY-WORD LOOP). + +;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING +;NOTE: MANY OF THESE ROUTINES SUBTRACT 3 FROM THE PC BEFORE RETURNING. +;THE CALLER MUST MAKE SURE THAT THE ILDB UREDP IS WHAT THEY RETURN TO THAT WAY. + +RPATAB: +IFN ITSSW, JFCL ;0, ON I.T.S. IS NORMAL CHARACTER +.ELSE CALL RPANUL ;0, ON DEC SYSTEM, IGNORE IT. + JFCL + JFCL +IFN .-RPATAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB. + PUSHJ P,INCHR3 ;3, EOFCH + REPEAT 6,JFCL + CALL RPALF ;LINE FEED + JFCL ;13 + PUSHJ P,RPAFF ;FORM FEED + JRST SEMICR ;FROM SEMIC ONLY, EXIT FROM LOOP + +RPAFF: SKIPE ASMOUT ;FORM FEED + SKIPL TEXT4 ;ALLOW FORMFEED WITHIN GROUPING ONLY IF IN A TEXT PSEUDO. + CAIA + ETR [ASCIZ/Formfeed within <>, () or []/] + AOS CH1,CPGN + SETOM CLNN +IFN ITSSW,[ + ADD CH1,[SIXBIT /P0/+1] + MOVE CH2,A.PASS + DPB CH2,[300200,,CH1] + .SUSET [.SWHO3,,CH1] ;PUT THE NEW PAGE # IN THE WHO-LINE. +] +RPALF: AOS CH2,CLNN + CAME CH2,A.STPLN + RET + MOVE CH1,CPGN + CAMN CH1,A.STPPG + SETOM TTYBRF + RET + +IFN DECSW\TNXSW,[ +RPANUL: MOVE CH1,@UREDP ;SAW A NULL - IN A LINE NUMBER? + TRNN CH1,1 + JRST RCHTRA ;NO, JUST IGNORE IT. + MOVEI CH1,010700 + HRLM CH1,UREDP ;YES, SKIP THIS WHOLE WORD, THEN + CALL RCH ;SKIP THE 1ST CHAR AFTER THE LINE NUMBER + JRST RCHTRA ;RETURN THE NEXT CHAR FROM THIS CALL TO RCH. +] +] ;END IFN TS, + +VBLK +LIMBO1: 0 ;LAST CHARACTER READ BY RCH +RCHMOD: 0 ;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC. +CLNN: 0 ;1 LESS THAN LINE # IN CURRENT INPUT FILE. +CPGN: 0 ;1 LESS THAN PAGE # IN CURRENT INPUT FILE +A.STPL: 0 ;1 LESS THAN LINE # TO STOP AT. +A.STPP: 0 ;1 LESS THAN PAGE # TO STOP AT. + ;(STOPPING MEANS INSERTING THE TTY) + +;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH) +;CLOBBERS A,CH1,CH2. + +RCH: TLZE FF,FLUNRD + JRST RCH1 ;RE-INPUT LAST ONE +RCH2: GOHALT ;ILDB A,UREDP ;ILDB A,CPTR ;GET CHAR + 0 ;CAIG A,14 ;TRZE A,200 ;CHECK FOR SPECIAL + 0 ;XCT RPATAB(A) ;PUSHJ P,MACTRM ;SPECIAL, PROCESS + MOVEM A,LIMBO1 ;GOT CHAR, SAVE AS LAST CHAR GOTTEN +IFE TS,RCHLS1==JRST TYPCTL +IFN TS,RCHLS1==RET ;DEFAULT CONTENTS OF RCHLST (IF NOT LISTING) +RCHLST: RCHLS1 ;AOSN PNTSW IF LISTING. +IFN LISTSW,[ + PUSHJ P,PNTR + CAIG A,15 + JRST RCHL1 +RCHL3: IDPB A,PNTBP +TYPCTL: POPJ P, ;OR JRST SOMEWHERE +PBLK + +RCHL1: CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + JRST RCHL3 +RCHL2: MOVEM A,LISTBC + SETOM PNTSW + JRST TYPCTL + +VBLK +RCH1: MOVE A,LIMBO1 +RCH1LS: RET ;OR CAILE A,15 IF LISTING. + RET ;NEEDED IN CASE LISTING. + CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + POPJ P, + JRST RCHL2 +PBLK +] ;END IFN LISTSW, + +IFE LISTSW,[ +PBLK +RCH1: MOVE A,LIMBO1 + RET +] ;END IFE LISTSW, + +;;GETSYL ;VARIOUS SYLLABLE READING ROUTINES (BUT NOT ALL OF THEM) + +GSYL: CLEARB SYM,STRCNT +GSYL1: MOVEI D,6 + MOVE T,[440700,,STRSTO] + MOVEM T,STRPNT +GSYL3: AOSG A,STRCNT + JRST (F) + PUSHJ P,RCH + IDPB A,STRPNT ;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1) +A.GSY2: CAIN A,". + JRST GSYL1C + HLRZ CH1,GDTAB(A) + CAIN CH1,(JSP CH2,) + JRST GSYL1A ;NUMBER + PUSHJ P,GSYL1B ;RETURN ONLY ON SYL SEP + HRRZ A,GDTAB(A) + MOVE T,LIMBO1 +C%: POPJ P,"% + +GSYL1B: XCT GDTAB(A) ;POPJ FOR SYL SEPS + SUB P,[1,,1] +GSYL1D: SOJGE D,GSYL3 + AOJA D,GSYL3 + +GSYL1C: ADD SYM,%.SQ(D) + JRST GSYL1D + +GSYL1A: XCT NSQTB-60(A) + JRST GSYL1D + + ;VERSION OF GETSYL TO TRY UNTIL SYL OR WORD TERMINATOR FOUND + ;SKIPS IF NAME THERE (FOR .TYPE, SQUOZE) + +GTSLD2: TLNN C,DWRD\DFLD + JRST GTSLD3 ;DELIMITER IS WORD TERMINATOR, TOLERATE THE NULL SYLLABLE +GETSLD: PUSHJ P,GETSYL ;ENTRY, GET A SYL + MOVE C,CDISP ;GET CDISP + TRNN I,IRSYL + JRST GTSLD2 ;NO SYL + AOS (P) ;GOT SYL, CAUSE RETURN TO SKIP +GTSLD3: TLNN C,DWRD\DFLD + TLO FF,FLUNRD ;CAUSE DELIMITER TO BE RE-INPUT + POPJ P, + +PASSPS: SKIPA A,LIMBO1 +GPASST: CALL RCH + CAIE A,40 + CAIN A,^I + JRST GPASST + RET + +GETSYL: TLZ I,ILUARI+ILNPRC+ILLSRT +GTSL1: CLEARB SYM,NUMTAB ;RECUR HERE FOR RIGHT ARG TO ^ AND _. + MOVE AA,[NUMTAB,,NUMTAB+1] + AOSN NTCLF + BLT AA,NUMTAB+10 ;NUMTAB NOT CLEAR, HAVE TO CLEAR IT + MOVEI D,6 ;CHARACTER COUNTER FOR BUILDING UP SYM + SETOM ESBK ;NO SPECIFIC BLOCK DESIRED. + TDZ I,[ILDECP+ILFLO+ILVAR+ILGLI,,IRPERI+IRLET+IRSYL] +RRL2: PUSHJ P,RR ;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR +SEMICR: ;RETURN HERE FROM SEMIC WITH CR IN A + MOVEM A,LIMBO1 ;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE + HRRZ A,GDTAB(A) ;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB + MOVE C,DTB-40(A) ;GET DTB ENTRY (FLAGS,,JUMP ADR) + MOVEM C,CDISP ;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1) +RR8: TLNE C,DSYL ;NOW SEE IF SYL OPERATOR FLAG SET + JRST (C) ;SET => INTRA-SYLLABLE OPERATOR +RR10: TRNE I,IRLET ;NOT SET => SYLLABLE TERMINATOR: SYL? + POPJ P, ;SYL HAS LETTERS + TRNN I,IRSYL + JRST CABPOP ;NO SYL + CAMN SYM,[SQUOZE 0,.] + JRST PT1 ;SYM IS . + ;NUMBER + +RR5: TLNN I,ILNPRC + PUSHJ P,NUMSL + TLNN I,ILFLO + JRST RR9 ;NOT FLOATING POINT + MOVE A,B ;FLOATING, HIGH IN AA,LOW IN A,EXP IN B + ADDI A,306 ;201+105 TO ROUND + ADDI AA,200 ;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE + JUMPGE AA,.+3 ;NOW CHECK FOR OVERFLOW ON ROUNDING + LSH AA,-1 ;OVERFLOW, SHIFT BACK ONE + AOS A ;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT + EXCH A,AA ;GET EXPONENT IN AA, REST IN A + ASHC AA,-10 ;SHIFT TO MACHINE FLOATING POINT FORMAT + SKIPE AA ;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER + ETR [ASCIZ /Exponent overflow/] +RR9: TLZ I,ILGLI+ILVAR ;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL +CLBPOP: TDZA B,B ;CLEAR OUT B (RELOCATION BITS OF VALUE) +CABPOP: SETZB A,B ;DO JRST CABPOP TO RETURN ZERO AS VALUE + POPJ P, + +RRU: MOVE A,LIMBO1 ;GET HERE WHEN FLUNRD SET AT RR, RETRIEVE CHARACTER FROM LIMBO1 + CAIG A,14 ;IF TOO BIG, + CAIGE A,12 ;OR IF TOO SMALL, + JRST RR1B ;THEN JUST FALL BACK IN + TLNN FF,FLVOT\FLMAC\FLTTY ;SKIP IF NOT HACKING CPGN/CLNN + XCT RRUTAB-12(A) ;HACKING, UNHACK FOR HACK COMING UP + JRST RR1B ;FALL BACK IN + +RRUTAB: SOS CLNN ;LINE FEED (TABLE FOR RRU) + JRST RR1B ;13 + SOS CPGN ;FORM FEED + + ;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER +VBLK +RR: TLZE FF,FLUNRD ;RE-INPUT LAST CHARACTER? + JRST RRU ;YES +RR1: JRST RRL1 ;ILDB A,CPTR ;GET CHAR (" " ") + GOHALT ;TRZE A,200 ;CHECK FOR END OF STRING +RREOF: PUSHJ P,RCH ;PUSHJ P,MACTRM ;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RRU + .SEE RCHTRA ;SPECIAL HANDLING OF UNRCHF IN RCHTRA IF CALLED FROM HERE. +RR1B: XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE) + TROA I,IRLET\IRSYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS + TRO I,IRSYL ;NUMBERS RETURN, SET FEWER FLAGS + SOJGE D,RR1 ;DECREMENT SYM COUNTER AND LOOP + AOJA D,RR1 ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP + +RRL1: PUSHJ P,RCH ;ILDB A,UREDP ;GET CHAR + XCT GDTAB(A) ;NOW MAKE LIKE RR1B (EOFCH => JRST RREOF) + TROA I,IRLET\IRSYL + TRO I,IRSYL + SOJGE D,RRL1 + AOJA D,RRL1 + + ;SEMICOLON (GET HERE FROM RR8) + + JRST SEMICL ;RETURN HERE FROM SEMIC+2 WHEN FLUNRD SET +;NEXT 4 INSNS ALTERED IN DIFFERENT INPUT MODES. SEE RCHFIL, ETC. +SEMIC: PUSHJ P,RCH ;GET CHAR + CAIE A,15 ;SEE IF SPECIAL + JRST SEMIC ;SPECIAL => DO SOMETHING (JRST SEMICR ON CR) + JRST SEMICR ;IF NOT SPECIAL THEN GO BACK FOR NEXT CHAR + +LOC SEMIC+6 ;LEAVE A LITTLE EXTRA ROOM FOR BIG ROUTINES +PBLK + +SEMICL: MOVE A,LIMBO1 ;HERE FROM SEMIC-1, RETRIEVE CHARACTER FROM LIMBO1 + CAIE A,15 ;SKIP IF SHOULD TERMINATE SCAN + JRST SEMIC ;NOT CR, FALL BACK IN + JRST SEMICR ;DONE + +SEMIC2: +REPEAT 5,[ + ILDB A,UREDP + CAIG A,15 + XCT RPATAB(A) +] + MOVE A,[ASCII /@@@@@/] +SEMIC1: AOS CH1,UREDP + MOVE CH1,(CH1) ;ANY CONTROL CHARS IN THE WORD UREDP POINTS AT? + MOVE CH2,CH1 + AND CH1,A + AND CH2,[ASCII/ /] + LSH CH2,1 + IOR CH1,CH2 + CAMN CH1,A + JRST SEMIC1 ;NO, ADVANCE TO NEXT WORD AND TEST IT. + MOVEI A,440700 + HRLM A,UREDP + JRST SEMIC2 ;YES, LOOK AT EACH CHAR AND PROCESS IT. + +SEMIC3: REPEAT 6,JRST SEMIC2+3*<5-.RPCNT> + +;JSP CH2,RR2 => DIGIT (FROM GDTAB) +;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME + +RR2: XCT NSQTB-"0(A) ;UPDATE SQUOZE. + TRNE I,IRLET + JRST 1(CH2) ;SYL IS SYM, DON'T WASTE TIME. + TRNE I,IRPERI + TLO I,ILFLO ;DIGIT AFTER . => FLOATING. +MAKNUM: SETOM NTCLF ;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME + MOVEI AA,2 ;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES +MAKNM1: MOVE T,ARADIX(AA) ;GET THIS RADIX, + CAMN T,ARADIX ;REDUNDANT => SKIP THIS PASS. + JUMPN AA,MAKNM4 + SKIPGE CH1,HIGHPT(AA) + JRST MAKNM3 + MUL T,LOWPT(AA) ;TT HAS OLD LOW TIMES RADIX, T HAS OVFLO TO HIGH. + ADDI TT,-"0(A) ;ADD DIGIT TO LOW PART + TLZE TT,400000 + AOJ T, ;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT + JUMPE CH1,MAKNM5 ;OLG HIGHPT WAS 0 => SAVE TIME. + JFCL 17,.+1 ;NOW CLEAR OV, ETC. + IMUL CH1,ARADIX(AA) ;MULTIPLY HIGHPT BY RADIX + ADD T,CH1 ;ADD HIGH PARTS + JFCL 10,MAKNM2 ;JUMP ON OVERFLOW FROM IMUL OR ADD +MAKNM5: TLNE I,ILFLO + SOS NUMTAB(AA) ;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT + MOVEM T,HIGHPT(AA) ;NOW STORE STUFF BACK + MOVEM TT,LOWPT(AA) +MAKNM4: SOJGE AA,MAKNM1 ;NOW DO ALL THIS FOR NEXT RADIX + JRST 1(CH2) + +MAKNM2: MOVSI B,400000 ;OVERFLOW FROM UPDATING HIGH PARTS + IORM B,HIGHPT(AA) ;SET SIGN BIT +MAKNM3: TLNN I,ILFLO + AOS NUMTAB(AA) ;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS + JRST MAKNM4 + +VBLK +NUMTAB: 0 ;EXPONENT + 0 + 0 +HIGHPT: 0 ;HIGH PART OF CURRENT NUMBER THIS RADIX + 0 ;4.9 => OVERFLOW, TRAILING DIGITS DROPPED + 0 +LOWPT: 0 ;LOW PART OF CURRENT NUMBER THIS RADIX + 0 ;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF + 0 ;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE +ARADIX: 10 ;CURRENT RADIX + 12 + 10 + +NTCLF: -1 ;-1 => NUMTAB NOT CLEAR (TO SAVE BLT AT GETSYL WHEN CLEAR) +PBLK + +;JRST POINT => . (FROM GDTAB) + +POINT: TLO I,ILDECP ;PREFER DECIMAL + TROE I,IRPERI ;SET PERIOD FLAG + TRO I,IRLET ;2 POINTS => NAME + ADD SYM,%.SQ(D) ;UPDATE SYM + JRST 1(CH1) ;RETURN + +RBRAK: SOSL SCNDEP ;IF A CONDITIONAL TO TERMINATE, + JRST RBRAK2 ;HAVE DONE SO, IGNORE CHAR. + SETZM SCNDEP +;CLOSES OF ALL KINDS COME HERE. +RPARN: +GRTHN: MOVE A,LIMBO1 + SKIPE CH1,ASMOUT ;WHAT KIND OF OPEN ARE WE IN? + CAIN CH1,4 ;WITHIN A .ASCII OR + JRST RBRAK1 ;NOT WITHIN GROUPING => THIS CLOSE IS STRAY. + CAME A,ASMOT1(CH1) ;RIGHT KIND OF CLOSE FOR THAT OPEN? + ERJ RBRAK3 +RBRAK4: MOVE CH1,ASMOT2(CH1) + MOVEM CH1,ASMDSP ;ARRANGE FOR THIS ASSEM1 LEVEL TO EXIT +RBRAK5: SETZM CDISP + JRST RR10 ;AND GO TERMINATE WORD. + +RBRAK3: CALL TYOERR ;COME HERE ON CLOSE WRONG FOR OPEN. + ;(EG, ")" MATCHING "<"). + TYPR [ASCIZ/ Seen when /] + MOVE A,ASMOT1(CH1) + CALL TYOERR + TYPR [ASCIZ/ expected +/] + JRST RBRAK4 + +RBRAK1: CAIN CH1,4 ;CLOSE INSIDE A .ASCII => + JRST RBRAK5 ;TERMINATE WORD BUT DON'T CLOSE ANYTHING. + SKIPN CONSML ;COME HERE FOR STRAY CLOSE. + JRST RRL2 + ERJ .+1 + TYPR [ASCIZ/Stray /] + MOVE A,LIMBO1 ;GET THE CLOSE WE SAW. + CALL TYOERR + CALL CRRERR + JRST RRL2 + +;COME HERE FOR CLOSE-BRACE, AND CERTAIN CLOSE-BRACKETS. +RBRAK2: SETOM A.SUCC ;HAVE JUST ENDED SUCCESSFUL BRACKETED CONDIT, + JRST RRL2 ;REMEMBER THAT MOST RECENT CONDITIONAL WAS TRUE. + +FORMF: TLNN FF,FLVOT\FLMAC\FLTTY ;FORM FEED SYLLABLE OPERATOR ROUTINE + PUSHJ P,RPAFF ;UNLESS ALREADY DONE, INCREMENT PAGE #. + JRST RR10 + +LINEF: TLNN FF,FLVOT\FLMAC\FLTTY ;LINE FEED SYLLABLE OPERATOR ROUTINE + CALL RPALF + JRST RR10 + +CTLAT: +IFN DECSW\TNXSW,[ + TLNN FF,FLVOT\FLMAC\FLTTY ;^@ SYLLABLE OPERATOR ROUTINE. + CALL RPANUL +] + JRST RRL2 + +;DECIPHER A VALUE FROM NUMTABS +;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B +;AND RADIX USED IN D. + +NUMSL: TLNN I,ILVAR\ILDECP\ILFLO + SKIPE B,HIGHPT + JRST NUMSLS + MOVE A,LOWPT ;BE VERY FAST IN CASE OF SMALL FIXNUM IN CURRENT RADIX. + MOVE D,ARADIX ;SAVE RADIX AND HIGH PART FOR ^. + SETZ AA, + RET + +NUMSLS: CLEARB TT,D ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC. + TLNE I,ILDECP+ILVAR ;NEITHER . NOR ', CURRENT RADIX. + TLNE I,ILGLI ;" => CURRENT RADIX DESPITE . OR '. + JRST NUMSL0 + MOVEI D,1 ;DECIMAL UNLESS ' + TLNE I,ILVAR ;WHICH FORCES OCTAL. + MOVEI D,2 + MOVE A,ARADIX(D) + CAMN A,ARADIX ;IF REALLY SAME AS CURRENT RADIX, + MOVEI D,0 ;COMPUTATION WASN'T DONE FOR THIS VALUE OF D, + ;SO USE COMPUTATIONS DONE FOR CURRENT RADIX. +NUMSL0: MOVE AA,HIGHPT(D) ;AA := HIGH PART + MOVE B,LOWPT(D) ;B := LOW PART + MOVE T,NUMTAB(D) ;T := EXPONENT + MOVE D,ARADIX(D) ;NO LONGER NEED IDX, GET RADIX VALUE. + TLNN I,ILFLO + JRST FIXNUM ;NOT FLOATING + TLZ AA,400000 ;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW +NUMC1: JUMPN AA,.+2 ;ENTRY FROM UPARR + JUMPE B,FIX0 ;COMPLETELY ZERO => RETURN FIXED ZERO + JUMPL T,NUMSL1 ;JUMP IF EXPONENT NEGATIVE + JUMPE T,NUMSL2 ;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO + ;EXPONENT POSITIVE, DO THE APPROPRIATE THING +NUMSL5: MULI B,(D) ;MULITIPLY LOW PART BY RADIX + MULI AA,(D) ;MULTIPLY HIGH PART BY RADIX + ADD A,B ;A := LOW PART OF HIGH + HIGH PART OF LOW + TLZE A,400000 + ADDI AA,1 ;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH + MOVE B,C ;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B +NUMSL3: JUMPE AA,NUMSL4 ;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE + ASHC A,-1 ;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1 + ASH A,1 + ASHC AA,-1 + AOJA TT,NUMSL3 ;INCREMENT BIT EXPONENT AND TRY AGAIN + +NUMSL4: MOVE AA,A ;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA + SOJG T,NUMSL5 ;COUNT DOWN + +NUMSL2: TLNN I,ILFLO + JRST NUMSL9 ;NOT FLOATING, DON'T WASTE TIME NORMALIZING. + SKIPA A,B ;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A +NUMSL7: ASHC AA,1 ;NOW NORMALIZE + TLNN AA,200000 + SOJA TT,NUMSL7 + SKIPA B,TT ;DONE NORMALIZING, RETURN BINARY EXPONENT IN B +PT1: TRO I,IRLET + POPJ P, + +NUMSL9: MOVE A,B + MOVEI B,0 + ASHC AA,(TT) ;SHIFT 2-WD NUM. BY EXPONENT, + LSH A,1 ;PUT HIGH BIT IN WITH REST. + JRST FIX1 + +FIX0: TLZ I,ILFLO +FIXNUM: LSHC A,45 +FIX1: LSHC AA,-1 + JUMPE AA,.+2 + ETR [ASCIZ /FIXNUM too big for 36 bits/] + POPJ P, + +NUMSL1: SKIPA A,B ;EXPONENT NEGATIVE: NORMALIZE NOW +NUMSL8: ASHC AA,1 +NUMSL6: TLNN AA,200000 + SOJA TT,NUMSL8 ;NOT NORMALIZED YET + AOS T + MOVEI TM,(D) + TLNN TM,-1 ;GET CONVIENT POWER OF RADIX + JUMPL T,[ IMULI TM,(D) + AOJA T,.-1] + MOVE B,A ;GET NORMALIZED LOW PART IN B + IDIV AA,TM ;DIVIDE HIGH PART BY APPROPRIATE RADIX + DIV A,TM + JUMPL T,NUMSL6 + MOVE B,A + JRST NUMSL2 + +UPARR: TRON I,IRSYL + JRST UPCTRC ;"UNARY UPARROW" => GOBBLE CHARS + TRNE I,IRLET + ETR [ASCIZ /Symbolic 1st arg to "^"/] + PUSHJ P,NUMSL ;DECIPHER NUMTABS + PUSHJ P,UA3 ;GET RIGHT OPERAND IN T + MOVE TT,B ;EXPONENT + MOVE B,A ;LOW PART + PUSHJ P,NUMC1 ;T EXP HIGH IN AA LOW IN B TT BIN EXP + MOVE C,CDISP ;IF A _ WAS DEFERRED WHILE ILUARI WAS SET, + TLO I,ILNPRC + CAME C,[DSYL,,BAKAR] ;DO IT NOW. + JRST RR10 + +BAKAR: TLNE I,ILUARI + JRST RR5 ;RETURN TO UPARROW (WILL COME BACK HERE LATER) + TRNE I,IRSYL + TRNE I,IRLET + JRST BAK1 ;NO SYL, OR SYL IS NAME + CAMN SYM,[SQUOZE 0,.] + JRST BAK1 ;. ALSO NAME + TLZN I,ILNPRC + PUSHJ P,NUMSL + PUSHJ P,UA3 + ADD B,T + ASHC AA,(B) + LSH A,1 + LSHC AA,-1 + CLEARB B,AA + TLZ I,ILFLO + MOVE C,[DFLD,,CBAKAR] + EXCH C,CDISP ;IF 2ND ARG ENDED WITH A _, TURN INTO FIELD OP. + CAME C,[DSYL,,BAKAR] + EXCH C,CDISP + POPJ P, + +UPCTRC: SETZ T, +UPCTR1: JSP F,QOTCOM ;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + CAIL A,140 + SUBI A,40 + ANDI A,77 ;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS + ADD T,A ;ADD TO ACCUMULATED + POPJ P, + +BAK1: MOVE TT,[DFLD,,CBAKAR] + MOVEM TT,CDISP + JRST RR10 + +UA3: HRLM D,(P) ;SAVE RADIX (FOR UPARR) + JSP LINK,SGTSY ;PUSH I,AA,A,B + TLO I,ILUARI ;TELL _ TO WAIT TILL LATER (SEE UPARR, BAKARR) + PUSHJ P,RCH + CAIN A,"- + TROA I,IRGMNS + TLO FF,FLUNRD + PUSHJ P,RCH + CAIN A,"< + JRST UAR1 + TLO FF,FLUNRD +UA3L: PUSHJ P,GTSL1 ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE + TRNE I,IRLET + JRST UA3S ;NAME + TLNE I,ILFLO + ETR [ASCIZ /Floating point 2nd arg to "_"/] +UAR2: TRZN I,IRGMNS + SKIPA T,A + MOVN T,A + JSP LINK,SGTSY1 ;RESTORE GETSYL TEMPS. + HLRZ D,(P) + POPJ P, + +UA3S: PUSHJ P,GETVAL ;MAKE NUMBER_NAME WORK + JRST UA3SR ;GOT VALUE, PROCESS + JRST UA3L ;NO VALUE, TRY AGAIN + +UAR1: TLO I,ILLSRT + TRZ I,IRSYL ;(OR ELSE LSSTH GIVES NOS ERROR.) + SETZB A,B + PUSHJ P,LSSTH +UA3SR: JUMPN B,RLCERR ;RELOC ERR + JRST UAR2 + +ATSGN: MOVSI A,20 ;ATSIGN + IORM A,WRD + TRO I,IRFLD ;SET IRFLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE + ; ^ CHANGED FROM SYL TO FIELD 9/6/70 + JRST RRL2 ;FALL BACK IN + +DQUOTE: TRON I,IRSYL + JRST DQUOT8 + TRNN I,IRLET ;AFTER NUMBER => CURRENT RADIX. + JRST DQUOT7 + PUSHJ P,RCH + TLO FF,FLUNRD ;NEXT CHAR. SQUOZE? + HLRZ A,GDTAB(A) + CAIN A,(POPJ P,) + JRST DQUOT7 ;NO => MAKE PREV. SYM. GLOBAL. + CAMN SYM,[SQUOZE 0,.M] ;SPECIAL BLOCK NAMES + JRST DQUOTM ;.M MEANS MAIN BLOCK, + CAMN SYM,[SQUOZE 0,.U] + JRST DQUOTU ;.U MEANS SUPERIOR. + CAMN SYM,[SQUOZE 0,.C] + JRST DQUOTC ;.C MEANS CURRENT BLOCK. + SKIPGE A,ESBK ;GET SPEC'D BLOCK OR CURRENT, + HRR A,BKCUR ;LOOK FOR SUBBLOCK OF THAT BLOCK. + HLL A,BKTAB+1(A) + ADD A,[1,,] ;LH HAS LEVEL SUBBLOCK OUGHT TO HAVE. + MOVEI T,0 + SETO D, ;NO POSSIBLE ALTERNATE CHOICE YET. +DQUOT0: CAME SYM,BKTAB(T) ;LOOK AT ALL BLOCKS SEEN. + JRST DQUOT1 ;HAS THE NAME WE'RE LOOKING FOR? + SKIPGE ESBK ;IF LOOKING FOR A SUBBLOCK OF A PARTICULAR BLOCK, + JRST DQUOT4 + CAMN A,BKTAB+1(T) + JRST DQUOT2 ;SUCH A BLOCK WINS; ALL OTHERS LOSE. + JRST DQUOT1 + +DQUOT4: SKIPN BKTAB+2(T) ;ELSE PREFER DEFINED BLOCKS TO UNDEFINED ONES. + JUMPGE D,DQUOT1 + SKIPE BKTAB+2(T) + JUMPL D,DQUOT5 + CAME D,[-1] ;THAT'S THE SAME EITHER WAY => PREFER AN INFERIOR + CAMN A,BKTAB+1(T) ;OF THE CURRENT BLOCK TO ONE THAT'S NOT. + JRST DQUOT5 + JRST DQUOT1 + +DQUOT5: HRROI D,(T) ;FOUND A BLOCK WE LIKE BEST SO FAR. + SKIPE BKTAB+2(T) + ANDI D,-1 ;LEAVE SIGN OF D SET UNLESS THE BLOCK IS DEFINED. +DQUOT1: ADDI T,BKWPB + CAMGE T,BKTABP + JRST DQUOT0 + HRRZI T,(D) ;NOW USE THE BEST BLOCK FOUND, IF THERE WAS ONE. + CAIE T,-1 + JRST DQUOT2 + MOVE T,BKTABP ;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY. + CAIL T,BKTABS + ETF ERRTMB ;NO ROOM FOR MORE BLOCKS. + MOVEM SYM,BKTAB(T) + MOVEM A,BKTAB+1(T) ;ADD BLOCK AT END. + MOVEI A,BKWPB(T) + MOVEM A,BKTABP ;POINTS AFTER LAST USED ENTRY. +DQUOT2: MOVEM T,ESBK + SETZ SYM, +DQUOT3: MOVEI D,6 ;NEXT CHAR GOES IN 1ST SQUOZE POS. + JRST RRL2 + +DQUOTM: MOVEI T,BKWPB ;.M - MAIN BLOCK FOLLOWS INITIAL SYMS BLOCK. + JRST DQUOT2 + +DQUOTU: SKIPGE T,ESBK ;.U SPEC'D - GET SPEC'D OR CURRENT BLOCK, + MOVE T,BKCUR + HRRZ T,BKTAB+1(T) + JRST DQUOT2 ;SPEC. ITS SUPERIOR. + +DQUOTC: SKIPGE T,ESBK ;.C => SPEC THE CURRENT BLOCK. + MOVE T,BKCUR + JRST DQUOT2 + +SQUOT1: TLOA I,ILVAR +DQUOT7: TLO I,ILGLI + MOVE A,BKCUR ;IF NO SPEC'D BLOCK, + SKIPGE ESBK + MOVEM A,ESBK ;SPEC. CURRENT BLOCK. + JRST RRL2 + +DQUOT8: SETZ T, +DQUOT9: JSP F,QOTCON ;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + ADD T,A ;ADD IN ASCII CHARACTER IN A + POPJ P, ;RETURN TO SOMETHING + +SQUOTE: TROE I,IRSYL + JRST SQUOT1 + SETZ T, +SQUOT9: JSP F,QOTCON ;SIXBIT SYL + CAIGE A,40 + ETR ERRN6B ;NOT SIXBIT + CAIL A,140 + SUBI A,40 ;CONVERT TO UPPER CASE + LSH T,6 ;SHIFT OVER ACCUMULATED VALUE + ADDI T,-40(A) ;ADD IN SIXBIT FOR CHARACTER IN A + POPJ P, + +;COMMON ROUTINE FOR RIGHT JUSTIFIED TEXT SYLS +;CALLED WITH JSP F,; ROUTINE PUSHJ'S BACK W/ CHAR IN T, ACCUM VALUE IN A +;SYL FLAG EXPECTED TO BE ALREADY SET +QOTCON: SKIPE QMTCH ;' AND " COME HERE, BUT NOT ^: IF IN QUOTES-MATCHING MODE, USE A + JRST QOTCO4 ;FAIL-LIKE ALGORITHM. HERE FOLLOWS THE OLD MIDAS WAY OF DOING IT +QOTCOM: CALL RCH ;USE AT LEAST 1 CHAR IN ANY CASE. + JRST QOTCO1 + +QOTCO2: CALL RCH ;USE SUCCEEDING CHARS IF SQUOZE CHARS. + HLRZ CH1,GDTAB(A) + CAIN CH1,(POPJ P,) + JRST QOTCO3 +QOTCO1: CALL (F) + JRST QOTCO2 + +QOTCO3: CAIN A,"" ;NONSQUOZE: IF IT IS A TEXT SYL INDICATOR, + JRST DQUOT9 ;CONTINUE WITH WHATEVER TYPE OF TEXT + CAIN A,"' + JRST SQUOT9 ;IT INDICATES. + CAIN A,"^ + JRST UPCTR1 +QOTCO6: TLO FF,FLUNRD + JRST TEXT5 + +QOTCO4: MOVE B,LIMBO1 ;GET ' OR ", WHICHEVER STARTED THIS SYL, AS THE DELIMITER. + MOVE SYM,[SQUOZE 0,TEXT] + JSP TM,ERMARK +QOTCO5: CALL RCH + CAMN A,B ;FOUND ANOTHER EXAMPLE OF THE DELIMITER? + JRST [ CALL RCH ;IF DUPLICATED, IT PUTS THE DELIMITER IN THE CONSTANT. + CAMN A,B + JRST .+1 + JRST QOTCO6] ;OTHERWISE UNREAD THE CHAR AFTER THE DELIMITER AND EXIT. + CALL (F) ;HAVE CHAR TO PUT IN STRING IN A; GO MERGE IT IN. + JRST QOTCO5 + +;RETURN A VALUE FROM A PSEUDO WHOSE ARGS CAN BE TERMINATED BY EITHER COMMA (GOBBLED) +;OR CR (NOT GOBBLED). +VALRET: MOVE T,A ;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL + MOVE B,CDISP ;GET STORED DISPATCH CODE + TLNN B,DWRD\DFLD + JRST VALR1 ;WORD TERMINATOR +;COME HERE TO RETURN A VALUE, AND ALSO +;BARF IF THE NEXT CHARACTER ISN'T A SYLLABLE SEPARATOR +TEXT5: PUSH P,T ;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T + PUSHJ P,GETSYL ;SEE IF IMMEDIATELY FOLLOWED BY SYL + TRNE I,IRSYL + ETR ERRNOS ;NO SEPARATOR BETWEEN TWO VALUES + POP P,A ;RESTORE VALUE TO RETURN +VALR1: TRO I,IRSYL + JRST CLBPOP + +;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK, + +SGTSY: PUSH P,I + PUSH P,AA + PUSH P,A + PUSH P,B + JRST (LINK) + +SGTSY1: POP P,B + POP P,A + POP P,AA + POP P,I + JRST (LINK) + +;JSP LINK,SAVWD1 TO SAVE STUFF FOR < OR (, ETC. + +SAVWD1: PUSH P,A ;SYLL. BEFORE GROUPING NOW STARTING. + PUSH P,B ;AND ITS RELOC. + +SAVWLD: PUSH P,FORMAT + PUSH P,FORPNR + PUSH P,FLDCNT + PUSH P,GLSP2 + PUSH P,I + PUSH P,WRD + PUSH P,WRDRLC + PUSH P,SYM + PUSH P,PPRIME + PUSHJ P,(LINK) +SAVL1==. + +;POP OFF WHAT PUSHED BY SAVWLD. CLEARS FLUNRD, IN CASE THE > OR ) WAS UN-READ. + +USVWLD: POP P,SYM + HRRZS SYM + CAIE SYM,SAVL1 + GOHALT + TLZ FF,FLUNRD + POP P,PPRIME + POP P,SYM + POP P,WRDRLC + POP P,WRD + TDZ I,[-1-(ILWORD)] + IOR I,(P) + POP P,1(P) + POP P,GLSP2 + POP P,FLDCNT + POP P,FORPNR + POP P,FORMAT + JRST (LINK) + +;;GETFD ;GET FIELD (EXPRESSION); RETURN VALUE IN A, RELOC BITS IN B + + ;GET FIELD FOR PSEUDO + ;SYM SHOULD CONTAIN THE SQUOZE NAME OF THE PSEUDO + ;OR A POINTER TO AN INSN TO EXECUTE WHEN UNDEF + ;SYMBOL SEEN. SYM IS NOT CLOBBERED. + +AGETFD: PUSH P,I ;SAVE I + TRO I,IRPSUD+IRNOEQ ;SET FLAG TO GETVAL TO EXECUTE GTVER ON UNDEFINED SYM ON EITHER PASS + PUSH P,GTVER ;OLD VALUE OF GTVER + MOVEM SYM,GTVER ;ERROR MSG SHOULD GIVE NAME OF PSEUDO. + CALL YGETFD + MOVE SYM,GTVER + REST GTVER + MOVEM I,ISAV ;SAVE FLAGS FOR FIELD GOTTEN +POPIJ: POP P,I + POPJ P, + +;READ A FIELD, NOT PART OF THE CURRENT WORD. +YGETFD: PUSH P,WRD + SETZM WRD + CALL XGETFD + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + ADD A,WRD ;ADD IN INDEX, INDIRECT FIELDS + POP P,WRD + POPJ P, + +IFN FASLP,[ +FAGTFD: PUSHJ P,AGETFD ;DO AGETFD, COMPLAIN IF RELOCATABLE OR GLOBAL + MOVE TM,GLSP1 + CAMN TM,GLSP2 + SKIPE B + ETSM [ASCIZ /relocatable or external argument/] + POPJ P, +] +;READ A FIELD PART OF CURRENT WORD (FOR XWD, ETC). +XGETFD: PUSH P,PPRIME +AGTFD3: PUSHJ P,GETFLD + MOVE CH1,CDISP + TLNN CH1,DWRD + TLOA FF,FLUNRD ;DELIMITER IS WORD TERMINATOR => RE-READ IT. + TRNE I,IRFLD ;NON-NULL FIELD SUPPLIED => RETURN IT. + JRST AGTFD4 + HRRZ C,CDISP ;ELSE COMMA => RETURN NULL VALUE (0) + CAIN C,SPACE ;SPACE => TRY AGAIN TO READ A FIELD. + JRST AGTFD3 ;NO FIELD, TRY AGAIN +AGTFD4: REST PPRIME + POPJ P, + + ;IN RELOCATABLE FORMAT + ;READ FIELD AND COPY OUT AS WORD + +RGETFD: SETZM WRD ;FIRST INITIALIZE SOME STUFF AS THOUGH AT GETWD + SETZM WRDRLC + MOVE A,GLSPAS + MOVEM A,GLSP1 + MOVEM A,GLSP2 + CALL XGETFD + ADDM A,WRD + ADDM B,WRDRLC + PUSHJ P,PWRDA ;OUTPUT WORD + TLNE I,ILMWRD + JRST IGTXT ;SOAK UP MULTI-WORD FIELD + POPJ P, + +;READ IN A FIELD, RETURN IN A,B SETTING IRFLD IF FIELD NOT NULL. +GETFLD: PUSH P,GLSP1 ;REFERED TO AS GETFLB(P) WHEN ONLY 1 SYL PUSHED. + MOVEM P,PPRIME + TRZ I,IRFLD+IROP +GETFD1: TLNE I,ILMWRD + JRST GETFD9 ;MULTIPLE WORD, RE-CALL PSEUDO + PUSHJ P,GETSYL + TRNE I,IRLET +GETFD9: PUSHJ P,GETVAL ;GET OPERAND (MAYBE SKIPS) +GETFD6: SKIPA C,CDISP ;GET INFO ON SYLLABLE TERMINATOR + JRST GETFD1 ;GETVAL SKIPPED => PSEUDO/MACRO WITH NO VALUE, TRY AGAIN + TLNE C,DFLD + JRST (C) ;FIELD OPERATOR, GO PROCESS + TRNE I,IRSYL ;NO DISP MEANS FIELD TERMINATOR. + TRO I,IRFLD + CAME P,PPRIME ;IF ANY OPERATORS PUSHED, + JSP LINK,GETFD8 ;EVAL THEM. + SUB P,[1,,1] ;FLUSH GLSP1 SAVED AT GETFLD. + RET + +GETFD8: MOVEI TT, ;END OF FIELD HAS VERY LOW PRIORITY. + JRST GETFD7 + +;PUSH AN OPERATOR, MAYBE EVALLING STUFF TO LEFT. +;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS, +;C ADR OF ROUTINE TO PERFORM OPERATION, LH OF TT HAS PRECEDANCE OF OPERATOR + +GETFDL: MOVEI LINK,GETFD3 ;AFTER MAYBE EVALLING, GO PUSH OPERATOR. + TRO I,IRFLD+IROP + TRNN I,IRSYL + JRST GETFD5 ;UNARY, EVAL NOTHING, JUST PUSH WITH HIGH PRIO. +GETFD2: CAME P,PPRIME ;NO OPS TO LEFT => NOTHING TO EVAL. + CAMLE TT,GETFLP(P) ;COMPARE PRIO OF PREV. OP. AND CURRENT. + JRST (LINK) ;WAIT UNTIL LATER +GETFD7: HRRZ T,GETFLP(P) ;EVAL THE LAST OP ON STACK. + JRST (T) ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4) +GETFD4: SUB P,[4,,4] + JRST GETFD2 + +GETFD5: MOVSI TT,200 ;GIVE UNARY OP HIGH PRIO. TO DO BEFORE NEXT BINARY. +GETFD3: PUSH P,B ;GETFLR(P) + PUSH P,A ;GETFLV(P) + HLL C,TT + PUSH P,C ;GETFLP(P) + PUSH P,GLSP1 ;GETFLG(P) + JRST GETFD1 + +GETFLB==,-4 ;PDL IDX OF GLSP1 BEFORE LEFT OPERAND. +GETFLR==,-3 ;PDL IDX OF RELOC OF LEFT OPERAND. +GETFLV==,-2 ;PDL IDX OF VALUE OF LEFT OPERAND. +GETFLP==,-1 ;PDL IDX OF PRIO,,DISPATCH +GETFLG==0 ;PDL IDX OF GLSP1 AFTER LEFT OPERAND (=BEFORE RIGHT) + +PLS: MOVEI C,PLS1 ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION +MINUS2: MOVSI TT,10 ;SET UP PRECEDENCE OF 10 FOR +, - + JRST GETFDL + +MINUS: JSP C,MINUS2 ;MINUS SIGN + MOVNS A ;NEGATE VALUE OF RIGHT OPERAND + MOVNS B ;ALSO RELOCATION +;433 This instr was causing [foo] and [-foo] to be mistakenly +; constants-optimized to the same thing during pass1, resulting in a +; "more constants on pass2 than pass1" error. +; JUMPGE FF,PLS1 + MOVE T,GETFLG(P) + PUSH P,B + HRLZI B,MINF + PUSH P,C + PUSHJ P,LNKTZ ;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND + POP P,C + POP P,B +PLS1: ADD A,GETFLV(P) ;ADD VALUES + ADD B,GETFLR(P) ;ADD RELOCATIONS + JRST GETFD4 + +LNKTZ: TDZA C,C +LNKTC1: MOVE T,GLSP2 +LINKTC: CAML T,GLSP1 + POPJ P, + SKIPL 1(T) + XORM B,1(T) + SKIPL 1(T) + IORM C,1(T) + AOJA T,LINKTC + +MULTP: MOVEI C,MULTP1 ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION +DIVID2: MOVSI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION + JRST GETFDL + +MULTP1: SKIPL CONTRL ;ELSE IN DECREL ASSEMBLY, TEST FOR EXTERNALS. + JUMPGE FF,MULTR + MOVE D,GETFLB(P) ;ACTUALLY, GET HERE FOR ABS ASSEMBLIES TOO, BUT SO WHAT? + CAMN D,GLSP1 + JRST MULTR + SKIPGE FF + ETR [ASCIZ /Externals multiplied/] + TLO I,ILNOPT ;DON'T OPTIMIZE LITERALS CONTAINING UNDEFS ON PASS 1. +MULTR: JUMPE B,MULTP3 ;JUMP ON RIGHT OPERAND NOT RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;BOTH OPERANDS RELOCATED + MOVE T,GETFLV(P) ;GET VALUE OF LEFT OPERAND AND FALL IN + JRST MULTP5 + +MULTP3: MOVE T,A ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T + MOVE B,GETFLR(P) ;RELOCATION BITS OF LEFT OPERAND +MULTP5: MOVE D,GETFLG(P) ;GLOTB POINTER TO BETWEEN OPERANDS + CAME D,GETFLB(P) + JRST GMUL1 ;LEFT OPERAND HAS GLOBALS + CAME D,GLSP1 + JRST GMUL2 ;RIGHT OPERAND HAS GLOBALS + ;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER +GMUL4: IMUL A,GETFLV(P) ;MULTIPLY VALUES + IMULB B,T ;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER + TRZ T,1 + SKIPL CONTRL ;EXCEPT IN STINK ASSEMBLY, OBJECT TO RELOCATION + JRST GETFD4 ;OTHER THAN 0 OR 1 (ONLY AFFECTS DECREL, SINCE + JUMPE T,GETFD4 ;RELOCATION CAN'T BE NONZERO IN ABS ASSEMBLY). +MULTP4: ETR [ASCIZ+Relocatable arg to * or / or Boolean+] + JRST GETFD4 + +GMUL1: TLNE FF,FLPPSS ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND + CAMN D,GLSP1 + SKIPA CH1,A ;LOOKS OK, GET VALUE IN CH1 + ETR [ASCIZ /Multiplying two externals/] + SKIPA D,GETFLB(P) ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND +GMUL2: MOVE CH1,GETFLV(P) ;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND +GMUL3: CAML D,GLSP1 + JRST GMUL4 ;TABLE COUNTED OUT + SKIPGE 1(D) + AOJA D,GMUL3 + JUMPE CH1,GMUL5 ;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK + LDB CH2,[221200,,1(D)] ;PICK UP MULTIPLICATION FIELD THIS GLOBAL + SKIPN CH2 + MOVEI CH2,1 ;0 => 1 + IMUL CH2,CH1 + CAIN CH2,1 + MOVEI CH2,0 ;IF ONE THEN USE ZERO + DPB CH2,[221200,,1(D)] + AOJA D,GMUL3 + + +GMUL5: CLEARM 1(D) + AOJA D,GMUL3 + +DIVID: JSP C,DIVID2 ;SLASH, PRECEDENCE = 20 +DIVID1: JUMPN B,MULTP4 ;JUMP IF RIGHT OPERAND RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;LEFT OPERAND RELOCATED + EXCH A,GETFLV(P) + IDIV A,GETFLV(P) + MOVEI B,0 + MOVE D,GETFLB(P) + CAMN D,GLSP1 ;IF THERE ARE EXTERNALS OR UNDEFINED SYMBOLS, + JRST GETFD4 + SKIPGE FF ;ON PUNCHING PASS IT'S AN ERROR. + ETR [ASCIZ /Division involving externals/] + TLO I,ILNOPT ;ON PASS 1, DON'T OPTIMIZE THIS IF IN A LITERAL. + JRST GETFD4 + + ;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30) + +ANDF: MOVSI TT,40 ;& + JSP C,GETFDL + JSP D,LOGIC1 ;GO DO IT + AND A,GETFLV(P) ;INSTRUCTION ARGUMENT TO LOGIC1 + +XORF: MOVSI TT,34 ;# + TRNN I,IRSYL ;IF ABOUT TO BE UNARY, + MOVNI A,1 ;THEN TURN LEFT OPERAND INTO -1 + JSP C,GETFDL + JSP D,LOGIC1 + XOR A,GETFLV(P) + +IORF: MOVSI TT,30 ;\ + JSP C,GETFDL + JSP D,LOGIC1 + IOR A,GETFLV(P) + + ;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS + +LOGIC1: JUMPN B,MULTP4 ;NO RELOCATION ALLOWED + SKIPE GETFLR(P) ;NOW CHECK RELOCATION OF LEFT OPERAND + JRST MULTP4 + XCT (D) ;ALL TESTS PASSED, DO IT + MOVE D,GETFLB(P) ;ARE THERE ANY GLOBALS OR UNDEFINED SYMBOLS? + CAMN D,GLSP1 + JRST GETFD4 ;NO. + SKIPGE FF ;YES. ON THE PUNCHING PASS, THAT'S AN ERROR. + ETR [ASCIZ /External in arg to \, & or #/] + TLO I,ILNOPT ;ON PASS 1, JUST DON'T OPTIMIZE IF IN LITERAL. + JRST GETFD4 + +CBAKAR: MOVSI TT,100 ;BACKARROW AS FIELD OPERATOR, PREC = 100 + JSP C,GETFDL ;RETURN TO GETFLD TO READ 2ND ARGUMENT. + JSP D,LOGIC1 ;FOR EVALUATION, CALL LOGIC1 + JSP D,.+1 ;WHICH EXECUTES THIS INSTRUCTION, + MOVE T,A ;TO CALL THIS SUBROUTINE. + MOVE A,GETFLV(P) + LSH A,(T) + JRST (D) + +;D SHOULD HAVE 1 FOR <, 2 FOR (, 3 FOR [ ;] +LSSTH9: JSP LINK,SAVAS1 ;SAVE ASSEM1 PDL LEVELS, .BYTE MODE, ETC. + MOVEM D,ASMOUT ;SAY WHAT KIND OF OPEN WE JUST DID + JRST ASSEM3 ;REENTER ASSEM1 LOOP AT INNER LEVEL. + +;COME HERE TO EXIT FROM AN ASSEM1 LEVEL THAT WAS ENTERED BY LSSTH9. +LSSTHA: SKIPE BYTM ;IN BYTE MODE, DO .WALGN. SINCE ASMDSP + JRST A.BY3 ;STILL POINTS HERE, WE'LL COME BACK. + MOVE P,CONSTP + JSP T,CONNDP ;POP STUFF SAVED BY SAVAS1 + MOVE A,WRD ;RETURN THE WORD IN THE GROUPING + MOVE B,WRDRLC ;(OUR CALLER WILL USVWLD, CLOBBERING WRD) + POPJ P, + +LSSTH: MOVEI D,1 ;1 FOR <. + JSP LINK,SAVWD1 + PUSHJ P,LSSTH9 +LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUTPREVIOUS SYLL. + +;GROUPINGS EXCEPT (PARENS THAT ADD TO WORD) +;SYLL IMMEDIATELY BEFORE OR AFTER IS ERROR. +LSSTH2: ADDM A,-1(P) ;SYLL BEFORE GROUPING, PUSHED BY SAVWD1. + ADDM B,(P) + TRNE I,IRSYL ;IF WAS SYLL BEFORE GROUPING, ERROR. + ETR ERRNOS +LSSTH5: MOVE A,LIMBO1 ;CHECK FOR FOLLOWING SYLL. + CAIE A,15 + CAIN A,12 + JRST LSSTH6 ;DELIMITER CR OR LF + PUSHJ P,RCH ;NOT CR OR LF, GET NEXT CHAR + CAIN A,"! ;IGNORE EXCLAMATION POINT + JRST .-2 + TLO FF,FLUNRD ;CAUSE IT TO BE RE-INPUT + HLRZ CH1,GDTAB(A) + CAIE CH1,(POPJ P,) + JRST LSSTH4 ;SQUOZE CHAR. MEANS FOLLOWING SYLL. + HRRZ CH1,GDTAB(A) + MOVE CH1,DTB-40(CH1) ;GET DISPATCH FOR CHAR. + TLNE CH1,DSY1 ;MIGHT START SYL => NOS ERROR. + JRST LSSTH4 +LSSTH7: PUSHJ P,GTSL1 +LSSTH6: TRO I,IRSYL + POP P,B + POP P,A ;VALUE OF GROUPING WAS ADDM'ED INTO THESE. + TLZE I,ILLSRT ?.SEE UA3 + RET ;IF CALLED BY ^ OR _ AS SYL OP, RETURN TO IT. + JRST GETFD6 + +LSSTH1: TLO I,ILWORD ;A NUMBER IN PARENS BY ITSELF IS A NONNULL WORD. + ADDM A,WRD + ADDM B,WRDRLC + TRNE I,IRSYL ;IF SYLL BEFORE, + JRST LSSTH5 ;ERROR IF SYL AFTER. + JRST LSSTH8 ;ELSE NO ERROR. + +LSSTH4: ETR ERRNOS ;FOLLOWING SYLL WHEN THAT IS ERROR. +LSSTH8: TLNE I,ILLSRT ?.SEE UA3 + JRST LSSTH6 + SUB P,[2,,2] + JRST GETFD1 + +ERRNOS: ASCIZ /Syllables not separated/ + +POP2J: SUB P,[2,,2] + POPJ P, + +LEFTP: MOVEI D,2 ;2 FOR ). + JSP LINK,SAVWD1 + MOVEI C,0 + TRNE I,IROP + TRNE I,IRSYL + TLO C,400000 ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL + PUSH P,C + PUSHJ P,LSSTH9 + POP P,C + MOVSM A,T1 ;STORE SWAPPED VALUE + ADDI B,400000 ;NOW WANT TO SWAP RELOCATION, MAKE LH CORRECT + HLREM B,T2 ;STORE AS RH WITH SIGN EXTENDED + MOVSI B,400000(B) ;GET RIGHT HALF IN LEFT + ADDM B,T2 ;FINISH RELOCATION SWAP (THIS IS PAINLESS COMPARED TO THE HAIR EVERYWHERE + ;ELSE WHEN KEEPING THE HALFWORDS SEPARATE) + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + JSP LINK,USVWLD + MOVE A,T1 + MOVE B,T2 + JUMPL C,LSSTH1 ;ADD TO WHOLE WORD + JRST LSSTH2 + +;VERSION OF GETWRD FOR PSEUDO, +;PSEUDO MUST EITHER SAVE I, PPRIME AND GTVER OR RETURN TO ASSEM1. +;SYM SHOULD HOLD NAME OF PSUEUDO. + +AGETWD: MOVEM SYM,GTVER ;STORE NAME OF PSEUDO FOR UNDEF SYM MSGS. + TRO I,IRPSUD\IRDEF\IRNOEQ + PUSHJ P,GETWRD + MOVE SYM,GTVER ;RESTORE SYM. + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + RET + +;;GETWD ;READ A WORD, LEAVE VALUE IN A AND WRD, RELOC IN WRDRLC AND B + +GETWRD: MOVE T,GLSP1 + MOVEM T,GLSP2 + CLEARM FORMAT ;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB + CLEARM WRD ;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD + CLEARM WRDRLC ; " RELOCATION BITS, " + TDZ I,[ILWORD,,IRIOINS] + CLEARM FLDCNT ;NO FIELDS YET + MOVE T,[50100,,FORMAT] ;SET UP BIT POINTER TO FORMAT + MOVEM T,FORPNR +GTWD1: PUSHJ P,GETFLD ;READ NEXT FIELD +SPACE6: MOVEI T,1 ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO + SKIPA C,CDISP +SPACE5: REST A + TLNE C,DWRD + JRST (C) ;NO DISPATCH MEANS WD TERMINATOR + MOVE C,GLSP1 + MOVEM C,LINKL ;MARK END OF ACTIVE PART OF GLOTB + TRNN I,IRFLD + JRST GETWD2 ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF + IDPB T,FORPNR ;MARK NON-NULL FIELD IN FORMAT +GTWD4A: TLO I,ILWORD ;NON-NULL WORD + MOVE TT,FORMAT + SKIPN TT,FORTAB-10(TT) ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD + ETR [ASCIZ /Undefined format/] + MOVEM TT,FORMAT ;STORE IN FORMAT + MOVE T,[301400,,FORMAT] + MOVEM T,FORPNR + ;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD +GTWD3: LDB T,FORPNR + MOVE D,FLDCNT + CAIG D,2 + IBP FORPNR ;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV + TRNE I,IRIOINS + PUSHJ P,INTIOW + PUSHJ P,INTFLD ;PUT FIELD WHERE IT BELONGS + SOSGE FLDCNT + JRST GTWD5 ;THIS WAS LAST (FIRST) FIELD + POP P,GLSP2 ;NOT YET, POP OFF MORE + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD3 + +GTWD5: MOVE A,WRD + MOVE B,WRDRLC + MOVE C,LINKL + MOVEM C,GLSP1 + TRZ I,IRIOINS + POPJ P, + +COMMA: TRNN I,IRFLD ;FIELD DELIMITER WAS COMMA (T HAS 1) + JRST COMMA1 ;NO FIELD + IDPB T,FORPNR ;MARK NON-NULL FIELD +COMMA4: IDPB T,FORPNR ;MARK FIELD TERMINATOR WAS COMMA + MOVE TT,FLDCNT + CAIL TT,2 + ETR [ASCIZ /Comma past the 3rd field of a word/] +PUSHFD: PUSH P,A ;DONE WITH THIS FIELD, NOW TO GET NEXT + PUSH P,B + PUSH P,GLSP1 + PUSH P,GLSP2 + AOS FLDCNT ;ANOTHER FIELD + MOVE TT,GLSP1 + MOVEM TT,GLSP2 + HRRZ T,FORPNR + CAIE T,FORMAT + HRRZS FORPNR ;STABILIZE FORPNR + TLO I,ILWORD ;SAY WE HAVE A NON-NULL WORD IN PROGRESS (LOC, ETC. ILLEGAL). + JRST GTWD1 + +GETWD2: SKIPN FORMAT ;LAST FIELD OF WORD IS NULL + JRST GTWD5 ;ENTIRE WORD NULL, MAYBE WERE PARENS. + SOS FLDCNT + POP P,GLSP2 + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD4A + +COMMA1: LDB TT,FORPNR ;COMMA TERMINATED NULL FOELD. + SKIPE FORMAT + JUMPE TT,COMMA2 ;NOT 1ST FIELD, JMP IF PREV WAS TERM BY SPACE. + IBP FORPNR ;ELSE MARK NULL FIELD IN FORMAT. + JRST COMMA4 + +;FIELD SPACE COMMA, PATHOLOGICAL CASE +;(EG MACRO STARTED WITH A COMMA) +COMMA2: DPB T,FORPNR ;REPLACE SPACE WITH COMMA. + JRST GTWD1 + + ;FIELD TERMINATOR IS SPACE (T HAS 1) + +SPACE: MOVE TT,LIMBO1 + CAIE TT,^I ;HEURISTIC: REAL SPACES ARE LIKELY TO BE FOLLOWED BY SQUOZE, + JRST SPACE4 ;WHILE TABS ARE LIKELY TO BE FOLLOWED BY COMMENTS. + PUSH P,A + MOVE TT,GDTAB+40 + PUSHJ P,RCH + CAMN TT,GDTAB(A) + JRST .-2 ;FLUSH OTHER LOGICAL SPACES + CAIN A,"; ;TAB WAS FOLLOWED BY SEMICOLON: + JRST [ PUSH P,B + TRZ I,IRSYL + CALL SEMIC ;FLUSH THE COMMENT + MOVEI T,1 + REST B + JRST SPACE5] ;AND HANDLE THE C.R. +SPACE3: POP P,A + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-READ NEXT TIME +SPACE4: TRNN I,IRFLD + JRST GTWD1 ;NO FIELD + IDPB T,FORPNR ;T HAS 1, MARK NON-NULL FIELD IN FORMAT + IBP FORPNR ;MARK FIELD TERMINATOR WAS SPACE + JRST PUSHFD + +;T HAS DESC BYTE, PUT FIELD IN ITS PLACE +;ALSO CALLED FROM PBYTE, MUSTN'T CLOBBER AA. + +INTFLD: MOVE TT,GLSP2 + CAMN TT,GLSP1 + JUMPE B,INTFD1 ;NO GLOBALS, JUMP IF NO RELOCATION + CAIN T,2222 ;LH + JRST INTL + CAIN T,22 ;RH + JRST INTR + CAIN T,44 ;WHOLE WORD + JRST INTW + SKIPE B + ETR [ASCIZ/Relocation attempted in irrelocatable field/] + ;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS + CAIN T,2704 ;HIGH AC + JRST INTACH + CAIN T,504 ;AC LOW + JRST INTACL + JUMPGE FF,INTFD1 ;JUMP ON NOT PUNCHING PASS + CAME TT,GLSP1 + ETR [ASCIZ/Global symbol in illegal field/] +INTFD1: MOVEI TT,C_12. + ROTC T,-12. ;SHIFT BYTE POINTER INTO TT + MOVEI C,0 ;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE + DPB A,TT + CAMN TT,[2200,,C] + JRST INTFD2 ;RIGHT HALF, DON'T ALLOW CARRY INTO LH + ADDM C,WRD ;ALLOW CARRY +INTFD3: ADDM B,WRDRLC ;ADD RELOCATIONS, WILL BE BROKEN BACK INTO HALF-WORDS LATER + POPJ P, + +INTFD2: ADD C,WRD ;ADD RIGHT HALVES + HRRM C,WRD + JRST INTFD3 + +INTIOW: CAIE T,2704 + CAIN T,504 + TRZA A,3 ;IO DEVICE FIELD + POPJ P, ;NOT "AC" FIELD + ADDI T,611-504 + POPJ P, + +INTR: HRRE D,B ;RH + MOVEI B,0 + PUSH P,T + HRLZI C,HFWDF + PUSHJ P,LNKTC1 ;THIS IS A BUG WHICH SHOULD BE FIXED SOMETIME +PRTCL: MOVE B,D ;GET BACK MAPPED RELOCATION BITS +PRTCL2: POP P,T +INTW: MOVE D,GLSP2 ;WHOLE WORD + HRLOI LINK,377777 + CAML D,GLSP1 + JRST INTFD1 + ANDM LINK,1(D) + AOJA D,.-3 + +INTL: HRLZ D,B ;LH + MOVSI B,SWAPF + MOVSI C,HFWDF + PUSH P,T + MOVE T,GLSP2 +INTL2: CAML T,GLSP1 + JRST PRTCL + SKIPGE 1(T) + AOJA T,INTL2 ;INDEX FIELD, ETC => LEAVE ALONE + IORM C,1(T) ;SET HFWDF + XORM B,1(T) ;COMPLEMENT SWAP STATUS + TDNN B,1(T) + SETZM 1(T) ;SWAPPED TO RH, FLUSH IT + AOJA T,INTL2 + +INTACL: TDZA B,B ;AC LOW +INTACH: HRLZI B,SWAPF ;AC HIGH + HRLZI C,ACF + PUSH P,T + PUSHJ P,LNKTC1 + MOVEI B,0 + JRST PRTCL2 + +IOINST: HLLZ A,B ;IO INSTRUCTION, GET WHICH ONE INTO A + SKIPN FLDCNT ;THIS FIRST FIELD OF WORD? + TRO I,IRIOINS ;YES + JRST CLBPOP ;RETURN VALUE + +;TOP LEVEL LOOP, ASSEMBLE STORAGE WORDS +;LOTS OF PSEUDOS MEANINGLESS IN STORAGE WORDS +;(E.G. BLOCK, CONSTA) DO JRST ASSEM1 WHEN DONE +;THERE'S ALSO AN ERROR UUO WHICH RETURNS TO ASSEM1 + +ASSEM1: MOVE P,ASSEMP + JRST @ASMDSP + +;COME HERE TO START THE NEXT EXPRESSION OR WHATEVER. +ASSEM3: PUSHJ P,RCH + CAIN A,^I + JRST ASSEM2 ;PROBABLY NOT PROFITABLE TO SKIP AFTER SEE A TAB. + CAIG A,40 + JRST ASSEM3 ;FLUSH LEADING GARBAGE + TLO FF,FLUNRD ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT +;ASMDSP POINTS HERE WITHIN ASCII, SIXBIT ETC. +ASSEM2: TRZ I,IRFLD+IRSYL+IRLET+IRPSUD+IRCOM+IRCONT+IRGMNS+IROP+IRNOEQ+IREQL + TLZ I,ILGLI+ILVAR+ILFLO+ILDECP+ILUARI+ILWORD+ILNPRC+ILNOPT + IOR I,ASMI ;SET DEF AND RESTORE PSEUDF. + MOVE A,GLSPAS + SKIPL BYTM + MOVEM A,GLSP1 + ;GETWRD WILL COPY GLSP1 INTO GLSP2 +IFN TS,[AOSN TTYBRF ;DO A ^H-BREAK IF REQUESTED. + CALL TTYBRK] + PUSHJ P,GETWRD + TLZN I,ILWORD + JRST @ASMDSP ;NO WORD ASSEMBLED,TRY AGAIN + SKIPGE BYTM + JRST PBYTE ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC. + MOVE AA,ASMOUT ;OUTPUT WD AS APPRO. FOR GROUPING, IF ANY. + JRST @ASMOT0(AA) + +ASSEM6: SKIPE STGSW ;ASMOT0 POINS HERE. COME IF NOT IN GROUPING. + ETR ERRSWD ;STORAGE WORD ASSEMBLED + PUSHJ P,PWRD ;OUTPUT THE WORD. + AOS CLOC + HRRZS CLOC ;INCREM. POINT . + JRST @ASMDSP ;ASSEM3 OR ASSEM2 + +ERRSWD: ASCIZ /Storage word assembled/ + +ASSEM4: JSP T,PCONST ;ASMOT0+3 POINTS HERE. COME IF IN CONSTANT. + JRST @ASMDSP + +;ASMDSP POINTS HERE WITHIN GROUPING IF NOT IN MULTI-LINE MODE +;[ ;AND NO CLOSE (">)]") HAS BEEN SEEN. +ASSEMC: MOVE AA,ASMOUT + SKIPE CONSML ;IN ERROR MODE, GIVE APPROPRIATE ERROR MSG. + XCT ASMOT3(AA) + JRST @ASMOT2(AA) ;CLOSE WHATEVER TYPE GRPING WE'RE IN. + +;JUMP THRU THIS TABLE TO OUTPUT A WORD. +ASMOT0: ASSEM6? ASSEM1? ASSEM1? ASSEM4? [GOHALT ] + +;THIS TABLE GIVES APPRO. CLOSE FOR EACH TYPE OF GROUPING. ;[ +ASMOT1: "? ? "> ? ") ? "] ? "? + +;THIS TABLE SAYS WHERE TO GO TO END THE GROUPING. +ASMOT2: [GOHALT ]? LSSTHA? LSSTHA? CONND? [HALT ] + +;APPROPRIATE ERROR MESSAGE FOR MISSING CLOSE OF GROUPING. [ +ASMOT3: GOHALT + ETR [ASCIZ /Missing >/] + ETR [ASCIZ /Missing )/] + ETR [ASCIZ /Missing ]/] + GOHALT + +;THIS TABLE TELLS PBYTE HOW TO HANDLE BYTE MODE. +ASMOT4: PBY4 ? PBY5 ? PBY5 ? PBY3 ? [GOHALT ] + +;TABLE SAYING WHAT CHAR MUST HAVE OPENED THE GROUPING. +ASMOT5: "? ? "< ? "( ? "[ ? "? ;] + +;;GETVAL ;GET VALUE OF SYM + ;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED) + ;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B + +VBLK +GTVER: 0 ;SQUOZE NAME OF CALLING PSEUDO, OR POINTER + ;TO INSN TO EXECUTE WHEN IF SYM IS UNDEF. +PBLK + +GETVAL: PUSHJ P,ES + JRST GVNF ;NO STE. +IFN CREFSW,XCT CRFINU ;JFCL OR CALL TO CREF RTN. + JRST @.+1(A) ;FOUND, DISPATCH ON SQUOZE FLAGS + +GVTAB: GVCOM ;COMMON (UNUSED) + GVPSEU ;PSEUDO OR MACRO. + GVSYM ;LOCAL SYMBOL. + GVUL ;LOCAL UNDEF (MAYBE STINK KNOWS VALUE) + GVDLV ;DEFINED LOCAL VAR. + GVULV ;UNDEF LOC VAR. + GVDGV ;DEF GLO VAR + GVUGV ;UNDEF GLO VAR + GVDG ;DEF GLOBAL + GVUG ;UNDEF GLOBAL + +;DEF LOCAL VAR. +GVDLV: PUSHJ P,GVDLGV ;IF PASS2 AND HAS ' THIS TIME, SET 3VAS2 FOR AVARIAB + TLZN I,ILGLI + JRST GVDLV2 + MOVSI T,DEFGVR ;NOW DEF GLO VAR. + PUSHJ P,VSM2 + JRST GVDG1 ;MAYBE OUTPUT GLOBAL DEF. TO STINK. + +GVDGV: PUSHJ P,GVDLGV ;DEF GLO VAR; IF PASS 2 AND ' THIS TIME, SET 3VAS2 + JRST GVDG2 ;MUSN'T PUNCH VALUE, AVARIAB WILL. + +GVDLGV: TRNE FF,FRPSS2 ;IF PASS 2 + TLNN I,ILVAR ;AND THIS TIME HAVE SINGLEQUOTE + POPJ P, + TLO C,3VAS2 ;TELL AVARIAB SEEN IN PASS 2 WITH '. + 3PUT C,D + POPJ P, + +GVULV: TLZN I,ILGLI ;UNDEF LOCAL VAR, MAYBE MAKE GLOBAL. + JRST GVUNDF + PUSHJ P,PLOGLO ;IF SO, TELL STINK SYM IS GLOBAL, + MOVSI T,UDEFGV ;SYM NOW UNDEF GLO VAR + PUSHJ P,VSM2 + JRST GVUNDF ;IN EITHER CASE, HANDLE UNDEF SYM. + +GVUL: TLZE C,3MACOK ;UNDEF LOCAL, PRESUMED NUMERIC + 3PUT C,D ;DON'T LET IT BECOME MACRO AND SCREW PASS2. + TLNE C,3LLV + JRST GVGLTB ;(REALLY DEFINED BUT ONLY STINK KNOWS HOW) + TLNE I,ILGLI ;IF MAKING GLOBAL, TELL STINK. + PUSHJ P,PLOGLO +GVNF1: TLZE I,ILVAR ;IF ', MAKE VAR (WILL CHECK ILGLI) + JRST GVUL1 + TLZN I,ILGLI ;NOT MAKING VAR, MAYBE GLOBAL? + JRST GVUNDF ;NO, MAYBE ERROR, MAKE GLOTB ENTRY. + MOVSI T,GLOEXT + PUSHJ P,VSM2 ;NOW GLOBAL UNDEF, + JRST GVGLTB ;NO ERROR, JUST GLOTB ENTRY. + +GVUL1: TLZN I,ILGLI ;UNDEF LOCAL BECOMES + SKIPA T,[UDEFLV,,] ;UNDEF LOC VAR OR +GVGVAR: MOVSI T,UDEFGV ;UNDEF GLO VAR. +GVVAR: CALL ESDEF ;DEFINING SYM AS A VAR => INSIST ON DEFINING LOCAL TO INNERMOST BLOCK. + JFCL + AOS VARCNT + HRR B,VARCNT + PUSHJ P,VSM2 ;MAKE IT A VAR, + JRST GVUNDF ;PRETEND HAD ALREADY BEEN A VAR. + +GVUG: TLZE I,ILVAR ;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR. + JRST GVGVAR +GVGLTB: SKIPGE CONTRL ;UNDEF GLO IN ABS ASSEM => + JRST GVUND1 ;MAYBE TREAT AS UNDEF. +GVGLT1: AOS GLSP1 ;DON'T KNOW SYM'S VALUE, MAKE GLOTB ENTRY. + MOVEI T,ST(D) + HRRZM T,@GLSP1 + JRST CABPOP ;RETURN 0 AS VALUE. + +GVNF: +IFN CREFSW,XCT CRFINU ;ONLY IF NOT FOUND WOULD NOT CREF AFTER ES. + TLNE I,ILVAR+ILGLI ;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY + JRST GVNF1 ;AND WILL STORE NAME IN STE ANYWAY. + SKIPGE ESBK ;ELSE IF NO SPEC'D BLOCK, + TRNN FF,FRNPSS ;FORCE .MAIN BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES. + CAIA ;BUT CAN'T DO THAT FOR 1PASS OR WOULD MISS FWD REFS. + HRRI C,BKWPB + MOVSI T,LCUDF + PUSHJ P,VSM2 + JRST GVUNDF ;MAYBE ERROR, MAKE GLOTB ENTRY. + +GVCOM: TRO I,IRCOM ;COMMON: SAY THIS WAS ONE. + HRRZ A,B ;RETURN RH OF VALUE, ABSOLUTE. + JRST CLBPOP + +GVPSEU: TLNN I,ILVAR+ILGLI ;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR. + JRST (B) ;OTHERWISE, DISPATCH TO IT. + TLZE I,ILVAR + ETSM ERRCBV + TLZE I,ILGLI + ETSM ERRCBG + JRST (B) ;DISPATCH TO PSEUDO (OR MACCL IF MACRO) + ;EXPECTS LH OF VALUE IN LH OF B. + +ERRCBV: ASCIZ /Can't be a variable/ +ERRCBG: ASCIZ /Can't be global/ + +GTVL7B: TLNE C,3RLL ;R(LH) + TLO SYM,200000 + TLNE C,3RLR ;R(RH) + TLO SYM,100000 + POPJ P, + +GVSYM: TLNN C,3REL + TLNE I,ILVAR\ILGLI + JRST GVSYM2 + MOVE A,B ;THIS CODE DOES WHAT GVSYM2 WOULD DO, BUT FASTER. + SETZ B, + RET + +GVSYM2: TLZE I,ILVAR ;LOCAL SYM: CAN'T MAKE VARIABLE. + ETSM ERRMDV + TLZN I,ILGLI + JRST GVSYM0 ;NOT MAKING GLOBAL, GET VALUE & RETURN. +GVSYM1: MOVSI T,GLOETY ;BECOMES DEF. GLOBAL. + PUSHJ P,VSM2 + JRST GVDG1 ;HANDLE AS IF WAS DEF GLOBAL. + +ERRMDV: ASCIZ /Multiply-defined variable/ + +GVDG: TLZE I,ILVAR ;GLOBAL ENTRY + ETSM ERRMDV +;COME HERE FOR DEF GLOBAL +GVDG1: SKIPGE CONTRL + JRST GVDLV2 ;DON'T PUNCH VALUE IF ABSOLUTE. + TLNE C,3VP + JRST GVDG2 ;VALUE PUNCHED ALREADY, NOT AGAIN. + JUMPGE FF,GVDG2 + TLNN C,3LLV + TRNE I,IRPSUD+IREQL + JRST GVDG2 + TLO SYM,40000 + PUSH P,WRD + PUSHJ P,OUTDE2 + POP P,WRD +GVDG2: TRNN I,IRPSUD\IREQL ;IF INSIDE AN ORDINARY STORAGE WORD, + TLNN C,3REL ;GENERATE A GLOBAL REF IF GLOBAL IS RELOCATABLE (HEURISTIC). +GVDLV2: TLNE C,3LLV ;IF VAL KNOWN ONLY BY STINK, MUST MAKE A GLOBAL REF. + JRST GVGLTB +GVSYM0: MOVE A,B ;USED IN LBRAK + LDB B,[.BP (3RLR),C] + TLNE C,3RLL + TLO B,1 + POPJ P, + +GVUND1: MOVE A,CONTRL + TRNE A,DECREL+FASL ;DEC FMT OR FASL => UNDEF GLOBALS OK. + JRST GVGLT1 +GVUGV: +GVUNDF: TRZ I,IRDEF ;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY. + TRNE I,IRPSUD\IREQL + JRST GVUND2 ;PSEUDO + TRNN FF,FRPSS2 + JRST GVGLT1 ;PASS 1 + SKIPN CONDEP + ETSM [ASCIZ/Undefined/] + SKIPE CONDEP + ETSM [ASCIZ/Undefined in literal/] + JRST CABPOP + +GVUND2: HLRZ A,GTVER ;DOES GTVER POINT TO AN INSN? + JUMPE A,[XCT @GTVER ? JRST CABPOP] + ERJ .+1 ;NO, IT IS NAME OF PSEUDO. + MOVE A,LINEL + CAIGE A,75. ;CR-LF-TAB NOW IF WHOLE MSG WON'T FIT ON A LINE. + CALL CRRTBX + TYPE2 SYM ;TYPE NAME OF UNDEF SYM. + TYPR [ASCIZ/ Undefined in /] + TYPE2 GTVER + CALL CRRERR + JRST CABPOP + +;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM +;IDX OF BLOCK TO DEFINE IN IN ESBK (OR -1 => ANY BLOCK NOW IN PROGRESS). +;DOESN'T CLOBBER F (FOR WRQOTE) +;RETURNS SKIPPING IF SYM FOUND, WITH SQUOZE FLAGS IN BOTTOM OF A, +;VALUE OF SYM IN B, STE IDX IN D, AND 3RDWD IN C. +;IF NOT FOUND, RETURNS IN D THE IDX OF A PLACE TO DEFINE SYM. +;CALL ESDCHK TO GET THE FOLLOWING EXTRA INFO (WHETHER SYM FOUND OR NOT): +;ESLAST -> LAST STE WITH DESIRED NAME SEEN, REGARDLESS OF WHAT BLOCK IT'S IN +;ESL1 HAS LEVEL OF BLOCK OF BEST STE SEEN, -1 IF NOT FOUND +;ESL2 HAS 3RDWRD OF BEST. +;ESXPUN HAS -1 OR IDX OF A STE WHICH MIGHT BE USED TO DEFINE THE SYM. +;RH(TM) GETS BLOCK IDX TO DEFINE IN IF DEFINE THE SYM. +;TT HAS -<# STE NOT LOOKED AT YET> +;THEN IF SYM IS FOUND IN A CONTAINING BLOCK AND YOU WANT TO DEFINE +;IT IN THE CURRENT BLOCK, YOU CAN CALL DEFCHK TO FIND AN STE TO DO IT IN. +;CALLING ESDEF IS AS GOOD AS CALLING ESDCHK AND DEFCHK, BUT DOESN'T +;LET YOU SEE WHAT YOU ARE GOING TO SHADOW. + +ESDEF: MOVE A,BKCUR ;EVAL SYM IN ORDER TO DEFINE IT: + SKIPGE ESBK ;IF NO SPEC'D BLOCK, SPEC THE CURRENT BLOCK, + MOVEM A,ESBK ;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN + +ESDCHK: SETOM ESLAST ;CALL HERE IF WE MIGHT END UP CALLING DEFCHK, + SETOM ESL1 ;SINCE IN THAT CASE WE'LL NEED THESE VARS EVEN IF SYM IS FOUND + SETOM ESXPUN ;RIGHT AWAY. + MOVN TT,SYMLEN +ES: MOVE C,SYM ;HASH AWAY + TSC C,SYM ;THIS MAKES SURE THAT THE FIRST FEW CHARS OF SYMBOL DON'T GIVE + ;A ZERO REMAINDER, IF SYMLEN IS A ROUND NUMBER. + MOVMS C ;THIS IS BECAUSE IDIV OF NEGATIVE NUMBER GIVES NEG. REMAINDER. + IDIV C,SYMLEN + IMUL D,WPSTE + SKIPGE TM,ESBK ;GET BKTAB IDX OF SPEC'D BLOCK + HRR TM,BKCUR ;OR -1,,BKTAB IDX OF CURRENT BLOCK. +;NOW CHECK FAST FOR AN IMMEDIATE MATCH - AVOID SETTING UP FLAGS NEEDED ONLY WHEN +;SYM APPEARS IN MULTIPLE BLOCKS OR ISN'T DEFINED. + SKIPN B,ST(D) + JRST ESEND0 ;SYM IS KNOWN NOT TO BE DEFINED. + TLZ B,740000 + CAME B,SYM + JRST ESBAD0 ;NOT FOUND IN 1ST ENTRY - MUST SET UP INFO AND LOOP + 3GET C,D + MOVEI A,(C) + CAIN A,(TM) + JRST ESGOOD ;IN THE DESIRED BLOCK => GOOD. + TDNN C,[3MAS,,-1] ;IN THE INITIAL SYMS BLOCK, NOT PRESENT IN ANY OTHER, + JUMPL TM,ESGOOD ;AND BLOCK WASN'T EXPLICITLY SPEC'D => GOOD. + MOVN TT,SYMLEN ;ELSE MUST KEEP LOOKING TO SEE IF THIS DEF IS REALLY ONE WE WANT. + SETOM ESLAST + SETOM ESL1 + SETOM ESXPUN + JUMPGE TM,ESIGN + JRST ESLP1 + +;LOOK AT THE NEXT STE, WHILE LOOPING. +ESLP: SKIPN B,ST(D) ;GET SQUOZE IN THIS ST SLOT + JRST ESEND ;NOTHING WHERE SYM BELONGS, END SEARCH + TLZ B,740000 ;CLEAR OUT FLAGS + CAME B,SYM ;COMPARE WITH WANTED + JRST ESBAD ;NO MATCH BUT MAYBE KEEP GOING + 3GET C,D ;FOUND SYM, GET 3RDWRD + MOVEI A,(C) + CAIN A,(TM) ;DEFINED IN DESIRED BLOCK + JRST ESGOOD ; => MUST BE GOOD. +ESLP0: JUMPGE TM,ESIGN ;BLOCK SPEC'D => ALLOW NO OTHERS. + TDNE C,[3MAS,,-1] ;IF IN INITIAL SYMS BLK, NO MORE DEFS, + JRST ESLP1 + SKIPGE ESL1 ;AND NO PREVIOUS DEFS, + JRST ESGOOD ;UNREDEFINED INITL SYM MUST BE GOOD. +ESLP1: HLRZ B,BKTAB+1(C) ;GET LEVEL OF BLOCK DEF. IS IN. + CAMN A,BKPDL(B) ;SAME AS BLOCK WE'RE IN AT THAT LEVEL? + CAMLE B,BKLVL ;AND NOT A BLOCK WE'VE EXITED + JRST ESIGN + CAMG B,ESL1 ;OR HIGHER LEVEL THAN PREVIOUS BEST + JRST ESIGN + MOVEM C,ESL2 ;REPLACE BEST'S 3RDWRD, LEVEL, ADDR. + MOVEM B,ESL1 + MOVEM D,SADR +ESIGN: HRRZM D,ESLAST ;THIS ENTRY LAST SEEN WITH THIS NAME. + TLNN C,3MAS ;MORE STE'S FOR THIS SYM => + JRST ESEND1 + JRST ESNXT ;KEEP LOOKING. + +;COME HERE IF 1ST SYM SEEN ISN'T THE SAME NAME. SET UP TO LOOP. +ESBAD0: MOVN TT,SYMLEN + SETOM ESLAST + SETOM ESL1 + SETOB C,ESXPUN +;HERE WHILE LOOPING WHEN SYM WITH WRONG NAME IS SEEN. +ESBAD: JUMPN B,ESNXT + SKIPGE A,ESXPUN ;IF THIS IS 1ST EXPUNGED ENTRY SEEN + MOVEM D,ESXPUN ;REMEMBER IT FOR DEFINITION. + SKIPGE A + HRROS ESLAST ;AND SET OLD ENTRY'S 3MAS. +ESNXT: ADD D,WPSTE + CAML D,SYMSIZ ;AT END => GO TO BEGINNING + MOVEI D,0 + AOJN TT,ESLP + JRST ESEND1 ;NOT FOUND. + +ESEND0: MOVEI C,(TM) ;COME HERE IF 1ST PLACE LOOKED AT SHOWS THE SYM ISN'T DEFINED + MOVEM D,ESXPUN + POPJ P, + +ESEND: SKIPGE A,ESXPUN ;FREE ENTRY CAN BE USED TO DEFINE. + MOVEM D,ESXPUN + SKIPGE A + HRROS ESLAST +ESEND1: SKIPGE ESL1 ;NOT FOUND => FIND PLACE TO DEFINE IT. + JRST DEFCH1 + MOVE D,SADR ;IDX OF BEST FOUND. + TRNN FF,FRNPSS + JRST ES1PS ;1-PASS, SPECIAL CHECK. + MOVE C,ESL2 ;GET BEST'S 3RDWRD. +ESGOOD: LDB A,[400400,,ST(D)] ;GET SQUOZE FLAGS IN A. +ES1POK: MOVE B,ST+1(D) ;VALUE OF SYM. IN B. + ;D HAS IDX OF 1STWRD IN SYM TAB. + ;C HAS 3RDWRD +POPJ1: AOS (P) +APOPJ: +CPOPJ: POPJ P, + +;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF. +;WE ASSUME THAT D AND TT ARE STILL SET UP FROM A CALL TO ESDCHK. +DEFCHK: SKIPGE ESL1 ;IF WE DIDN'T TAKE TIME TO SET ESLAST BEFORE, + HRRZM D,ESLAST ;DO IT NOW. (SEE BEFORE ESLP1) + JRST DEFCH1 + +ES1PS: LDB A,[400400,,ST(D)] ;1PASS & FOUND IN CONTAINING BLOCK: + MOVE C,ESL2 + TRNN C,-1 ;INITIAL SYM, OK; + JRST ES1POK + CAIE A,1 ;PSEUDO OR MACRO + TLNE C,3DOWN ;OR .DOWN'D SYMBOL OK; + JRST ES1POK ;ELSE GET NEW STE TO DEF. +DEFCH1: MOVEI C,(TM) ;INITIALIZE NEW 3RDWRD WITH BLOCK TO DEF IN. + SKIPL D,ESXPUN ;IF FOUND EXPUNGED OR FREE ENTRY, USE IT. + JRST DEFCH2 + SKIPGE D,ESLAST ;ELSE LOOK FOR ONE. + ETF ERRSCE +DEFCH4: MOVE B,ST(D) + TLZ B,740000 + JUMPE B,DEFCH3 ;MUST RETURN 0 IN B IF DON'T SKIP. + ADD D,WPSTE + CAML D,SYMSIZ + MOVEI D,0 + AOJL TT,DEFCH4 ;ASSUME TT LEFT AROUND FROM ES. + ETF ERRSCE +ERRSCE: ASCIZ /Symbol table full/ + +;ESLAST HAS -1 IF NO ENTRY SEEN; ELSE +;RH HAS IDX OF LAST SEEN, SIGN SET IF SEEN BEFORE PLACE TO DEFINE. +DEFCH3: MOVEM D,ESXPUN ;REMEMBER ADDR WHERE CAN DEFINE + HRROS ESLAST ;LAST PLACE SEEN MUST BE EARLIER. +DEFCH2: SKIPL A,ESLAST + JRST DEFCH5 ;LAST PLACE SEEN WAS SEEN AFTER PLACE TO DEFINE. + CAMN A,[-1] + POPJ P, ;REALLY NEVER SEEN. + MOVSI TM,3MAS + IORM TM,ST+2(A) ;PLACE SEEN IS EARLIER, SET ITS 3MAS. + POPJ P, + +DEFCH5: TLO C,3MAS ;PLACE TO DEF BEFORE EXISTING STES. + POPJ P, + +;ENTER A SYM IN SYMBOL TABLE + ;B HAS VALUE + ;C HAS 3RDWRD + ;D HAS INDEX INTO ST (PROBABLY SET UP BY ES) + ;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE + ;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED + +VSM2LV: TLOA C,3LLV ;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE +VSM2W: MOVE B,WRD ;ENTRY TO ENTER VALUE OF WRD STEAD B +VSM2: MOVE CH1,SYM + TLZ CH1,740000 + IOR CH1,T ;CH1 := SQUOZE WITH FLAGS + MOVEM CH1,ST(D) ;STORE SQUOZE + MOVEM B,ST+1(D) ;STORE VALUE +VSM3A: 3PUT C,D ;STORE 3RDWRD + POPJ P, + +;RETURN THE NUMBER OF SYMTAB SLOTS IN USE. +A.SYMCN:SKIPL A,SMSRTF ;IF SYMTAB HAS BEEN COMPACTED, GET # OF SYMS THAT IT HAD + JRST CLBPOP ;BEFORE COMPACTION AND RETURN THAT. + MOVE D,SYMAOB + SETZ A, +A.SYC1: MOVE B,ST(D) + TLZ B,740000 + SKIPE B + AOS A + ADD D,WPSTE1 + AOBJN D,A.SYC1 + JRST CLBPOP + +;;EQUAL ;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT + +EQUAL: TLZ FF,FLHKIL + PUSHJ P,RCH + CAIE A,"= ;DECIDE WHETHER TO HALF-KILL THE SYM. + TLOA FF,FLUNRD + TLO FF,FLHKIL + SETZM LABELF + CALL RCH + CAIE A,": ;DECIDE WHETHER TO MARK SYM AS NOT REDEFINABLE. + TLOA FF,FLUNRD + SETOM LABELF + CAMN SYM,[SQUOZE 0,.] ;.=FOO, SAME AS LOC FOO + JRST PTEQ + TDNN I,[ILWORD,,IROP+IRNOEQ] + TRNN I,IRLET + ETR [ASCIZ/= With bad format or bad context/] + PUSH P,LABELF + PUSH P,SYM + PUSH P,ESBK + PUSH P,I + MOVEI A,[ETSM [ASCIZ/Undefined in =/]] + MOVEM A,GTVER + TRO I,IRNOEQ+IRDEF+IREQL + PUSHJ P,GETWRD + TRNN I,IRDEF + JRST ASEM1A ;UNDEFINED SYMS IN VALUE, IGNORE +IFN LISTSW,[ + SKIPN LSTONP + JRST EQUAL1 ;NOT LISTING. + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE SYM,WRD + MOVEM SYM,LISTWD + MOVE SYM,WRDRLC + MOVEM SYM,LSTRLC + SETOM LISTAD + SETOM LISTPF +EQUAL1: +] ;END IFN LISTSW, + TDZ I,[-1-(ILMWRD)] + IOR I,(P) + TLZ FF,FLUNRD + POP P,(P) + POP P,ESBK + POP P,SYM + POP P,LABELF + MOVE A,WRDRLC ;GET RELOCATION + TDNN A,[-2,,-2] ;SKIP ON NON-STANDARD RELOCATION BITS + SKIPE LDCCC + JRST EQG1 ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER + MOVE A,GLSP1 + CAMN A,GLSP2 + JRST EQL1 ;NO GLOBALS IN DEFINITION +;FALLS THROUGH. + +;FALLS THROUGH. +;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT. +EQG1: IFN CREFSW, XCT CRFLBL ;CREF DEF. OF NORMAL SYM, + SKIPGE CONTRL + JUMPL FF,[ETASM [ASCIZ /Externals in =/]] + CALL ESDCHK ;SEARCH SYM TAB. + JRST EQL2 ;NOT FOUND IN CURRENT OR CONTAINING BLKS. + HRRZI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQG1A + XCT EQG1TB(A) ;FOUND IN DESIRED BLOCK. + JRST ASSEM1 + +EQG1A: JUMPN T,EQG2 + CAIN A,PSUDO_-16 ;FOUND AS INITIAL PSEUDO => ERROR. + ETSM ERRQPA +EQG2: CALL DEFCHK ;FIND FREE STE TO DEFINE IN DESIRED BLOCK. + JRST EQL2 ;PRETEND WASN'T FOUND. + +ERRQPA: ASCIZ /Shadowing a pseudo-op/ +ERRIPA: ASCIZ /Illegal =/ + +EQG1TB: ETSM ERRIPA ;COMMON + ETSM ERRIPA ;PSEUDO OR MACRO + JRST EQL2 ;SYM + JRST EQGUL ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL7 ;GLO ENTRY + JRST EQL8 ;GLO EXIT + +EQL8: PUSHJ P,GLKPNR + TLZ C,3LABEL\3MULTI +EQL7: MOVSI T,GLOETY ;GLOBAL PARA ASSIGN + MOVEI B,0 + TLO SYM,40000 +LOPRA1: PUSH P,CASM1A ;RETURN TO ASSEM1A AFTER FOLLOWING. + TLNE C,3MULTI + ETSM ERRMDT + SKIPE LABELF + TLO C,3LABEL + TLNE FF,FLHKIL + TLOA SYM,400000 ;SET FLAG TO HALF-KILL SYM + TLZA C,3SKILL + TLO C,3SKILL ;SET CORRESPONDING FLAG IN 3RDWRD + PUSHJ P,VSM2LV + JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS + TRNN I,IREQL ;IF CAME FROM COLON ROUTINE, + JRST PDEFPT ;PUNCH "DEFINE SYM AS $.". + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D ;STORE UPDATED 3RDWRD + PUSHJ P,EBLK + MOVEI TT,LGPA + DPB TT,[310700,,BKBUF] + PUSHJ P,OUTSM0 + PUSHJ P,PWRDA + JRST EBLK + +EQGUL: PUSHJ P,LKPNRO ;LOCAL UNDEF, OUTPUT LINK REQUEST. + TLZ C,3LABEL\3MULTI ;CAN'T DETECT MDT'S WHEN ONLY STINK KNOWS FOR SURE. +EQL2: TLNE I,ILGLI + JRST EQL7 ;MAKE IT GLOBAL + MOVSI T,LCUDF ;LOCAL UNDEFINED + JRST LOPRA1 + +CASM1A: JRST ASEM1A + +;MAYBE PUNCH OUT LINK REQUEST +;SYM HAS NAME OF SYM TO REQUEST, D STE IDX OF SYM, C 3RDWRD, B ADR OF REQUEST +;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B) + +GLKPNR: TLO SYM,40000 ;GLO BIT +LKPNRO: TLNN C,3RLNK + TLNE B,-1 + TROA I,IRCONT + POPJ P, ;DON'T PUNCH REQUEST + MOVE A,CONTRL + TRNE A,DECREL + JRST LKPNDR ;DIFFERENT WAY TO OUTPUT THIS INFO IN DECREL FMT + MOVEI A,6 + PUSHJ P,PBITS + PUSHJ P,OUTSM0 ;PUNCH SYM + HLRZ A,B + TLZE C,3RLNK ;RELOC OF LINK PNR + TLO A,100000 + HRRZS B ;CLEAR OUT LH OF B + TRZ I,IRCONT ;OK TO END BLOCK NOW + JRST $OUTPT ;PUNCH OUT A AND RETURN + +LKPNDR: MOVSI A,DECINT ;WRITE AN "INTERNAL REQUEST" WITH ONE DATA WORD. + CALL DECBLK + SETZ TM, ;COMPUTE RELOC OF ADDRESS AND DATA IN TM. + TLNE C,3RLNK + TRO TM,2 + SKIPE WRDRLC + TRO TM,1 + MOVE A,WRD ;ADDRESS TO LINK,,DATA + HRL A,B + CALL DECWR1 + JRST EBLK + +;THESE ASSUME STE IDX IN D, SQUOZE W/ FLAGS IN SYM. +;C HAS 3RDWRD, B OR WRD HAS VALUE TO DEF. WITH. +;CALL ONLY IN RELOCATABLE ASSEMBLY. +OUTDE2: MOVEM B,WRD +OUTDE1: TLNE FF,FLPPSS + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D + SKIPGE CONTRL + RET + TRO I,IRCONT + SETZ A, + TLNN C,3LABEL ;WHAT KIND OF DEFINITION DEPENDS ON WHETHER SYM IS REDEFINABLE. + MOVEI A,CRDF + CALL P7X ;PUNCH OUT CODE BITS + PUSHJ P,GTVL7B ;SET RELOCATION BITS IN SQUOZE + PUSHJ P,OUTSM0 + TRZ I,IRCONT + JRST OUTWD ;OUTPUT VALUE + +;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM +;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL +PLOGLO: SKIPGE CONTRL + RET + PUSH P,A + PUSHJ P,PBITS7 + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY THIS IS NEW STYLE RQ, + PUSHJ P,OUTSM0 ;PUNCH "OLD NAME" = SYMTAB IDX, + TLC SYM,440000 ;SAY MAKE GLOBAL, OUTPUT ACTUAL NAME OF SYM. + PUSHJ P,OUTSM + JRST POPAJ + +;NO GLOBALS TO RIGHT OF EQUAL SIGN + +EQL1: PUSHJ P,ESDCHK + JRST EQL1A ;NOT FOUND +IFN CREFSW,XCT CRFEQL ;DEF. OCCUR. OF NORMAL SYM. OR INTSYM. + MOVEI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQL1F + SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL + XCT EQL1TB(A) ;FOUND IN DESIRED BLOCK => NOW REDEFINE. + JRST ASSEM1 + +EQL1F: JUMPN T,EQL10 + CAIE A,PSUDO_-16 + JRST EQL10 + MOVEI T,(B) ;FOUND AS PSEUDO IN INITIAL SYMS BLOCK, + CAIN T,INTSYM ;SPECIAL WAY TO REDEFINE IF LIKE .MLLIT, ETC. + JRST EQLINT + ETSM ERRQPA ;SHADOWING AN INITIAL PSEUDO, TELL USER. +EQL10: CALL DEFCHK ;FOUND IN OUTER BLOCK, GET NEW STE, + JRST EQL1A ;DEFINE THERE AS IF NOT FOUND. + +EQL1TB: ETSM ERRIPA ;COMMON + JRST EQL1B2 ;PSEUDO OR MACRO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL1D ;GLO ENTRY + JRST EQL1E ;GLO EXIT + +EQL1E: PUSHJ P,GLKPNR ;DUMP LINKING POINTER + CAIA +EQL1D: CALL MDTCHK + PUSHJ P,RCHKT ;GLO ENTRY +EQLB2: PUSHJ P,RMOVET + TLNE FF,FLHKIL + TLOA SYM,400000 + TLZA C,3SKILL + TLO C,3SKILL + HRLZI T,GLOETY + SKIPE LDCCC ;IF IN LOADER CONDITIONAL, + TLO C,3LLV ;THEN LOADER MUST SUPPLY VALUE + PUSHJ P,VSM2W ;DEFINE SYM + TLO SYM,40000 ;SET GLOBAL BIT IN SQUOZE +EQL1CE: JUMPGE FF,ASEM1A + PUSHJ P,OUTDE1 +ASEM1A: TLNE I,ILMWRD + PUSHJ P,IGTXT + JRST ASSEM1 + +;CHECK WHETHER DEFINING AN MDT, OR REDEFINING A LABEL (=> THIS IS AN MDT) +MDTCHK: TLNN C,3LABEL + JRST MDTCH1 + CALL GVSYM0 ;MOVE VALUE OF SYM TO A, GET RELOC (WRDRLC STYLE) IN B + CAMN A,WRD + CAME B,WRDRLC ;IF WE'RE CHANGING THE VALUE, MARK SYM AS MDT +MDTCHL: TLO C,3MULTI +MDTCH1: TLNE C,3MULTI ;EVER ASSIGNING TO MDT, EVEN SAME VALUE, GIVES ERR MSG + ETSM ERRMDT + RET + +EQL1C: TLNE I,ILGLI + JRST EQL1CA ;MAKE GLOBAL + PUSH P,C + PUSHJ P,LKPNRO ;MAYBE OUTPUT LINK REQUEST + PUSHJ P,RCHKT + PUSHJ P,RMOVET ;INITIALIZE 3RDWRD + MOVSI T,SYMC ;SYM + PUSHJ P,EQA2A ;ENTER DEF IN SYMTAB + TLNE C,3SKILL + TLO SYM,400000 + POP P,AA + TLNE AA,3VCNT ;USED IN CONSTANT + PUSHJ P,CONBUG + JRST EQL1CE + + ;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7 + +P7X: MOVEM A,PARBIT ;ENTRY FOR SECOND BYTE IN A +P70: PUSHJ P,PBITS7 ;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7 + SKIPA A,PARBIT ;GET SECOND BYTE BACK +PBITS7: MOVEI A,7 ;ENTRY TO JUST PUNCH OUT 7 + JRST PBITS + +EQL1CA: PUSHJ P,PLOGLO + JRST EQL1E +EQA2: PUSH P,CASM1A +EQA2A: TLNE FF,FLHKIL + TLO C,3SKILL + JRST VSM2W + +EQL1B2: HRRZ A,B ;ATTEMPT TO ASSIGN PSEUDO-OP, IS IT AN INTSYM? + CAIN A,INTSYM + JRST EQLINT ;YES, GO SET WD IT POINTS TO. + ETSM [ASCIZ /Pseudo or macro ='D/] +EQL1B: CALL MDTCHK + PUSHJ P,RCHKT + TLNE I,ILGLI + JRST EQLB2 ;WAS LOCAL, MAKE IT GLOBAL + ;WAS LOCAL, LEAVE IT LOCAL + PUSHJ P,RMOVET ;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD) + MOVSI T,SYMC ;SYM + JRST EQA2 + +EQL1A1: PUSHJ P,RCHKT + PUSHJ P,RMOVET + HRLZI T,SYMC + JRST EQA2 + +EQL1A: SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL +IFN CREFSW,XCT CRFLBL ;DEF. OCCUR. OF NORMAL SYM. + TLNN I,ILGLI + JRST EQL1A1 + JRST EQL1E + +EQLINT: HLRZS B ;GET ADDR OF WD HOLDING VALUE. + MOVEMM (B),WRD ;PUT NEW VALUE IN IT. + JRST ASEM1A + +;;. ;ROUTINES DEALING WITH THE CURRENT LOCATION AND OFFSET + +VBLK +CLOC: 0 ;PUNCHING LOC +CRLOC: 0 ;PUNCHING RELOC +OFLOC: 0 ;OFSET VAL +OFRLOC: 0 ;OFSET RELOC +;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC +SYLOC: 0 ;VAL OF LAST TAG +SYSYM: 0 ;LAST TAG +SYLOC1: 0 ;VALUE OF NEXT TO LAST TAG +SYSYM1: 0 ;NEXT TO LAST TAG +GLOCTP: 0 ;4.9 => CURRENT LOCATION GLOBAL, 2.9 => OFFSET GLOBAL + ;FRGLOL (FLAG IN FF) IS IOR OF BITS 4.9 AND 2.9 OF GLOCTP + ;EXCEPT AFTER .=NON-GLOBAL WITH GLOBAL OFFSET + ;OTHER BITS USED ONLY WHEN IN LINK (NEVER SET IN GLOCTP): + ;400 => ARG GLOBAL +PBLK + + + ;POINT (.) AS PSEUDO-OP + +GTVLP: TRNE FF,FRGLOL + JRST GTVLP2 ;LOCATION GLOBAL + MOVE B,OFRLOC ;GET RELOCATION OF OFFSET + ADD B,CRLOC ;ADD CURRENT RELOCATION + MOVE A,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 ;IF IN BYTE MODE, + HLL A,BYTWP ;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB + ADD A,OFLOC ;NOW ADD OFFSET + TLZ I,ILFLO+ILDECP+IRPERI ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER + POPJ P, + + +GTVLP2: MOVEI T,$.H ;LOCATION GLOBAL + AOS GLSP1 + HRRZM T,@GLSP1 ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT) + SKIPL BYTM1 ;IN BYTE MODE? + TDZA A,A ;NO, CLEAR ABS PART OF VALUE + HLLZ A,BYTWP ;YES, USE LH(BP) AS ABS PART + JRST CLBPOP + +$.H: (GLOETY)+SQUOZE 0,$. ;CURRENT LOCATION + OFFSET IN LOADER +$L.H: (GLOETY)+SQUOZE 0,$L. ;LOCATION BEING LOADED INTO BY LOADER, USED BY ABLOCK +$O.H: (GLOETY)+SQUOZE 0,$O. ;LOADER OFFSET +$R.H: (GLOEXT)+SQUOZE 0,$R. ;RELOCATION AS GLOBAL + +COLON: TRNE I,IRLET + TRNN I,IRSYL + ETA [ASCIZ/Colon without preceding symbol/] + TLNN I,ILWORD + TRNE I,IROP+IRPSUD+IREQL+IRNOEQ + ETSM [ASCIZ/Label inside an expression/] + SKIPE ASMOUT + ETSM [ASCIZ /Label inside <>, () or []/] + TLZ FF,FLHKIL + PUSHJ P,RCH ;GET NEXT CHAR + CAIN A,": ;IF NEXT CHAR ANOTHER COLON, + TLOA FF,FLHKIL ;THEN SET FLAG TO HALF-KILL + TLO FF,FLUNRD ;NOT COLON, CAUSE IT TO BE RE-INPUT + SKIPE HKALL ;CHECK FOR HALF-KILL-ALL-LABELS MODE. + TLO FF,FLHKIL + MOVE T,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 + HLL T,BYTWP ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER + ADD T,OFLOC ;ADD OFFSET + MOVEM T,WRD ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT + EXCH T,SYLOC ;NOW SET UP STUFF FOR ERROR PRINTOUT + MOVEM T,SYLOC1 + EXCH SYM,SYSYM + MOVEM SYM,SYSYM1 + MOVE SYM,SYSYM + MOVE A,CRLOC ;SET UP RELOCATION + ADD A,OFRLOC + MOVEM A,WRDRLC + SETOM LABELF ;SET FLAG CAUSING 3LABEL (DON'T REDEFINE) TO BE SET. + SKIPN LDCCC + TRNE FF,FRGLOL + JRST GCOL1 ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL + PUSHJ P,ESDCHK ;TRY FINDING CURRENT ENTRY IN ST + JRST EQL1A ;NOT ALREADY DEFINED +IFN CREFSW,XCT CRFLBL +COLON1: MOVEI T,(C) ;BKTAB IDX OF BLOCK FOUND IN, + CAIE T,(TM) ;FOUND IN DESIRED BLOCK => TRY REDEFINING. + JRST COLON3 + TLO C,3LABEL ;CAUSE REDEFINING SYMBOL TO BARF + XCT COLON2(A) ;BUT MAYBE PRINT ERR MSG FIRST. + JRST EQL1B + +CASSM1: JRST ASSEM1 + +COLON3: JUMPN T,EQL10 ;NOT INITIAL SYM => CAN SHADOW, + CAIN A,SYMC_-14. ;INITIAL SYM => CAN SHADOW IF IT'S AN ORDINARY LOCAL SYM + CAME B,WRD ;AND NEW VALUE SAME AS OLD VALUE. + CAIA + SKIPE WRDRLC + ETSM ERRRES ;ELSE GIVE ERROR MESSAGE BEFORE SHADOWING, TO WARN USER. + JRST EQL10 + +ERRRES: ASCIZ /Pseudo, macro or initial sym as label/ +ERRMDT: ASCIZ /Multiply defined/ + +COLON2: TLO C,3MULTI ;COMMON + ETSM ERRRES ;MACRO OR PSEUDO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI ;SETTING 3MULTI CAUSES EQL1B TO PRINT AN MDT ERROR. + JRST EQL1D ;GLOBAL ENTRY + JRST EQL1E ;GLO EXIT + +;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL + +GCOL1: IFN CREFSW,XCT CRFLBL ;DEFINING ORDINARY SYM. + SKIPGE CONTRL + ETASM [ASCIZ /Virtual label in abs assembly/] + PUSHJ P,ESDCHK ;FIND ITS SLOT IN ST + JRST EQL2 ;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES. + MOVEI T,(C) + CAIE T,(TM) + JRST COLON5 + XCT GCOL1T(A) ;FOUND IN DESIRED BLOCK, REDEFINING. + JRST EQL2 + +COLON5: JUMPN T,EQG2 ;SHADOWING, OK UNLESS INITIAL SYM. + ETSM ERRRES + JRST EQG2 + +GCOL1T: TLO C,3MULTI ;COMMON + ETSM ERRRES ;PSEUDO. + JRST EQL2 ;SYM. + JRST EQGUL ;LOCAL UNDEF. + TLO C,3MULTI ;VAR + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + JRST EQL7 ;DEF GLO + JRST EQL8 ;UNDEF GLO. + + + ;PUNCH OUT "DEFINE SYM AS $." + +PDEFPT: MOVEI A,CDEFPT + PUSHJ P,P7X ;OUTPUT 7 THEN PDEFPT + JRST OUTSM0 ;OUTPUT SYM, WITHOUT BITS + +;LOC, BLOCK, .= + +ALOC: PUSHJ P,ALOCRG ;LOC, GET ARG +ALOC1: SETZM SYLOC ;CLEAR OUT LOC OF LAST TAG + SETZM SYSYM ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS +IFN FASLP,[ + SKIPGE TM,CONTRL + TRNN TM,FASL + JRST .+2 + ETA [ASCIZ /LOC illegal in FASL assembly/] +] + TRZE LINK,400 ;GLOBALS IN ARG? + JRST ALOC2 ;YES + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF CURRENT LOCATION + CALL SLOCF ;RE-INIT NEXT OUTPUT BLOCK'S HEADER; SET LOCF. + MOVEI A,LCEGLO ;=> RESET GLOBAL RELOCATION (BACK TO ORIGINAL NON-GLOBAL RELOCATION) + TLZE LINK,400000 ;IS CURRENT LOCATION NOW GLOBAL? + PUSHJ P,PLDCM ;YES, RESET IT + MOVE B,WRDRLC ;GET BACK NEW RELOCATION +ALOC2B: TRZE B,-2 ;NO BITS ALLOWED EXCEPT LOW ORDER + ETR [ASCIZ *Illegal relocation in LOC/BLOCK/.=*] + HRRZM B,CRLOC ;STORE NEW RELOCATION + SKIPGE CONTRL + JRST ASSEM1 ;DON'T BOTHER WITH REST IF ABS. + MOVEI B,2(B) ;LABS OR LREL + DPB B,[310700,,BKBUF] ;STORE NEW BLOCK TYPE + MOVEM B,CDATBC ;ALSO STORE AS NORMAL BLOCK TYPE +AOFSTX: TDNN LINK,[SETZ(SETZ)] ;ENTRY FROM AOFFSET, SKIP IF FRGLOL SHOULD BE SET + TRZA FF,FRGLOL ;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG + TRO FF,FRGLOL ;GLOBAL, SET FLAG + TRZ LINK,600 ;CLEAR OUT TEMPORARY FLAGS SO WON'T GET STORED IN GLOCTP + MOVEM LINK,GLOCTP ;STORE BACK STATUS FLAGS + JRST ASSEM1 + +PTEQ: MOVE SYM,[SQUOZE 0,LOC] + PUSHJ P,ALOCRG ;.=, GET ARG + MOVE T,[MINF+HFWDF,,$O.H] ;GLOTB ENTRY IF .+1 DOESN'T SKIP + TRNE LINK,400000 ;OFFSET GLOBAL? + JRST PTEQ2 ;YES, WANT TO DO LOC ARG-$O." + PUSHJ P,SBWDOF ;OFFSET IS LOCAL, SUBTRACT FROM ARG + JRST ALOC1 + +ABLOCK: PUSHJ P,ABLKRG ;GET ARG TO "BLOCK" PSEUDOOP. + TRNE LINK,400 ;GLOBALS IN ARG? + JRST ABLKG ;GLOBALS IN ARG + TLNE LINK,400000 + JRST ABLKG ;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL +IFN FASLP,[ + MOVE D,CONTRL + TRNN D,FASL ;IN FASL FORMAT, CAN'T SET LOC. CTR., + JRST ABLKF1 + SKIPE B + ETA [ASCIZ /BLOCK size relocatable/] + JUMPGE FF,ABLKF1 + CALL ABLKF ;SO ON PASS 2 OUTPUT A BUNCH OF ZEROS. + JRST ABLKF1 + +;OUTPUT C(A) ZEROS, IN FASL FORMAT. NO-OP ON PASS 1. DOESN'T SET THE LOCATION COUNTER. +ABLKF: JUMPE A,CPOPJ + JUMPGE FF,CPOPJ + SETZM WRD + SETZM WRDRLC + PUSH P,A + PUSH P,A +ABLKF2: CALL FASPW + MOVEMM GLSP2,GLSP1 + SOSE (P) + JRST ABLKF2 + JRST POPBAJ +] + +ABLKF1: JUMPL A,[ETA [ASCIZ /BLOCK size negative/]] + ADD A,CLOC ;ARG TO BLOCK IS LOCAL, ADD DIRECTLY TO CLOC + ADD B,CRLOC ;ALSO ADD RELOCATIONS + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF LOCATION + CALL SLOCF ;FALL INTO ALOC ROUTINE, MAKING SURE FRLOC GETS SET + JRST ALOC2B + + +SBWDOF: SUB A,OFLOC ;SUBTRACT OFFSET FROM WRD, ETC. IN A,B + HRRZM A,WRD ;MAKE SURE RESULT GETS STORED IN WRD, AS WELL AS AC'S + SUB B,OFRLOC ;NOW DO RELOCATIONS + HRRZM B,WRDRLC + POPJ P, + +ABLKG: TRNE LINK,400000 ;GLOBAL BLOCK, IS OFFSET GLOBAL? + JRST ABLKG2 ;YES, OK TO REFERENCE $L. + PUSHJ P,SBWDOF ;NO, FOR COMPATIBILITY, DON'T REFERENCE $L. + SKIPA T,[HFWDF,,$.H] +ABLKG2: MOVE T,[HFWDF,,$L.H] +PTEQ2: AOS GLSP1 ;STORE T IN GLOTB + MOVEM T,@GLSP1 +ALOC2: TLO LINK,400000 ;SET GLOBAL LOCATION FLAG + MOVEI A,LCGLO ;=> GLOBAL LOCATION ASSIGNMENT + PUSHJ P,PLDCM ;PUNCH OUT GLOBAL LOCATION ASSIGNMENT + SETZM CLOC ;CLEAR OUT CLOC, NEW RELOCATION NOW + SETZB B,BKBUF ;ALSO CLEAR OUT HEADER, JUST TO BE SURE + AOJA B,ALOC2B ;SET RELOCATION TO 1 AND FALL IN + +AOFFSET: PUSHJ P,AOFFS2 ;OFFSET, GET ARG + MOVE A,T + MOVEM A,WRD ;RESTORE UNTRUNCATED ARG. + TRZE LINK,400 ;GLOBALS IN ARG? + TROA LINK,400000 ;GLOBALS IN ARG, SET GLOBAL OFFSET FLAG + TRZ LINK,400000 ;NO GLOBALS IN ARG + MOVEM A,OFLOC ;STORE NEW OFFSET + MOVEM B,OFRLOC ;ALSO STORE RELOCATION BITS + SKIPGE CONTRL ;IN RELOCATABLE, + JRST AOFSTX + MOVEI A,LDOFS ;LOADER OFFSET LOADER COMMAND TYPE + PUSHJ P,PLDCM ;PUNCH OUT LOADER COMMAND + JRST AOFSTX + +;GET ARG TO LOC, BLOCK, .=, OFFSET + +ALOCRG: +ABLKRG: MOVE A,CLOC + SKIPN CRLOC + JRST [ CAML A,DECBRA ;IF ADDR BEFORE THE LOC WAS ABS, + MOVEM A,DECBRA ;UPDATE HIGHEST ABS ADDR IF NEC. + JRST ABLKR1] + CAML A,DECTWO ;IT WAS RELOCA; UPDATE HIGHEST + JRST [ CAML A,DECBRH ;ADDR OF APPROPRIATE SEG. + MOVEM A,DECBRH + JRST ABLKR1] + CAML A,DECBRK + MOVEM A,DECBRK +AOFFS2: +ABLKR1: PUSH P,SYM + PUSHJ P,CONBAD ;ERROR IF IN GROUPING + REST SYM + TRNE I,IRNOEQ\IRPSUD\IREQL + ETSM [ASCIZ /Inside pseudo or =/] + TDNE I,[ILWORD,,IRFLD] + ETSM ERRNVL + PUSHJ P,EBLK ;MAYBE END CURRENT OUTPUT BLOCK + PUSHJ P,AGETWD ;GET ARG + MOVE LINK,GLOCTP ;GET GLOCTP FLAGS IN LINK, STAYS THERE UNTIL ALMOST DONE + MOVE T,GLSP2 + CAME T,GLSP1 + TROA LINK,400 ;SIGNAL GLOBAL ARG + TRZ LINK,400 ;LOCAL + MOVE T,A ;SAVE UNTRUNCATED FOR AOFFSET, + HRRZS A,WRD ;TRUNCATE FOR LOC, BLOCK, .=. + TRNN I,IRDEF ;ALL DEFINED? + JRST ASSEM1 + SKIPGE CONTRL ;YES, RETURN SKIPPING OVER ARG + TRNN LINK,400 + RET + MOVE SYM,GTVER + ETASM [ASCIZ *Argument has externals*] + +;;CONSTANTS AND VARIABLES + ;VARIABLES AREA +VBLK + +LCNGLO==CONMIN/4 +LCONTB==CONMIN + +BLCODE [ +PCNTB: BLOCK NCONS*3 ;CONSTANTS AREAS TABLE +VARTAB: BLOCK NVARS +] +CONTBA: CONTAB ;ADDRESS OF BEGINNING OF CONSTANTS TABLE. +CONTBE: CONTAB+LCONTB ;ADDRESS OF WORD AFTER END OF CONSTANTS TABLE. +PLIM: 0 ;POINTER TO FIRST UNUSED WORD IN CONSTANTS TABLE. + +CONGLA: CONGLO ;ADDRESS OF BEGINNING OF CONSTANT-GLOBALS TABLE. +CONGLE: CONGLO+LCNGLO ;ADDRESS OF WORD AFTER END OF CONSTANT GLOBALS TABLE. +CONGOL: 0 ;HAS ADR OF FIRST WORD INACTIVE IN CONSTANT-GLOBALS TABLE. + +CONBIA: CONBIT ;ADDRESS OF BEGINNING OF CONSTANT-RELOCATION-BITS TABLE. + +CONLEN: CONMIN ;TOTAL SPACE ALLOCATED TO CONSTANTS TABLES. + ;ALL THE HOOKS ARE IN FOR DYNAMIC ALLOCATION OF THESE TABLES + ;(CONTAB, CONGLO, AND CONBIT). ALL THAT IS NEEDED IS TO GET + ;THE SPACE AND INITIALIZE CONTBA, CONTBE, CONGLA, CONGLE, CONBIA. + + ;PCNTB STUFF + + ;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL +CSQZ: 0 ;SQUOZE COUNTER + ;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET) + ;THIRD WORD LH FLAGS + +CGBAL==100000 ;GLOBAL (INCLUDING OFFSET) +CTRL==200000 ;RELOCATED ( " ) +CTDEF==400000 ;DEFINED (MUST BE SIGN) + +PBCON: 0 ;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA +PBCONL: 0 ;POINTER TO ABSOLUTE TOP OF PCNTB +CONCNT: 0 ;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA) +CONDEP: 0 ;DEPTH IN CONSTANTS (0 TOP LEVEL) +CONSAD: 0 ;ADDR IN CONSTANTS TABLE OF ENTRY FOR CURRENT CONST. +CONSML: 0 ;VALUE OF .MLLIT INTSYM. + ;NEGATIVE => ERROR MODE (DEFAULT) + ;ZERO => OLD MODE. + ;POSITIVE => NEW (MULTI-LINE) MODE. + +CONSTP: 0 ;PDL POINTER BELOW WDS FOR INNERMOST CONSTANT. +CONSP1: 0 + + ;VARIABLES FOR VARIABLES CODING + +VARCNT: 0 ;NO OF VAR IN CURRENT VAR AREA SO FAR +VARPNT: 0 ;POINTER TO CURRENT PLACE IN VARTAB +VARCNR: 0 ;NO OF TIMES VARIABLES MAY APPEAR +VCLOC: 0 ;TEM FOR VARIAB +VECSIZ: 0 ;DEFAULT SIZE FOR .VECTOR. + +PBLK + +;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD +;SAVE WORLD, BYTE MODE, ASSEM1 PDL LEVELS. +;THEN SET ASSEM1 PDL LEVELS TO CURRENT LEVELS +;SO ASSEM1 WON'T FLUSH PAST LEVEL OF CONSTANT. +;SET CONSTP _ CURRENT PDL LEVEL. PCONS WILL PUT WORDS +;OF CONSTANT ABOVE CONSTP, AND SET ASSEMP ABOVE THEM. + +LBRAK: SKIPE LITSW + ETR [ASCIZ /Literal/] + TRO I,IRFLD ;LEFT BRACKET + JSP LINK,SAVWD1 ;SAVE CRUFT + PUSH P,SCNDEP ;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT. + JSP LINK,SAVAS1 + MOVEIM ASMOUT,3 + SETZM SCNDEP ;NOT WITHIN CONDITIONALS IN THIS LITERAL. + AOS CONDEP ;ONE DEEPER IN LITERALS. + MOVEI A,IRPSUD\IREQL + ANDCAM A,ASMI + JRST ASSEM3 ;GO ASSEMBLE THE WORDS OF THE CONSTANT. + +;OUTPUT WORD TO CONSTANT. P MUST EQUAL ASSEMP HERE. +PCONS: SKIPL CONTRL ;IF RELOCATABLE, + PUSHJ P,$RSET ;HANDLE STRANGE RELOCATIONS. + MOVE B,GLSP1 + SUB B,GLSP2 ;NUM. GLOBAL ENTRIES FOR THIS WD. + HLRZ A,WRDRLC ;ONLY 1.1 AND 3.1 BITS MATTER. + LSH A,1 + IOR A,WRDRLC ;GET THEM INTO 1.1, 1.2 BITS. + TLNE I,ILNOPT ;REMEMBER ILNOPT ALSO. + IORI A,4 + DPB B,[032200,,A] ;AND # GLBLS. + PUSH P,A ;SAVE THEM ALL. + HRLI B,(B) ;GET # GLBLS,,# GLBLS . + JUMPE B,PCONS1 + MOVE A,GLSP2 + MOVSI A,1(A) + HRRI A,1(P) ;SAVE THE GLBLS, IF ANY. + ADD P,B + JUMPGE P,CONFLP + BLT A,(P) +PCONS1: PUSH P,WRD + MOVEM P,ASSEMP ;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW. + JRST (T) + +;JSP LINK,SAVAS1 TO PUSH DATA ON ASSEM1 LEVEL AND CALL ASSEM1 +;LOOP RECURSIVELY. +.SEE CONNDP ;WHICH IS WHERE THESE THINGS ARE POPPED. +SAVAS1: SKIPN BYTM ;IF IN BYTM NOW (WILL PUSH AND TURN OFF) + JRST LBRAK1 + MOVSI A,BYBYT ;SAVE ALL THE DETAILS. + HRRI A,1(P) + ADD P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] + JUMPGE P,CONFLP ;(SOFTWARE-DETECTED PDL-OV) + BLT A,-BYTMCL(P) + MOVSI A,BYTMC + HRRI A,1-BYTMCL(P) + BLT A,(P) +LBRAK1: PUSH P,BYTM + SETZM BYTM + PUSH P,ASMOUT + PUSH P,ASMDSP + PUSH P,ASMI + PUSH P,GLSPAS ;SAVE ASSEM1 PDL LEVELS. + PUSH P,ASSEMP + PUSH P,CONSTP + MOVE A,I + ANDI A,IRPSUD+IREQL + IORI A,IRDEF + MOVEM A,ASMI ;ASMI IOR'D INTO I AT ASSEM2 LOOP. + HRRZ A,CPGN + HRL A,CLNN ;REMEMBER WHERE THIS LITERAL STARTS. + INSIRP PUSH P,[A SYSYM SYLOC] + MOVEM P,ASSEMP ;SO ASSEM1 WON'T FLUSH WHAT WE PUSHED. + MOVEM P,CONSTP ;SO CONND CAN FIND 1ST WD OF CONSTANT. + MOVEMM GLSPAS,GLSP1 +SAVAS2: MOVEI A,ASSEM3 ;IF NOT MULTI-LINE MODE, ARRANGE TO + SKIPG CONSML ;END THE CONSTANT AFTER 1 WORD. + MOVEI A,ASSEMC + MOVEM A,ASMDSP + JRST (LINK) + +PCONST: MOVE CH1,ASMDSP ;OUTPUT TO CONST. FROM ASSEM1 + CAIN CH1,CONND ;LAST WD OF CONST? + CAME P,CONSTP ;1ST WD? + JRST PCONS ;NO, DO THE GENERAL THING. + SKIPL CONTRL ;THIS MUST BE ONLY WORD OF CONST, + PUSHJ P,$RSET ;DON'T BOTHER PUSHING, END CONST. NOW. + PUSH P,CONSTP + TLZ I,ILMWRD+ILMWR1 ;THIS IS 1ST WD, NO MORE WDS. + JRST CONND3 ;PRETEND JUST POPPED IT. + +;COME HERE FROM ASSEM1 TO END A CONSTANT. +CONND: SKIPE BYTM ;IF IN BYTE MODE, LEAVE IT AND DO .WALGN + JRST A.BY3 ;(WILL COME BACK SINCE ASMDSP STILL SET) +CONNDW: MOVEMM CONSP1,CONSTP + TLZ I,ILMWR1 ;THIS IS 1ST WORD COMING UP. +CONND0: TLZ I,ILMWRD+ILNOPT + SETZM WRDRLC + MOVE F,CONSP1 ;ADDR IN IN PDL OF NEXT WD. + CAMN F,ASSEMP + JRST CONND2 ;J IF NO WORDS. + MOVE A,1(F) ;GET SAVED NUM GLBLS,,NUM GLBLS + DPB A,[100,,WRDRLC] + LSH A,-1 ;RESTORE WRDRLC BITS 1.1, 3.1 + DPB A,[220100,,WRDRLC] + TRNE A,2 + TLO I,ILNOPT ;RESTORE NOOPTF. + LSH A,-2 ;GET # GLBLS. + HRLI A,(A) ;# GLBLS,,# GLBLS. + AOBJN F,.+1 + HRRZM F,GLSP2 ;ADDR BEFORE 1ST GLOBAL ENTRY. + ADD F,A + HRRZM F,GLSP1 ;ADDR OF LAST GLOBAL ENTRY. + MOVE A,1(F) + MOVEM A,WRD + AOBJN F,.+1 ;POINT TO NEXT CONST WD IF ANY, + MOVEM F,CONSP1 + CAME F,ASSEMP ;IF MORE WORDS SET ILMWRD + TLO I,ILMWRD + JRST CONND3 + +CONND2: INSIRP SETZM,[WRD,GLSP1,GLSP2] +CONND3: MOVE F,GLSP1 + SUB F,GLSP2 + JUMPE F,SCON ;JUMP IF NOTHING VIRTUAL + MOVEI B,-1(F) + MOVN TT,B + JUMPE B,SCON ;JUMP IF ONLY ONE GLOBAL + ;SORT GLOTB ENTRIES THIS CONSTANT +LSORT: HRL T,TT ;SET UP AOBJN POINTER TO GLOBALS REMAINING + HRR T,GLSP2 +LSORT2: MOVE A,1(T) + CAMLE A,2(T) + EXCH A,2(T) ;INTERCHANGE + MOVEM A,1(T) + AOBJN T,LSORT2 ;INNER LOOP POINT + SOJG B,LSORT ;OUTER LOOP + ;DROPS THROUGH + +;DROPS THROUGH +SCON: PUSHJ P,RCHKT + PUSHJ P,RMOVET ;SET UP RELOACTION BITS. + ROT T,2 ;ROTATE TO BOTTOM TWO BITS OF T + TLNE I,ILMWRD+ILMWR1+ILNOPT + JRST NOCON ;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH + MOVE A,CONTBA +SCON1: CAML A,PLIM ;SEARCH CONSTANTS TABLE TO SEE IF ALREADY THERE + JRST NOCON ;END OF TABLE, NO MATCH + MOVE B,WRD + CAME B,(A) +SCON2: AOJA A,SCON1 ;VAL DISAGREES + PUSHJ P,CPTMK ;GET BP TO CONSTANTS-BIT TABLE IN C + LDB F,C ;GET RELOCATION BITS THIS CONSTANT + CAME F,T + JRST SCON2 ;RLC DIFFRS + MOVE B,CONGLA ;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS + SKIPA C,GLSP2 +SCON2B: AOS B ;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR + CAML B,CONGOL + JRST SCON3 ;GLOBALS MATCH SO FAR + CAME A,1(B) ;SKIP IF ONE FOUND +SCON7: AOJA B,SCON2B ;NOT YET + MOVE D,(B) ;FOUND ONE, GET GLOTB ENTRY + CAME D,1(C) ;COMPARE WITH THIS ENTRY IN GLOTB + JRST SCON2 ;NO MATCH, FLUSH THIS CONSTANT + AOJA C,SCON7 ;MATCH, TRY NEXT GLOBAL + +SCON3: CAME C,GLSP1 ;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB? + JRST SCON2 ;NO, BACK TO SEARCH + JRST NOCON4 + +NOCON: AOS A,PLIM ;CONSTANT NOT ALREADY IN TABLE + CAMLE A,CONTBE + ETF [ASCIZ/Literal table full/] + MOVE AA,WRD + MOVEM AA,-1(A) + SOS A + PUSHJ P,CPTMK + TLNE I,ILNOPT + TRO T,4 ;1.3 OF RELOCATION BITS => DON'T OPTIMIZE ON TOP OF ME + DPB T,C + MOVE B,GLSP2 +NOCON3: CAML B,GLSP1 + JRST NOCON4 + SKIPN C,1(B) + AOJA B,NOCON3 ;THIS ENTRY NOT REALLY HERE + MOVEM C,@CONGOL + HRRZS C + PUSHJ P,NOCON5 + MOVEM A,@CONGOL + PUSHJ P,NOCON5 + SKPST C, ;SKIP IF IN SYMBOL TABLE + AOJA B,NOCON3 + 3GET1 D,C ;IN SYMBOL TABLE + TLO D,3VCNT ;THIS SYM USED IN CONSTANT + 3PUT1 D,C ;UPDATE 3RDWRD TABLE ENTRY + AOJA B,NOCON3 + +NOCON5: AOS AA,CONGOL + CAML AA,CONGLE + ETF [ASCIZ/Constants-global table full/] + POPJ P, + + ;SET UP BYTE POINTER TO CONSTANTS-BIT TABLE + ;A SHOULD HAVE ADR OF CONSTANTS TABLE ENTRY + ;LEAVES ANSWER IN C + ;BITS IN CONSTANTS-BIT TABLE PER ENTRY: + ;1.2, 1.1 RELOCATION BITS + ;1.3 ILNOPT BIT => DON'T OPTIMIZE ON TOP OF ME + +CPTMK: PUSH P,A + SUB A,CONTBA + PUSH P,B + IDIVI A,12. + MOVEI C,(A) + ADD C,CONBIA ;SET UP ADDRESS PART + IMULI B,3 + DPB B,[360600,,C] ;STORE POSITION FIELD FROM REMAINDER + TLO C,200 ;SET UP SIZE FIELD +POPBAJ: POP P,B + JRST POPAJ + +NOCON4: TLON I,ILMWR1 + MOVEM A,CONSAD ;IF 1ST WD SAVE ADDR. + TLNE I,ILMWRD ;IF MORE WORDS, HANDLE NEXT. + JRST CONND0 + MOVE P,CONSTP ;VALUE OF CONSTP AT CONND. + MOVE C,GLSPAS ;TO RESTORE GLSP1 + JSP T,CONNDP ;POP STUFF. + HRRZ A,CONSAD ;ADDR OF CONSTANTS TABLE ENTRY OF 1ST WD. + MOVE B,PBCON ;ADDR OF WDS DESCRIBING CONST. AREA. + SKIPL 2(B) ;CONST. AREA LOCATION DEFINITE? + AOJA C,CONND6 ;NO, USE GLOBAL. + MOVEM C,GLSP1 + HRRZ C,1(B) ;ADD ACTUAL ADDR OF CONST. AREA. + ADDI A,(C) ;GET C(CONTBA) + ADDR OF CONSTANT. + LDB B,[420100,,2(B)] + JRST CONND7 + +CONND6: MOVEM C,GLSP1 + MOVEM B,(C) + MOVEI B,0 +CONND7: SUB A,CONTBA + JRST LSSTH3 ;POP OUT INTO OUTER WORD. + +.SEE SAVAS1 ;WHICH IS WHAT PUSHES WHAT CONNDP POPS. +CONNDP: SUB P,[3,,3] ;FLUSH SAVED SYLOC AND SYSYM AND CLNN,,CPGN. +CONFL2: HRL T,ASMOUT ;REMEMBER IF POPPING A LITERAL OR NOT. + INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,ASMI,ASMDSP,ASMOUT,BYTM] + SKIPN BYTM ;IF IN BYTE MODE, POP DETAILS. + JRST CONND5 + MOVSI A,1-BYTMCL(P) + HRRI A,BYTMC + BLT A,BYTMC+BYTMCL-1 + MOVSI A,1-BYTMCL-LBYBYT(P) + HRRI A,BYBYT + BLT A,BYBYT+LBYBYT-1 + SUB P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] +CONND5: HLRZ A,T + CAIE A,3 + JRST (T) + POP P,A + ADDM A,SCNDEP ;DON'T FORGET ABOUT ANY CONDITIONALS. + SOS CONDEP ;HAVE POPPED ONE CONSTANT. + JRST (T) + +CONFLS: MOVE P,ASSEMP ;FLUSH ALL CONSTANTS. + CAMN P,[-LPDL,,PDL] ;IF IN ANY, + JRST (LINK) + MOVE P,CONSTP ;POINT AFTER ITS PDL ENTRY, + JSP T,CONNDP ;POP IT, + JRST CONFLS ;TRY AGAIN. + +CONBAD: SKIPN ASMOUT ;IF IN GROUPING, ERROR. + POPJ P, + ETSM [ASCIZ/Within <>, () or []/] + JRST ASSEM1 + +;COME HERE FOR PDL-OV ON P. +;IF IN A CONSTANT, FLUSH ALL OF THEM, SAYING WHERE EACH STARTED. +;THEN TYPE A PDL ERROR MSG AND RETURN TO ASSEM1. +;OTHERWISE FATAL ERROR. +CONFLP: MOVEI LINK,ASSEM1 + MOVEI CH1,ERRPDL + SKIPE CONDEP + JRST CONFL3 ;IN A CONSTANT. + MOVEI P,PDL ;RE-INIT PDL SO NO MORE PDL-OV. + ETF ERRPDL +ERRPDL: ASCIZ /PDL overflow/ + +;JSP LINK,CONFLM TO FLUSH CONSTANTS, SAYING WHERE THEYY STARTED, +;AND GIVE ERROR MSG. +CONFLM: MOVE CH1,ASMOUT + SKIPA CH1,ASMOT3(CH1) +CONFLZ: SETZ CH1, ;LIKE CONFLM BUT NO ERR MSG AT END. +CONFL3: SETO C, +CONFL1: MOVE P,CONSTP ;GET STACK ABOVE INNERMOST LITERAL. + REST SYLOC + REST SYSYM + REST D ;GET INFO ON WHERE STARTED + AOSN C ;THE 1ST TIME ONLY, SAY WHAT'S GOING ON. + TYPR [ASCIZ/Within groupings: /] + SKIPE C + TYPR [ASCIZ/, /] + MOVE A,ASMOUT ;SAY WHAT KIND OF GROUPING IS BEING CLOSED + MOVE A,ASMOT5(A) + CALL TYOERR ;BY SAYING WHAT CHAR OPENED IT. + JSP T,CONFL2 ;POP REST OF WDS SAVED AT LBRAK. + TYPR [ASCIZ/ at /] + MOVEI A,1(D) ;PAGE # GROUPING STARTED ON. + CALL DPNT ;PRINT IN DECIMAL. + MOVEI A,"- + CALL TYOERR + HLRZ A,D ;LINE NUMBER IT STARTED ON. + ADDI A,1 + CALL D3PNT2 ;PRINT W/ AT LEAST 3 CHARS, NO ZERO SUPPR. + MOVE A,ASSEMP + CAME A,[-LPDL,,PDL] ;MORE GROUPINGS TO POP => DO. + JRST CONFL1 + CALL CRRERR + MOVE P,ASSEMP + JUMPE CH1,(LINK) ;IF CALLED CONFLZ, NO ERR MSG (CALLER WILL GIVE ONE) + ETR (CH1) ;[ NO] OR PDL. + CALL CRRERR + JRST (LINK) + +;CONSTA + +CNSTNT: NOVAL + SKIPE ASMOUT ;IF ANY GROUPNGS, + JSP LINK,CONFLM ;FLUSH THEM, GIVE ERROR. + PUSHJ P,CNSTN0 + JRST ASSEM1 + +CNSTN0: SOSGE CONCNT ;ENTRY FROM AEND + ETF [ASCIZ /Too many constants areas/] + MOVE B,CLOC + ADD B,OFLOC + HRRZ T,PBCON + TRNN FF,FRPSS2 + JRST CNST1 ;PASS 1 + + MOVSI A,CGBAL + TDZ A,2(T) + TRNE FF,FRGLOL + TLC A,CGBAL + SKIPN A + ETR [ASCIZ /Constants globality phase error/] + HRRZ B,1(T) + SUB B,OFLOC + HRRZS B + CAME B,CLOC + ETR [ASCIZ /Constants location phase error/] + MOVE B,2(T) + ROT B,2 + XOR B,CRLOC + XOR B,OFRLOC + TRNE B,1 + ETR [ASCIZ /Constants relocation phase error/] + ;DROPS THROUGH + +;DROPS THROUGH +CNST2: MOVEI D,(T) ;STE IDX IN D FOR OUTSM0 + MOVE SYM,(T) ;GET NAME OF AREA + TLC SYM,400000#LCUDF ;CLEAR LCUDF, SET HALF-KILL + TRNE FF,FRGLOL + PUSHJ P,PDEFPT ;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA + MOVE A,CONTBA +CNSTH: CAML A,PLIM + JRST CNSTA ;THRU + MOVE TT,(A) + MOVEM TT,WRD + PUSHJ P,CPTMK + LDB F,C ;GET THIS CONSTANT'S RELOCATION BITS + TRZE F,2 + TLO F,1 ;RELOCATE LEFT HALF + MOVEM F,WRDRLC ;STORE RELOCATION + MOVEI D,GLOTB ;AND NOW TO SET UP GLOTB! + MOVEM D,GLSP2 + MOVE C,CONGLA +CNSTC: CAML C,CONGOL + JRST CNSTB ;END OF CONSTANT-GLOBAL TABLE + CAMN A,1(C) ;POINTS TO THIS CONSTANT? + PUSH D,(C) ;YES, STORE ENTRY IN GLOTB + AOS C + AOJA C,CNSTC + +CNSTB: HRRZM D,GLSP1 ;MARK END OF ACTIVE PART OF GLOTB + PUSH P,A + PUSHJ P,PWRD ;OUTPUT THIS CONSTANT + AOS CLOC ;INCREMENT CLOC TO NEXT + HRRZS CLOC ;MAKE SURE IT STAYS IN A HALF-WORD (IMPORTANT SINCE MAY BE LESS THAN RELOCATION) + POP P,A ;RESTORE POINTER INTO CONSTANTS TABLE + AOJA A,CNSTH + +CNST3: HLRZ A,1(T) ;GET POINTER TO TOP OF AREA STORED DURING PASS 1 + CAMN A,CLOC ;SAME AS CURRENT? + JRST CNSTE ;YES, NO HAIR + CAMGE A,CLOC ;DIFFERENT; LOWER? + ETR [ASCIZ /More constants on pass 2 than 1/] + ;INSUFFICIENT CONSTANT SPACE; CONSTANTS AREA TRYING TO BE BIGGER + ;IN PASS 2 THAN PASS 1; THE EXTRA CONSTANTS WERE BACKED OVER + MOVEM A,CLOC ;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE + PUSHJ P,EBLK ;END CURRENT BLOCK + CALL SLOCF ;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED + JRST CNSTE + +;CALL SLOCF WHENEVER "." IS CHANGED WITHOUT THE OUTPUTTING OF A STORAGE WORD. +SLOCF: MOVE A,CLOC ;STORE NEW "." IN HEADER FOR NEXT BLOCK OF OUTPUT. + SKIPGE TM,CONTRL + TRNN TM,DECREL+FASL ;BUT NOT IN DEC OR FASL OUTPUT FORMATS. + HRRM A,BKBUF + IORI FF,FRLOC ;MAKE SURE NULL BLOCK IS OUTPUT IF NEC. TO TELL LOADER "." HAS CHANGED. + RET + +;CONSTA DURING PASS 1 + +CNST1: HRRM B,1(T) ;STORE LOCATION OF AREA + MOVEI D,0 + MOVE A,CRLOC + ADD A,OFRLOC + TRNE A,1 + TLO D,CTRL ;RELOCATED + TRNE FF,FRGLOL + TLO D,CGBAL ;GLOBAL + IORM D,2(T) ;STORE FLAGS DESCRIBING AREA + JUMPL FF,CNST2 ;JUMP ON PUNCHING PASS, PUNCH OUT AREA NOW + MOVE T,PLIM + SUB T,CONTBA + ADDM T,CLOC ;PASS 1, JUST UPDATE CLOC + HRRZS CLOC + +CNSTA: HRRZ T,PBCON + TRNE FF,FRGLOL + JRST CNSTD ;LOCATION GLOBAL + TRNN FF,FRNPSS + SKIPGE 2(T) + JRST CNSTDA ;2 PASS ASSEMBLY OR AREA DEFINED + TRO I,IRCONT ;1PASS AND NOT DEFINED + SETZM PARBIT + PUSHJ P,P70 ;DEFINE SYM + MOVE A,(T) + TLC A,400000#LCUDF + SKIPE CRLOC + TLO A,100000 ;RELOCATE + PUSHJ P,$OUTPT + HRRZ A,1(T) + PUSHJ P,$OUTPT ;OUTPUT VALUE, FIRST LOCATION IN AREA + TRZ I,IRCONT +CNSTDA: MOVSI A,CTDEF + IORM A,2(T) ;CALL IT DEFINED +CNSTD: TRNE FF,FRPSS2 + JRST CNST3 ;PASS 2 + MOVE A,CLOC + HRLM A,1(T) ;MARK END OF AREA + +CNSTE: MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + MOVEI T,3 + ADDB T,PBCON + CAML T,PBCONL + MOVEM T,PBCONL + AOS A,CSQZ + MOVEM A,(T) + POPJ P, + +;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONSTANT-GLOBAL TABLE + +CONBUG: MOVE A,CONGLA ;B VAL C FLAGS ST(D) SADR + PUSH P,T + PUSH P,C ;SAVE FLAGS +CONBG2: MOVE C,(P) ;GET FLAGS + CAML A,CONGOL ;DONE WITH SCAN? + JRST CONBG1 ;YES + HRRZ F,(A) ;NO, GET CONSTANT-GLOBAL TABLE ENTRY + CAIE F,ST(D) ;POINT TO THIS SYM? + AOJA A,CONBG6 + PUSH P,B ;YES, SAVE VALUE, ABOUT TO WORK WITH B + MOVE T,(A) ;GET ENTIRE CONSTANT-GLOBAL TABLE ENTRY + LDB CH2,[221200,,T] ;GET MULTIPLICATION FIELD + SKIPE CH2 + IMUL B,CH2 ;NON-ZERO => MULTIPLY VALUE OF SYM + TLNE T,MINF + MOVNS B ;NEGATE VALUE + TLNE T,HFWDF + HRRZS B ;TRUNCATE TO HALFWORD + TLNE T,ACF + ANDI B,17 ;AC, MASK TO FOUR BITS + TLNE T,SWAPF + MOVSS B ;SWAP VALUE + TLNE T,ACF + LSH B,5 ;AC, SHIFT FIVE + ADD B,@1(A) ;ADD ABS PART OF VALUE + TLNN T,SWAPF + HRRM B,@1(A) ;NOT SWAPPED, STORE LH + TLNE T,SWAPF + HLLM B,@1(A) ;SWAPPED, STORE LH + TLNN T,HFWDF + MOVEM B,@1(A) ;FULL WORD, STORE VALUE + LDB CH1,[420200+P,,-1] ;GET HIGH BITS OF 3RDWRD, RELOCATION BITS + TLNE T,HFWDF ;NOW TO MAP RELOCATION BITS + TRZ CH1,2 + TLNE T,SWAPF + LSH CH1,1 + TRZE CH1,4 + TRO CH1,1 + PUSH P,A + HRRZ A,1(A) ;GET POINTER INTO CONSTANTS TABLE + PUSHJ P,CPTMK + LDB B,C ;GET RELOCATION BITS + TLNE T,MINF + JRST CONBG8 ;NEGATE + TRNE B,(CH1) + ETA ERRCRI + ;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT + ; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE + ;THAT ALSO SEARCHES CONSTANT-GLOBAL TABLE FOR $R. ALREADY THERE + IOR B,CH1 ;LOOKS OK, IOR IN BITS FOR GLOBAL +CONB8A: DPB B,C ;STORE BACK NEW RELOCATION BITS FOR CONSTANT + POP P,A + CLEARM (A) ;CLEAR OUT CONSTANT-GLOBAL TABLE ENTRY + CLEARM 1(A) + POP P,B + AOS A +CONBG6: AOJA A,CONBG2 ;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN + +CONBG1: MOVE A,CONGLA + PUSH P,B + MOVE B,CONGLA +CONBG7: CAML A,CONGOL + JRST CONBG3 + SKIPN C,(A) +CONBG5: AOJA A,CONBG4 + MOVEM C,(B) + MOVE C,1(A) + MOVEM C,1(B) + AOS B + AOJA B,CONBG5 + +CONBG4: AOJA A,CONBG7 +CONBG3: MOVEM B,CONGOL + POP P,B + POP P,C + POP P,T + POPJ P, +CONBG8: XORI B,3 + TRNE B,(CH1) + ETA ERRCRI + ANDCB B,CH1 + JRST CONB8A + +ERRCRI: ASCIZ /Multiple relocation in constant/ + +;VARIAB + +AVARIAB: NOVAL + SKIPE ASMOUT ;FLUSH ANY GROUPINGS IN PROGRESS. + JSP LINK,CONFLM + PUSHJ P,AVARI0 + JRST ASSEM1 + +AVARI0: SOSG VARCNR ;ENTRY FROM AEND + ETF [ASCIZ /Too many variable areas/] + MOVE D,SYMAOB ;SET UP AOBJN POINTER TO ST + MOVE T,CLOC + MOVEM T,VCLOC ;STORE AS LOCATION OF VARIABLE AREA + ADD T,OFLOC + MOVE C,CRLOC + ADD C,OFRLOC + TRNE FF,FRPSS2 + JRST AVAR1 ;PASS 2 + HRL T,VARCNT ;SIZE OF AREA + TRNE C,1 + TLO T,400000 ;RELOCATED + MOVEM T,@VARPNT + JRST AVAR2E + +AVAR1: HRRZ A,@VARPNT ;VARIAB DURING PASS 2 + CAIE A,(T) + ETR [ASCIZ /Variables location phase error/] + HLRZ A,@VARPNT + TRZE A,400000 + XORI C,1 + TRNE C,1 + ETR [ASCIZ /Variables relocation phase error/] + SKIPE VARCNT + ETR [ASCIZ /Variables area size phase error/] + +AVAR2E: HLRZ T,@VARPNT + TRNN T,377777 + JRST AVAR2C ;IF THIS VAR AREA IS EMPTY, DON'T SCAN SYMTAB. +AVAR2: HLRZ LINK,ST(D) ;SCAN, CHECKING EACH SYM FOR WHETHER IT'S A VARIABLE + CAIL LINK,DEFLVR + JRST AVAR2B + ADD D,WPSTE1 + AOBJN D,AVAR2 + JRST AVAR2C ;ALL SCANNED. + +AVAR2B: 3GET C,D ;FOUND A VARIABLE; DECIDE WHAT TO DO WITH IT. + MOVE B,ST+1(D) + MOVE SYM,ST(D) + TLZ SYM,740000 + LDB LINK,[400400,,ST(D)] + CAIE LINK,UDEFLV_-14. + CAIN LINK,UDEFGV_-14. + JRST AVAR3 ;UNDEFINED VARIABLE + CAIE LINK,DEFGVR_-14. + CAIN LINK,DEFLVR_-14. + JRST AVAR4 ;DEFINED VARIABLE +AVAR2A: ADD D,WPSTE1 + AOBJN D,AVAR2 ;CHECK ENTIRE SYMTAB +AVAR2C: HLRZ A,@VARPNT ;NOW GET SIZE OF AREA + TRZ A,400000 ;CLEAR OUT RELOCATION CHECK BIT +IFN FASLP,[ + MOVE D,CONTRL + TRNE D,FASL ;IN FASL ASSEMBLY, CAN'T JUST SET LOC CTR; MUST OUTPUT 0'S. + CALL ABLKF +] + ADD A,VCLOC ;ADD LOCATION OF BEGINNING OF VARIABLE AREA + MOVEM A,CLOC ;STORE AS NEW CURRENT LOCATION + PUSHJ P,EBLK + CALL SLOCF + CLEARM VARCNT ;INITIALIZE COUNT OF VARIABLES IN NEXT AREA + AOS VARPNT ;INCREMENT POINTER TO POINT TO NEXT AREA + POPJ P, + +;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN + +AVAR3: CAIN LINK,UDEFGV_-14. ;GLOBAL? + TLO SYM,40000 ;GLOBAL + PUSHJ P,LKPNRO + MOVSI T,DEFLVR + CAIN LINK,UDEFGV_-14. + MOVSI T,DEFGVR + TRNE FF,FRGLOL + JRST AVAR3A ;LOCATION GLOBAL + MOVEI B,-1(B) + ADD B,VCLOC + ADD B,OFLOC + MOVE TT,CRLOC + ADD TT,OFRLOC + SKIPE TT + TLO C,3RLR + CAIE LINK,UDEFGV_-14. + TLZN C,3VCNT + SKIPA + PUSHJ P,CONBUG +AVAR4B: PUSHJ P,VSM2 + JUMPGE FF,AVAR2A ;IF PUNCHING PASS, OUTPUT DEFINITION. + PUSHJ P,OUTDE2 + JRST AVAR2A + +AVAR4: TLNE C,3VAS2 ;DEFINED VARIABLE FOUND DURING SYMTAB SCAN + TLOE C,3VP + JRST AVAR2A + MOVSI T,(LINK) ;CAUSE AVAR4B TO REDEFINE AS SAME TYPE. + LSH T,14. + TRNN FF,FRGLOL + JRST AVAR4A +AVAR3A: PUSHJ P,VSM2LV + JUMPGE FF,AVAR2A + PUSHJ P,PDEFPT + MOVEI A,0 + PUSHJ P,PBITS + PUSHJ P,$OUTPT + AOS CLOC + JRST AVAR2A + +AVAR4A: CAIN LINK,DEFGVR_-14. ;DEF VAR, 3VAS2, POINT NOT GLOBAL. + JRST AVAR4B ;VAR GLOBAL, MUST PUNCH DEF SINCE DIDN'T ON PASS1. + 3PUT C,D ;LOCAL, JUST SET 3VP SO DON'T SEE IT NEXT VARIAB. + JRST AVAR2A ;NO NEED TO PUNCH DEF SINCE WAS DEF ON PASS1. + +;;MAIN ;"MAIN" MIDAS ROUTINES: INIT, PS1, PLOD, PS2, PSYMS + ;ALL CALLED WITH JSP A,; ALL GLOBAL + ;RETURN INSTRUCTION FROM JSP IN LOCATION RETURN +PS1: HRRM A,RETURN ;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN + PUSH P,[ASSEM1-1] ;SIMBLK WILL POPJ1. +IFN A1PSW,[SKIPL PRGC + JRST A1PAS1 ;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS +] + TRO FF,FRNPSS +IFN ITSSW,JRST SIMBLK ;SELECT SBLK AND ASSEMBLE +IFN DECSW\TNXSW,JRST A.DECRE ;SELECT .DECREL AND ASSEMBLE. + +PS2: HRRM A,RETURN ;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN + JUMPL FF,PA2A ;JUMP IF PASS 1 ENDED IN 1PASS MODE + TDO FF,[FLPPSS,,FRPSS2] ;SET PUNCHING PASS AND PASS 2 FLAGS + PUSHJ P,P2INI ;INITIALIZE + JRST ASSEM1 ;START ASSEMBLING + +PA2A: MOVE A,SYMAOB ;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS +PA2C: MOVE SYM,ST(A) ;GET SQUOZE THIS SYMTAB ENTRY + LDB B,[400400,,SYM] ;GET FLAGS + CAIE B,LCUDF_-14. ;LOCAL UNDEFINED? + JRST PA2B ;NOT LOCAL UNDEFINED, DON'T COMPLAIN + 3GET C,A ;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY + TLZ SYM,740000 ;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT + TLNN C,3LLV ;PROBLEM HANDED TO LINKING LOADER? + ETSM [ASCIZ /Undefined/] ;NO +PA2B: ADD A,WPSTE1 ;NOW GO FOR NEXT ST ENTRY + AOBJN A,PA2C + JRST RETURN + +$INIT: HRRM A,RETURN ;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT +IFN CREFSW,PUSHJ P,CRFOFF ;DON'T CREF ON 1ST PASS. +IFN LISTSW,CALL LSTOFF ;DON'T LIST ON 1ST PASS. + SKIPGE ISYMF + JRST INIT1 ;SPREAD SYMS (RETURNS TO SP4) + MOVE A,SYMAOB ;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS +INIT4: SKIPN B,ST(A) + JRST INIT2 + 3GET C,A + TRNE C,-1 ;INITIAL SYM? + CLEARM ST(A) ;NO +INIT2: ADD A,WPSTE1 + AOBJN A,INIT4 + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1] + BLT A,EBKCOD ;CLEAR OUT BLANK CODE + +SP4: PUSH P,CRETN +P1INI: CLEARB I, LDCCC + INSIRP SETZM,BKBUF ISYMF A.PASS +IFN FASLP,[ + INSIRP SETZM,FASATP FASPCH + CLEARM FASIDX +] + MOVEMM DECTWO,[[MOVE]] + TDZ FF,[FFINIT] ;INITIALIZE MOST FF FLAGS + MOVEIM A.PPASS,2 ;DEFAULT IS 2-PASS. + PUSHJ P,MACINI ;INITIALIZE MACRO STATUS + MOVEI A,PCNTB + MOVEM A,PBCONL + MOVS A,[BKTAB,,P1INI1] + BLT A,BKTAB+4 + MOVEIM BKTABP,BKWPB*2 + +;DROPS IN. +P2INI: INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKPDL +SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK,DEFNPS,BYTM,BYTM1,HKALL,QMTCH] + AOS B,A.PASS +IFN ITSSW,[ + CALL SETWH2 ;SET UP .WHO2, PREPARE .WHO3 IN A WITH PAGENUM=1. + .SUSET [.SWHO3,,A] ;'P1 ',,PAGENUM OR 'P2 ',,PAGENUM + .SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]] +] + TDZ FF,[FLUNRD,,FRGLOL] +IRP X,,[BKWPB,BKCUR,,BKPDL+1,1,BKLVL,IRDEF,ASMI +NCONS,CONCNT,VARTAB,VARPNT,NVARS,VARCNR,1,VECSIZ] +IFE 1&.IRPCN,IFSN [X], MOVEI A,X +IFN 1&.IRPCN, MOVEM A,X +TERMIN + MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + CLEARM VARCNT + CLEARM PBITS2 + MOVE A,[440300,,PBITS1] + MOVEM A,BITP + MOVEI A,PBITS4 + HRRZM A,PBITS4 + CLEARB I,PBITS1 + MOVEI A,PCNTB + MOVEM A,PBCON + MOVE A,[(LCUDF)++1] ;< AND > FOR COMPATIBILITY WITH OLD + MOVEM A,PCNTB + MOVEM A,CSQZ + MOVEI A,8 + MOVEM A,ARADIX + +IFN ITSSW,[ + MOVEI A,100 + MOVEM A,CLOC +] +.ELSE [ + SETZ A, ; SET LOC COUNTERS APPROPRIATELY + SKIPGE B,CONTRL + TRNE B,DECREL+FASL + JRST [SETZM CLOC ; ASSUME RELOCATABLE + AOS CRLOC ; CRLOC GETS 1 + JRST P2INI5] + TRNE B,DECSAV ; ASSUME ABSOLUTE + MOVEI A,140 + TRNE B,SBLKS + MOVEI A,100 ; IF SBLK FORMAT ASSUME FOR ITS. + MOVEM A,CLOC +P2INI5: +] + SETZM GLOCTP + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,CONTRL ;IN DEC FORMAT, OUTPUT PROGRAM NAME. + TRNE A,DECREL + CALL DECPGN ;CLOBBERS A +IFN FASLP,[ + SETOM FASBLC ;LOSING BLOCK COUNT + MOVE A,CONTRL ;IN FASL FORMAT, OUTPUT FASL HEADER + TRNE A,FASL + CALL FASOIN ;INITIALIZE FASL OUTPUT +] + SETZM DECBRH + TRO FF,FRSYMS+FRFIRWD + MOVE A,[IFORTB,,FORTAB] ;INITIALIZE FORMAT TABLE ON EACH PASS + BLT A,FRTBE + MOVEIM GLSPAS,GLOTB ;INIT. ASSEM1 PDL LEVELS TO BOTTOM. + MOVEMM ASSEMP,[[-LPDL,,PDL]] + MOVEIM ASMDSP,ASSEM3 + SETZM ASMOUT + SETZM CONSTP + SETZM SCNDEP ;NOT IN CONDIT. OR CONSTANT. + SETZM CONDEP + HRRZM P,CONSML ;START OUT IN MULTI-LINE MODE. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + MOVEM A,PNTBP + CLEARM LISTPF + SETOM LISTBC + SKIPG LISTP1 ;IF LIST ON PASS 1 + JUMPGE FF,CRETN ;OR PUNCHING PASS, + SKIPE LISTP ;IF WANT LISTING, + CALL LSTON ;TURN ON OUTPUT OF LISTING. +] +IFN CREFSW,[ + JUMPGE FF,CRETN + SKIPE CREFP ;IF C SWITCH WAS SEEN, + PUSHJ P,CRFON ;TURN ON CREFFING, +] +CRETN: POPJ P,RETURN + +P1INI1: SQUOZE 0,.INIT ? 0 ? 3 + SQUOZE 0,.MAIN ? 1,, + +PLOD: HRRM A,RETURN ;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT + PUSHJ P,PLOD1 ;PUNCH LOADER + JRST RETURN ;RETURN + + ;PUNCH OUT THE LOADER + +PLOD1: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE + MOVE B,CONTRL + TRNE B,ARIM10 + JRST PLOD2 ;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN + TRNN B,SBLKS + POPJ P, ;NOT SBLK => DON'T PUNCH LOADER +PLOD1A: MOVSI B,SLOAD-SLOADP ;PUNCH SBLK LOADER IN RIM FORMAT + MOVSI C,(DATAI PTR,) +PLOAD1: MOVE A,C + PUSHJ P,PPBA + CAMN C,[DATAI PTR,13] + HRRI C,27 + MOVE A,SLOAD(B) + PUSHJ P,PPBA + AOS C + AOBJN B,PLOAD1 + MOVE A,[JRST 1] + PUSHJ P, PPBA + JRST FEED1 + +PLOD2: MOVSI C,LDR10-ELDR10 ;PUNCH SBLK LOADER FOR PDP10 READIN +PLOD3: MOVE A,LDR10(C) + PUSHJ P,PPBA + AOBJN C,PLOD3 + JRST FEED1 + + ;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT + +SLOAD: CONO PTR,60 ;0 RESTART POINT (NEW BLOCK) + JSP 14,30 ;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY + DATAI PTR,16 ;GET HEADER + MOVE 15,16 ;INITIALIZE CHECKSUM + JUMPGE 16,16 ;HEADER .GE. 0 => STARTING INSTRUCTION + JSP 14,30 ;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY + DATAI PTR,(16) ;READ IN DATA WORD + ROT 15,1 ;NOW UPDATE CHECKSUM + ADD 15,(16) + AOBJN 16,5 ;LOOP FOR ALL DATA WORDS THIS BLOCK + MOVEI 14,33 ;30 TO RETURN TO 33 + JRST 30 ;WAIT FOR READY THEN GO TO 33 + ;14 JSP AC FOR ROUTINE AT 30 + ;15 CHECKSUM + ;16 AOBJN POINTER (UPDATED HEADER) + CONSO PTR,10 ;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI + JRST 30 + JRST (14) + DATAI PTR,16 ;33 GET CHECKSUM + CAMN 15,16 ;COMPARE WITH CALCULATED + JUMPA 1 ;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED) + JRST 4, ;CHECKSUM ERROR +SLOADP==. + +;PDP10 SBLK LOADER +;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT + ;BY ASSEMBLER, COMPILER, OR WHATEVER +;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE +;USES ONLY THE AC'S (BUT ALL OF THEM) + +LDR10: + -17,,0 ;BLKI POINTER FOR READ SWITCH + +LDRC=0 ;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD + ;INTO IT DURING HARDWARE READIN, BUT WHO SAYS + ;YOUR PROGRAM CAN'T USE IT?) +OFFSET -.+1 ;BEGIN LOADING INTO 1 AS PER HEADER +LDRGO==. + CONO PTR,60 ;START UP PTR (RESTART POINT) +LDRRD==. + HRRI LDRB,.+2 ;INITIALIZE INDEX +LDRW==. + CONSO PTR,10 ;WAIT FOR WORD TO BE AVAILABLE + JRST .-1 + ROT LDRC,-LDRRD(LDRB) ;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE) + ;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM) + ;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM) + DATAI PTR,@LDRT1-LDRRD(LDRB) ;READ WORD INTO RIGHT PLACE + ;HEADER => READ INTO C + ;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A + ;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C) + XCT LDRT1-LDRRD(LDRB) ;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS) + XCT LDRT2-LDRRD(LDRB) ;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS) +LDRB==. + SOJA ., ;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION + ;USED AS INDEX INTO TABLES, ETC. + + ;TABLE 1 + ;INDIRECTED THROUGH FOR DATAI + ;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD + ;ENTRIES EXECUTED IN REVERSE ORDER + +LDRT1==. + CAME LDRC,LDRA ;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE + ADD LDRC,(LDRA) ;UPDATE CHECKSUM + SKIPL LDRA,LDRC ;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK + + ;TABLE 2 + ;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED + +LDRT2==. + JRST 4,LDRGO ;CHECKSUM ERROR + AOBJN LDRA,LDRW ;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED +LDRA==. + JRST LDRRD ;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER + ;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK + +OFFSET 0 +ELDR10==. + +;FLAGS IN SQUOZE OF SYMS TO OUTPUT + +ABSGLO==040000 ;SYM IS GLOBAL (IF RELOCA, SAYS THIS IS BLOCK NAME) +ABSLCL==100000 ;LOCAL +ABSDLI==200000 ;DELETE INPUT (DON'T RECOGNIZE IT IF TYPED IN) +ABSDLO==400000 ;DELETE OUTPUT (DON'T TYPE IT OUT) + +PSYMS: HRRM A,RETURN ;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT + PUSH P,PSYMS ;AT END, POPJ TO RETURN. + TRNE FF,FRSYMS + JRST SYMDMP ;PUNCH SYMS IF NEC. + SKIPL A,CONTRL + JRST SYMDA ;IF RELOCA, PUNCH PROGRAM NAME. + TRNE A,DECSAV ;IF DEC SAVE FORMAT WITHOUT SYMBOLS + JRST SYMDSA ;STILL DUMP START ADDRESS + TRNN A,DECREL + POPJ P, + +PSYMSD: MOVSI A,DECEND + PUSHJ P,DECBLK ;START AN END-BLOCK. + MOVE A,DECTWO ;IN 2-SEG PROGRAMS, + CAME A,[MOVE] + JRST [ CAMG A,DECBRH ;OUTPUT HISEG BREAK + MOVE A,DECBRH + MOVEM A,WRD + MOVEIM WRDRLC,1 + CALL PWRD + MOVEMM WRD,DECBRK + CALL PWRD ;FOLLOWED BY LOSEG BREAK + JRST EBLK] + MOVEMM WRD,DECBRK ;OUTPUT THE PROGRAM BREAK. + MOVEIM WRDRLC,1 + PUSHJ P,PWRD + MOVE A,DECBRA ;OUTPUT HIGHEST ABS. ADDR + CAIG A,140 + SETZ A, ;IF IT'S ABOVE THE JOBDAT AREA. + PUSHJ P,DECWRD + JRST EBLK + +SYMDA: MOVEI A,LPRGN ;NOW PUNCH PROGRAM NAME + DPB A,[310700,,BKBUF] + MOVE A,PRGNM + TLO A,40000 + PUSHJ P,$OUTPT + PUSHJ P,EBLK + TLZ FF,$FLOUT + POPJ P, + + ;DUMP OUT THE SYMBOL TABLE + +SYMDMP: TRZ I,IRCONT ;OK TO END BLOCK + CLEARM GLSP1 + CLEARM GLSP2 + CLEARM WRDRLC + MOVE T,CONTRL + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + CLEARM CLOC + CLEARM BKBUF +IFN FASLP,[ + TRNE T,FASL + JRST SYMDM1 +] +IFN ITSSW,[ + TRNE T,SBLKS ; ON ITS, IF OUTPUTTING IN SBLK FMT + CALL SYMDDB ; THEN OUTPUT A DEBUGGING INFO BLOCK. +] + TRNE T,DECREL + JRST SYMDMD + JUMPL T,SSYMD ;JUMP IF NOT STINK + + MOVEI B,LDDSYM ;LOCAL SYMS BLOCK TYPE + DPB B,[310700,,BKBUF] ;SET BLOCK TYPE + MOVEM B,CDATBC + MOVE B,SYMAOB ;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB. + JRST SSYMDR + +SYMDMD: MOVSI A,DECSYM ;IN DEC FMT, START SYMBOLS BLOCK. + PUSHJ P,DECBLK +SYMDM1: MOVE B,SYMAOB + JRST SSYMDR + +IFN ITSSW,[ + + ; OUTPUT DEBUGGING INFO BLOCK (ITS SBLK ONLY) + +SYMDDB: MOVE A,[-7,,3] ;OUTPUT A "DEBUGGING INFORMATION" BLOCK + MOVE B,A ;UPDATING THE CHECKSUM IN B. + PUSHJ P,PPB + MOVE A,[-6,,1] ;THE BLOCK CONTAINS ONE SUBBLOCK - A "MIDAS INFO" SUBBLOCK. + PUSHJ P,PPBCK + .SUSET [.RXUNAME,,A] ;CONTAINING NAME OF USER, DATE IN DISK FORMAT, + PUSHJ P,PPBCK + SYSCAL RQDATE,[%CLOUT,,A] + .LOSE %LSSYS + PUSHJ P,PPBCK ;AND THE SOURCE FILE NAMES (DEV, FN1, FN2, SNAME). +REPEAT 4,[ + MOVE A,INFB+$F6DEV+.RPCNT + PUSHJ P,PPBCK +] + MOVE A,B + PJRST PPB ; PUNCH OUT CHECKSUM & RETURN +] ;IFN ITSSW + +IFN TNXSW,[ +SYMDDB: HRROI 1,FILNAM + HRRZ 2,INFB+$FJFN + MOVE 3,[111110,,JS%PAF] + JFNS + MOVEI A,1 + MOVE B,FILNAM-1(A) + TRNE B,376 ;Last byte empty? + AOJA A,.-2 ; No, so try next. + MOVEM A,FNAMLN ;# of words in filename. + MOVNI A,7 + SUB A,UNAMLN + SUB A,FNAMLN + MOVSS A ;-total # words in outer block,,0 + HRRI A,3 ;3 means a "debugging information block" + PUSH P,A + MOVE B,A + PUSHJ P,PPB + POP P,A + SUB A,[-1,,2] ;one less word in block, 3-2=1, "midas info" + PUSHJ P,PPBCK + MOVEI A,6 ;5 header words (including this one) + PUSHJ P,PPBCK + MOVE A,[.OSMIDAS] ;Machine type this was assembled on. + PUSHJ P,PPBCK + MOVE A,[SIXBIT "MIDAS"] ;Sixbit name of program creating this file + PUSHJ P,PPBCK + GTAD ;Current date and time + MOVE A,1 + PUSHJ P,PPBCK + MOVEI A,6 ;Offset to start of username string + PUSHJ P,PPBCK + ADD A,UNAMLN + PUSHJ P,PPBCK ;Offset to start of filename string + MOVS C,UNAMLN + MOVNS C + MOVE A,USRNAM(C) + PUSHJ P,PPBCK + AOBJN C,.-2 + MOVS C,FNAMLN + MOVNS C + MOVE A,FILNAM(C) + PUSHJ P,PPBCK + AOBJN C,.-2 + MOVE A,B + PJRST PPB ;Punch out checksum and return +];IFN TNXSW + +;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE): + ;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST + ;A TEMP + ;B SQUOZE + ;D OUTPUT INDEX INTO SYMTAB + ;CH1 VALUE OF SYM + ;CH2 3RDWRD + +SSYMD: MOVEI D,ST-1 + SETZB C,SMSRTF ;SYMS SORTED => INITIAL SYMS CLOBBERED + MOVE AA,SYMAOB +SSYMD1: SKIPE B,ST(AA) ;GET SYM NAME FROM TABLE + TDNN B,[37777,,-1] ;MAKE SURE NOT EXPUNGED + JRST SSYMDL ;NOT (REALLY) THERE, TRY NEXT + AOS SMSRTF + MOVE CH1,ST+1(AA) ;GET VALUE OF SYM + 3GET CH2,AA ;GET 3RDWRD + TRNE CH2,-1 + TLNE CH2,3KILL+3LLV + JRST SSYMDL ;DON'T PUNCH INITIAL OR KILLED SYMS. + MOVEI A,0 ;INITIALIZE FOR SHIFTING IN FLAGS + LSHC A,4 ;SHIFT FLAGS INTO A + XCT SSYMDT(A) ;DO THE APPROPRIATE THING THIS KIND OF SYMTAB ENTRY + JRST SSYMDL +SSYMD2: LSH B,-4 ;SHIFT SQUOZE BACK TO WHERE IT BELONGS + TLO B,ABSLCL ;SET LOCAL BIT + TLNE CH2,3SKILL + TLO B,ABSDLO ;HALF-KILL SYM + CAIL A,DEFGVR_-16 + TLC B,ABSGLO\ABSLCL ;FOR GLOBAL SYM, SET GLOBAL BIT INSTEAD OF LOCAL BIT, + CAIGE A,DEFGVR_-16 ;AND PUT IT IN THE GLOBAL BLOCK IN THE SYMTAB. + SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PROGRAM, PUT ALL SYMS IN GLOBAL BLOCK. + HRRI CH2,0 + PUSH D,B ;STORE NAME OF SYM IN OUTPUT SLOT + PUSH D,CH1 ;STORE VALUE + PUSH D,CH2 ;STORE 3RDWRD +SSYMDL: ADD AA,WPSTE1 + AOBJN AA,SSYMD1 ;LOOP FOR ALL SYMS IN TABLE + MOVSI CH2,4^5 ;1ST BIT TO SORT ON IS TOP BIT, + MOVEI A,ST ;SORT FROM BOTTOM OF SYMTAB + MOVEI B,1(D) ;TO WHERE WE FILLED UP TO. + MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST. + MOVE C,[TDNN CH2,1(B)] + JSP AA,SSYMD9 + TLC C,(TDNE#TDNN) ;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST. + TLC CH1,(TDNE#TDNN) + MOVEI AA,SSRTX ;NEED ONLY CHANGE C, CH1 THE FIRST TIME. + JRST SSRTX + +SSYMD9: PUSHJ P,SSRTX ;SORT SYMS ARITHMETICALLY BY VALUE. + MOVNI B,(B) + ADDI B,ST ;SIZE OF AREA OF SYMTAB STILL IN USE. + IDIV B,WPSTE + HRLZI B,(B) ;-<# SYMTAB ENTRIES>,, + MOVE T,CONTRL ; GET CONTRL FOR OUTPUT FMT CHECKS + MOVE A,[SQUOZE 0,GLOBAL] + MOVEM A,BKTAB ;CALL THE .INIT BLOCK "GLOBAL" WHICH IS WHAT DDT WANTS AS TOP BLOCK. + MOVE C,BKTABP + IDIVI C,BKWPB ;# BLOCKS (INCL. GLOBAL BLOCK). + CAIN C,2 ;IF ONLY GLOBAL AND MAIN, TELL BKSRT TO IGNORE MAIN. + SETZM PRGNM+1 + CAIN C,2 + MOVEI C,1 ;IF ONLY GLOBAL AND MAIN, FILE WILL HAVE ONLY 1 BLOCK (GLOBAL). + CAILE C,1 ;IF MORE THAN ONE BLOCK IN FILE, + TRNN T,DECSAV ;AND OUTPUT FORMAT IS DECSAV, + CAIA + ADDI C,1 ;THEN ALLOW FOR ONE MORE "BLOCK" (PGM NAME). + ;NOTE THAT DECSAV FMT REPLACES BLOCKNAME WITH PGM-NAME + ;FOR SINGLE-BLOCK CASE, SO COUNT OF 1 WORKS OK. + MOVSI A,(C) ; <# BLOCKS TO OUTPUT>,, + SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,, + LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,, + TRNE T,DECSAV ; IF OUTPUT FORMAT IS DEC SAV, + JRST [ HRR A,DECSYA ; GET LOC TO STORE SYMS AT + MOVE C,A + MOVE A,[-1,,116-1] ; STORE IT AT .JBSYM + CALL PPB + MOVE A,C + CALL PPB + HRRI A,-1(A) ; SET -<# WDS IN SYMTAB>,, + JRST .+1] + MOVEM A,SCKSUM ;SAVE 1ST WD FOR CHECKSUM (DECSAV IGNORES IT) + PUSHJ P,PPB + PUSHJ P,BKCNT ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY. + +;DROPS THROUGH. + +;DROPS IN IF ABS, JUMPS HERE IF RELOC. +;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND +;SHOULD NOT BE CLOBBERED. +SSYMDR: PUSH P,B ;-<# SYMS>,,0 ;IT WILL BE -1(P) + PUSHJ P,BKSRT ;SORT BLOCKS INTO BKTAB1 + MOVE A,BKTAB + CAME A,[SQUOZE 0,GLOBAL] ;IF ABS, WE RENAMED .INIT TO GLOBAL, SO LEAVE IT IN BKTAB1 + SOS D ;ELSE FLUSH .INIT FROM THE END OF BKTAB1. + SETOM 1(D) ;PUT A -1 AT END OF BKTAB1. + MOVE B,SCKSUM ;GET CHKSUM AFTER 1ST WD. (PPBCK WILL UPDATE) + PUSH P,[-1] ;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT. +SSYMD3: AOS F,(P) ;F HAS BKTAB1 IDX OF BLOCK. + SKIPGE C,BKTAB1(F) ;BKTAB1 ELT HAS BKTAB IDX OR + JRST SSYMDX ; -1 AFTER LAST BLOCK. + SKIPL LINK,CONTRL + JRST SSYMD7 ;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA. + TRNE LINK,DECREL+FASL+DECSAV + JRST SSYMD6 ; ALL THESE SKIP OVER SBLK-TYPE BLOCKNAME OUTPUT + MOVE A,BKTAB(C) + PUSHJ P,PPBCK ;OUTPUT BLOCK NAME WITH NO FLAG BITS SET. + HLRZ A,BKTAB+1(C) + SKIPE A + ADDI A,1 ;A GETS 0 FOR GLOBAL BLOCK, ELSE DDT LEVEL (= 1 + MIDAS LEVEL). + HRL A,BKTAB+2(C) ;PUT IN -2* + ADD A,[-2,,] +SSYMG2: PUSHJ P,PPBCK ;OUTPUT -SIZE,,LEVEL WORD OF BLOCK NAME ENTRY. + JRST SSYMD6 + +SSYMD7: MOVE A,BKTAB(C) ;OUTPUT BLOCK NAME IN RELOCATABLE. + TLO A,ABSGLO ;TELL STINK IT'S BLOCK NAME. + PUSHJ P,$OUTPT + HLRZ A,BKTAB+1(C) + SUBI A,1 + PUSHJ P,$OUTPT +SSYMD6: SKIPL C,-1(P) ;AOBJN PTR TO SYMS. + JRST SSYMD8 ;IN CASE NO SYMS. +SSYMD4: HRRZ A,ST+2(C) ;OUPUT ONLY THE SYMS IN THE BLOCK + CAME A,BKTAB1(F) ;NOW BEING HANDLED. + JRST SSYMD5 + SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SYMD2 ;SPECIAL IF RELOCA. + MOVE A,ST(C) + TRNE LINK,DECSAV + CALL RSQZA ; RIGHT-JUSTIFY THE SQUOZE (SIGH) + PUSHJ P,PPBCK ;1ST, SQUOZE WITH FLAGS. + MOVE A,ST+1(C) + PUSHJ P,PPBCK ;2ND, VALUE. +SSYMD5: ADD C,WPSTE1 + AOBJN C,SSYMD4 ;HANDLE NEXT SYM. +SSYMD8: TRNN LINK,DECSAV + JRST SSYMD3 ;ALL SYMS FOR THIS BLOCK DONE, DO NEXT BLOCK. + + ; DECSAV FMT HAS BLOCK NAMES OUTPUT LAST. + SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PGM, + JRST SSYMD3 ; FORGET IT; PGM-NAME SUBSTITUTES FOR BLKNAME. + MOVE C,BKTAB1(F) ; GET IDX FOR BLOCK + MOVE A,BKTAB(C) ; GET BLOCKNAME WITH FLAGS CLEAR + TLO A,140000 ; SET FLAGS TO SAY SYM IS BLOCKNAME + CALL RSQZA ; RIGHT-JUSTIFY SQUOZE FOR DEC (UGH BLETCH) + CALL PPB + HLRZ A,BKTAB+1(C) ; GET LEVEL OF BLOCK (NO WD COUNTS) + CALL PPB + JRST SSYMD3 + + ; RIGHT-JUSTIFY SQUOZE IN A, PRESERVING FLAGS. + ; (WHICH ASQOZR RTN DOESN'T) + ; CLOBBERS B. +RSQZA: PUSH P,A ; SAVE FLAGS + TLZA A,740000 ; ZAP +RSQZA2: DPB A,[004000,,(P)] ; UPDATE + IDIVI A,50 + JUMPE B,RSQZA2 + POP P,A + POPJ P, + +;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY) +;NORMALLY OUTPUT SQUOZE W/ FLAGS ? VALUE, +;IF 3LLV SET OUTPUT PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP. +SYMD2: LDB A,[400400,,ST(C)] + MOVE CH1,ST+1(C) ;SSYMDT MAY CHANGE CH1. + MOVE CH2,ST+2(C) + XCT SSYMDT(A) ;SKIPS IF SHOULD OUTPUT SYM. + JRST SSYMD5 + TLNE CH2,3KILL + JRST SSYMD5 + MOVE B,ST(C) + TLZ B,740000 + JUMPE B,SSYMD5 ;UNUSED ENTRY. + JUMPL LINK,SYMDEC ;J IF DEC OR FASL FMT + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LEFT HALF + TLNE CH2,3RLR + TLO B,100000 ;RELOCATE RIGHT HALF + TLNE CH2,3SKILL + TLO B,400000 ;HALF-KILL + MOVEI A,ST(C) + TLNE CH2,3LLV ;IF STINK HAS VALUE, + PUSHJ P,$OUTPT ;GIVE STINK NAME STINK KNOWS SYMBOL BY. + TLNE CH2,3LLV ;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET + TLO B,ABSLCL ;(STINK WILL DO SO OTHERWISE) + MOVE A,B + PUSHJ P,$OUTPT ;OUTPUT SYM + MOVE A,CH1 + TLNN CH2,3LLV ;DON'T OUTPUT VALUE IF DON'T KNOW IT. + PUSHJ P,$OUTPT ;OUTPUT VALUE + JRST SSYMD5 + +SYMDEC: IFN FASLP,[ + TRNE LINK,FASL + JRST SYMFSL ;FASL ASSMBLY +] + PUSHJ P,ASQOZR ;RIGHT-JUSTIFY THE SQUOZE, + TLNE CH2,3SKILL + TLO B,ABSDLO ;MAYBE HALFKILL, + TLO B,ABSGLO + LDB A,[400400,,ST(C)] + CAIGE A,DEFGVR_-14. + TLC B,ABSGLO+ABSLCL ;LOCAL SYM, CHANGE GLO TO LCL. + MOVEM B,WRD + PUSH P,C + PUSHJ P,DECPW ;FIRST, THE NAME, + POP P,C + LDB TM,[420200,,ST+2(C)] + MOVE A,ST+1(C) ;THEN THE VALUE AND RELOCATION BITS. + PUSHJ P,DECWR1 + JRST SSYMD5 + +IFN FASLP,[ +SYMFSL: TLO B,400000 ;GET VALUE FROM SECOND WD + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LH + TLNE CH2,3RLR + TLO B,100000 + CAIL A,LGBLCB_<-18.+4> + TLO B,40000 ;GLOBAL FLAG + MOVE A,B + MOVEI B,15 ;PUTDDTSYM + PUSHJ P,FASO + MOVE A,CH1 + PUSHJ P,FASO1 + JRST SSYMD5 +] + +;XCT INDEXED ON SQUOZE FLAGS; SHOULDN'T PUNCH SYM IF DOESN'T SKIP. +SSYMDT: JFCL ;COM + JFCL ;PSEUDO OR MACRO + CAIA ;SYM, PUNCH OUT + TLNN CH2,3LLV ;LOCAL UNDEFINED, OUTPUT IF STINK HAS VALUE TO TELL STINK WHERE TO PUT IT. + TLZA CH1,-1 ;DEFINED LOCAL VARIABLE, CLEAR OUT LH(VALUE) + JFCL ;UNDEFINED LOCAL VARIABLE + SKIPL CONTRL ;DEFINED GLOBAL VARIABLE, PUNCH OUT IF ABS. + JFCL ;UNDEFINED GLOBAL VARIABLE + SKIPL CONTRL ;GLOBAL ENTRY, PUNCH OUT IF ABS ASSEM. + JFCL ;GLOBAL EXIT, DON'T PUNCH OUT +IFN .-SSYMDT-NCDBTS,.ERR SSYMDT LOSES. + +SSYMDX: SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SSYMG3 + TRNE LINK,DECSAV ; IN DECSAV FORMAT, + JRST [ MOVE A,PRGNM ; PGM NAME IS LAST THING IN SYMTAB + CALL RSQZA + CALL PPB ; WITH FUNNY VALUE OF + SETZ A, ; -<# SYMTAB WDS USED BY PGM>,, + CALL PPB ; BUT LAST PGM IN SYMTAB MUST HAVE LH=0, SO... + JRST SSYMG3] + MOVE A,B ; SBLK OR RIM ASSEMBLY, OUTPUT CHKSUM. + PUSHJ P,PPB +SSYMG3: SUB P,[2,,2] + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK + SKIPL A,CONTRL ;RELOCATABLE => OUTPUT PROG NAME. + JRST SYMDA +IFN FASLP,[ + TRNE A,FASL + POPJ P, +] + TRNE A,DECREL ;DEC FMT => OUTPUT END BLOCK. + JRST PSYMSD +SYMDSA: MOVE A,STARTA ;NOW GET STARTING INSTRUCTION + CALL PPB ;PUNCH IT OUT +IFN TNXSW,[ + ; At moment, add assembly-info block feature ONLY if we are running + ; on a TNX. This isn't quite the right thing to do, but helps to + ; ensure that the additional info doesn't break TOPS-10 systems until + ; we verify that it will work OK for them. + SETZ A, ;0 word after start instruction + CALL PPB + CALL SYMDDB ;then the assembly info block + MOVE A,STARTA +] ;IFN TNXSW + JRST PPB ;then another copy of the start and return + +;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR +;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT) +;THE .INIT BLOCK (MAYBE BY NOW RENAMED "GLOBAL") GOES IN LAST. D POINTS AT WHERE IT WAS PUT. +; NOTE THAT FOR DECSAV FORMAT THE ORDERING IS REVERSED; A BLOCK'S SUBBLOCKS +; FOLLOW IT, AND THE .INIT BLOCK GOES IN FIRST. + +BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1. + MOVSI A,1 ;START WITH BLOCK 0 (OUTERMOST, .INIT). + MOVE LINK,CONTRL + + ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS. +BKSR1: TRNE LINK,DECSAV + JRST [ MOVEI C,(A) ? PUSH D,C ? JRST .+1] + SETZ C, +BKSR2: CAME A,BKTAB+1(C) + JRST BKSR3 ;THIS BLOCK ISN'T A SUBBLOCK. + ADD A,[1,,] ;LH HAS SUBBLOCK'S LEVEL. + HRRI A,(C) ;RH HAS SUBBLOCK. + PUSHJ P,BKSR1 ;HANDLE THE SUBBLOCK + MOVE A,BKTAB+1(C) ; RESTORE A (C IS PRESERVED OVER CALL) +BKSR3: ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKSR2 + MOVEI C,(A) ; RESTORE C INDEX BKSR1 WAS ENTERED WITH + TRNE LINK,DECSAV + POPJ P, + PUSH D,C ;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS) + POPJ P, + +PPBCK: ROT B,1 ;OUTPUT WD IN A, UPDATING CKSUM IN B. + ADD B,A + JRST PPB + +;THE THIRD WORD OF EACH BLOCK'S ENTRY IN BKTAB GETS THE NUMBER OF +;SYMBOLS IN THAT BLOCK (OF THE SYMBOLS THAT WE WILL PUT IN THE SYMTAB). + +BKCNT: PUSH P,B + MOVEI C,0 +BKCNT0: SETZM BKTAB+2(C) ;ZERO 3RD WD OF EACH BKTAB ENTRY. + ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKCNT0 +BKCNT1: MOVE C,ST+2(B) + SOS BKTAB+2(C) ;ADD -2 FOR EACH SYM IN THE BLOCK. + SOS BKTAB+2(C) + ADD B,WPSTE1 + AOBJN B,BKCNT1 +POPBJ: POP P,B + POPJ P, + +SSRTX: HRLM B,(P) ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END. + CAIL A,@WPSTEB ;ONLY 1 ENTRY, NOTHING TO DO. + JRST SSRTX7 + PUSH P,A ;SAVE START. +SSRTX3: XCT CH1 + JRST SSRTX4 ;MOVE UP TO 1ST WITH BIT ON. + SUB B,WPSTE + XCT C ;MOVE DOWN TO LAST WITH BIT OFF. + JRST SSRTX5 + MOVE D,WPSTE + CAIE D,MAXWPS + JRST .+4 +REPEAT MAXWPS,[ + MOVE D,.RPCNT(A) ;EXCHANGE THEM, + EXCH D,.RPCNT(B) + MOVEM D,.RPCNT(A)] +SSRTX4: ADD A,WPSTE +SSRTX5: CAME A,B ;ALL DONE => DO NEXT BIT. + JRST SSRTX3 ;MORE IN THIS PASS. + ROT CH2,-1 ;NEXT BIT DOWN. + POP P,A ;A -> START, B -> END OF 1ST HALF. + JUMPL CH2,SSRTX6 ;ALL BITS IN WD DONE, STOP. + PUSHJ P,(AA) ;DO NEXT BIT ON 1ST HALF. + HLRZ B,(P) ;A -> END OF 1ST HALF, B -> END OF ALL. + PUSHJ P,(AA) ;DO SECOND HALF. +SSRTX6: ROT CH2,1 ;LEAVE CH2 AS FOUND IT. +SSRTX7: HLRZ A,(P) ;LEAVE A -> END OF AREA SORTED. + POPJ P, + +;ARITHMETIC CONDITIONALS (B HAS JUMP A,) + +COND: PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,AGETFD ;GET FIELD TO TEST VALUE OF +CONDPP: POP P,T ;RESTORE CONDITIONAL JUMP INSTRUCTION + HRRI T,COND2 ;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE + XCT T ;JUMP IF COND T,ASSEMBLE STRING +COND4: SETZM A.SUCC ;MOST RECENT CONDIT. FAILED. +COND5: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WHAT PSEUDO WE'RE IN. + CALL RCH + JSP D,RARL4 ;INIT FOR THE CONDITIONALIZED STUFF. + CAIA + CALL RARFLS ;READ AND IGNORE THE ARG. + JRST MACCR + +ANULL: TLO FF,FLUNRD + JRST COND5 + +;.ELSE, .ALSO - B'S LH WILL HAVE SKIPE OR SKIPN. +A.ELSE: HRRI B,A.SUCC + XCT B + JRST COND4 ;CONDITION FALSE. + JRST COND2 ;TRUE. + +;IF1, IF2 - B'S LH WILL HAVE TRNE FF, OR TRNN FF, +COND1: HRRI B,FRPSS2 + XCT B + JRST COND4 ;NO + ;CONDITION TRUE, ASSEMBLE STRING +COND2: SETOM A.SUCC ;LAST CONDITIONAL SUCCEEDED. +COND6: PUSHJ P,RCH ;GET NEXT CHAR + CAIE A,LBRKT + JRST [ CAIE A,LBRACE + TLO FF,FLUNRD + JRST MACCR] + SKIPN SCNDEP ;BRACKET TYPE CONDITIONAL. + SKIPE CONDEP + JRST COND7 + MOVEMM CONDLN,CLNN ;AT TOP LEVEL, SAVE IN CASE THIS UNTERMINATED + MOVEMM CONDPN,CPGN +IFN TS, MOVEMM CONDFI,INFFN1 +COND7: AOS SCNDEP ;COUNT IT FOR RBRAK'S SAKE. + JRST MACCR + +;IFB, IFNB + +SBCND: PUSH P,B ;SAVE TEST JUMP + SETZB B,C ;C COUNTS SQUOZE CHARS FOR IFB/IFNB + ;B COUNTS NONSQUOZE FOR IFSQ/IFNSQ + JSP D,RARG ;INIT FOR READING OF ARG WHOSE BLANKNESS + JRST CONDPP ;IS TO BE TESTED. + JSP D,RARGCH(T) ;READ 1 CHAR, + JRST CONDPP ;(NO MORE CHARS) + HLRZ A,GDTAB(A) ;GET GDTAB ENTRY + CAIE A,(POPJ P,) ;POPJ => NOT SQUOZE + AOJA C,RARGCH(T) + AOJA B,RARGCH(T) + + ;IFDEF, IFNDEF + +DEFCND: PUSH P,SYM + PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + PUSHJ P,ES + MOVEI A,0 ;UNDEFINED +IFN CREFSW,XCT CRFINU + CAIN A,GLOEXT_-14. ;GLOBAL EXIT... + SKIPL CONTRL ;DURING ABSOLUTE ASSEMBLY? + CAIN A,3 ;NO, LOCAL UNDEF? + MOVEI A,0 ;ONE OF THESE => UNDEF + REST SYM + EXCH SYM,(P) ;POP SYM OUT FROM UNDER THE CONDITIONAL JUMP. + JRST CONDPP + +;;PWRD ;ROUTINES TO OUTPUT ASSEMBLES WORDS AND PORTIONS THEREOF + + ;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS + +PBITS3: PUSH P,A + MOVEI A,14 + MOVEM A,PBITS2 ;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS + MOVE A,[440300,,PBITS1] + MOVEM A,BITP ;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS + MOVE A,PBITS1 ;NOW GET ACCUMULATED WORD OF BITS + MOVEM A,@PBITS4 ;STORE IN BKBUF + AOS A,OPT1 ;RESERVE SPACE FOR NEW WORD + ;IF FRBIT7 SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES + ;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE + TRNN FF,FRBIT7 + SOSA A + TRO FF,FRINVT + HRRZM A,PBITS4 + POP P,A + CLEARM PBITS1 + ;DROPS THROUGH + ;OUTPUT RELOCATION CODE BITS IN A + +PBITS: SKIPGE CONTRL + POPJ P, ;NOT RELOCATABLE + SOSGE PBITS2 + JRST PBITS3 ;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN + CAIN A,7 + TROA FF,FRBIT7 + TRZ FF,FRBIT7 + IDPB A,BITP + POPJ P, + + ;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A + +OUTSM0: MOVE A,SYM ;OUTPUT NAME STINK KNOWS SYMBOL BY. + TLZ A,37777 ;FOR LOCALS, THAT'S THE STE ADDR, + HRRI A,ST(D) + TLNN SYM,40000 ;FOR GLOBALS, THAT'S THE SQUOZE. + JRST $OUTPT +OUTSM: SKIPA A,SYM +OUTWD: MOVE A,WRD +$OUTPT: SKIPGE CONTRL ;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY + POPJ P, ;DO NOTHING IF ABSOLUTE ASSEMBLY + PUSH P,AA + MOVE AA,OPT1 + TRZN FF,FRINVT ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS + AOS AA + MOVEM A,-1(AA) + MOVE A,CLOC + TRZE FF,FRFIRWD + HRRM A,BKBUF + POP P,AA + AOS A,OPT1 + CAIL A,BSIZE+BKBUF + TRNE I,IRCONT + POPJ P, + ;MAY DROP THROUGH + +;END CURRENT OUTPUT BLOCK + +EBLK: PUSH P,T + PUSH P,TT + PUSH P,A + PUSH P,B + MOVE T,CONTRL + JUMPGE T,EBLK3 ;JUMP IF RELOCATABLE ASSEMBLY + TRNE T,ARIM10\SBLKS + JRST ESBLK + TRNE T,DECSAV + JRST EDSBLK +IFN FASLP,[ + TRNE T,FASL + JRST FASLE ;FASL HAS NO BLOCKS TO END - IGNORE +] + TRNE T,DECREL + JRST DECEBL + JRST EBLK5 + +EBLK3: MOVE T,PBITS1 + MOVEM T,@PBITS4 + MOVEI T,PBITS4 + MOVEM T,PBITS4 + MOVE T,[440300,,PBITS1] + MOVEM T,BITP + CLEARB TT,PBITS2 + CLEARM PBITS1 + MOVEI T,BKBUF + MOVE B,OPT1 ;GET POINTER TO END OF BLOCK + SUBI B,BKBUF+1 ;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER) + DPB B,[220700,,BKBUF] ;SET COUNT FIELD IN HEADER + TRZN FF,FRLOC + JUMPLE B,EBLK5 ;IGNORE NULL BLOCK UNLESS FRLOC SET + TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) + PUSHJ P,FEED +EBK1: CAML T,OPT1 ;DONE WITH BLOCK? + JRST EBK2 ;YES + MOVE A,(T) ;NO, GET DATA WORD + JFCL 4,.+1 ;UPDATE CHECKSUM + ADD TT,A + JFCL 4,[AOJA TT,.+1] + PUSHJ P,PPB ;OUTPUT WORD + AOJA T,EBK1 +EBK2: SETCM A,TT ;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM + PUSHJ P,PPB ;OUTPUT CHECKSUM + MOVE T,CDATBC ;GET BLOCK TYPE + DPB T,[310700,,BKBUF] ;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE + MOVEI T,BKBUF+1 + MOVEM T,OPT1 +EBLK4: TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) +EBLK5: TRO FF,FRFIRWD +FASLE: POP P,B + POP P,A +PTT.TJ: POP P,TT + POP P,T + POPJ P, + +;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES + +PWRDA: TROA FF,FRNLIK ;SUPPRESS ADR LINKING +PWRD: TRZ FF,FRNLIK ;PERMIT ADR LINKING +IFN LISTSW,[ + SKIPN LSTONP + JRST PWRDL ;NOT MAKING LISTING NOW. + SKIPGE LISTPF + PUSHJ P,PNTR + SETOM LISTPF + MOVE LINK,WRD + MOVEM LINK,LISTWD + MOVE LINK,WRDRLC + MOVEM LINK,LSTRLC + MOVE LINK,CLOC + MOVEM LINK,LISTAD + MOVE LINK,CRLOC + DPB LINK,[220100,,LISTAD] +PWRDL: +] ;END IFN LISTSW, + JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS + SKIPGE LINK,CONTRL + JRST PWRD1 ;ABSOLUTE ASSEMBLY + ;RELOCATABLE ASSEMBLY + PUSHJ P,$RSET ;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD + MOVE A,GLSP2 + CAMN A,GLSP1 + JRST PWRD2 ;NO GLOBALS + + ;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK + + HRLZ B,WRD + HRR B,WRDRLC + JUMPN B,PWRD3 ;JUMP IF RH NON-ZERO + TRNN FF,FRNLIK + SKIPGE GLOCTP + JRST PWRD3 ;ADR LINKING SUPPRESSED OR CLOC GLOBAL + SKIPE LDCCC + JRST PWRD3 ;IN LOAD TIME CONDITIONALS + MOVNI T,1 ;INITIALIZE T FOR COUNTING +PWRD4: CAML A,GLSP1 + JRST PWRD5 ;DONE + HRRZ TT,1(A) ;GET GLOTB ENTRY + JUMPE TT,PWRD7A + LDB TT,[400400,,(TT)] ;GET SQUOZE FLAGS FROM SYM + CAIE TT,DEFGVR_-14. + CAIN TT,GLOETY_-14. + JRST PWRD3 ;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H) + HLRZ TT,1(A) + TRNE TT,1777+MINF + JRST PWRD3 ;NEGATED OR MULTIPLIED + TRNE TT,HFWDF + JRST PWRD7 + TRNE TT,ACF + TRNN TT,SWAPF + JRST PWRD3 ;NOT HIGH AC +PWRD7A: AOJA A,PWRD4 +PWRD7: TRNE TT,SWAPF + AOJA A,PWRD4 ;LEFT HALF + AOJN T,PWRD3 ;JUMP IF THIS NOT FIRST GLOBAL IN RIGHT HALF + MOVEI D,1(A) ;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY + AOJA A,PWRD4 + +PWRD5: AOJE T,PWRD3 ;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH + HRRZ T,(D) ;GET ADR OF SQUOZE + SKPST T, ;SKIP IF IN SYMBOL TABLE + JRST PWRD3 ;BELOW SYMBOL TABLE, DON'T ADDRESS LINK AFTER ALL + PUSH P,T ;HOORAY, WE CAN ADDRESS LINK + SETZM (D) ;CLEAR OUT GLOTB ENTRY, DON'T NEED IT ANY MORE + PUSHJ P,PWRD31 ;DUMP OUT THE OTHER GLOBALS + POP P,D ;GET ST ADR OF THIS AGAIN + 3GET1 A,D + LDB A,[.BP (3RLNK),A] + MOVE B,WRDRLC + TLNE B,1 + TRO A,2 ;RELOCATE LEFT HALF + PUSHJ P,PBITS ;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY + HLR A,1(D) ;GET ADR OF LAST + HLL A,WRD + PUSHJ P,$OUTPT ;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S + MOVE A,CLOC ;NOW UPDATE ST ENTRY + HRLM A,1(D) + 3GET1 B,D + SKIPN CRLOC + TLZA B,3RLNK ;CLOC NOT RELOCATED LAST TIME THIS SYM USED + TLO B,3RLNK ;RELOCATED + 3PUT1 B,D + POPJ P, + +PWRD31: MOVE T,GLSP2 ;DUMP ALL GLO S IN GENERAL FORMAT +PWRD3A: CAML T,GLSP1 + POPJ P, + MOVE B,1(T) + TRNN B,-1 + AOJA T,PWRD3A + TLNE B,1777 + JRST RPWRD ;REPEAT +RPWRD1: LDB A,[.BP (MINF),B] + TRO A,4 + PUSHJ P,PBITS + MOVE A,(B) ;CODEBITS +SQUOZE FOR SYM + HLRZ C,A + TLZ A,740000 + CAIL C,DEFGVR + TLOA A,40000 ;SYM IS GLO + JRST [ + MOVEI C,(B) ;IF WE ARE OUTPUTTING A REFERENCE TO THE + CAIL C,PCNTB ;"LABEL" AT THE BEGINNING OF A CONSTANTS AREA + CAIL C,PCNTB+NCONS*3 ;(BECAUSE THIS IS A 1PASS ASSEMBLY) USE THE + MOVEI A,(B) ;NAME, SINCE THE SYMBOL ISN'T IN THE + JRST .+1] ;SYMTAB + TLNE B,SWAPF + TLO A,400000 + TLNE B,ACF + JRST PWRD3E ;AC HIGH OR LOW + TLNN B,HFWDF + JRST PWRD3F ;ALL THROUGH + TLO A,100000 + TLNE B,SWAPF + TLC A,300000 +PWRD3F: PUSHJ P,$OUTPT + AOJA T,PWRD3A + + + +RPWRD: PUSHJ P,PBITS7 + MOVEI A,CRPT + PUSHJ P,PBITS + LDB A,[221200,,B] + PUSHJ P,$OUTPT + JRST RPWRD1 + +PWRD3E: TLO A,300000 + JRST PWRD3F + +PWRD3: PUSHJ P,PWRD31 +PWRD2: PUSHJ P,RCHKT + HRRZ A,B + DPB T,[10100,,A] + PUSHJ P,PBITS + JRST OUTWD + +;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD +;LEAVE RELOC (RH) IN B, RELOC (LH) IN T + +RCHKT: HRRZ B,WRDRLC ;CHECK FOR RELOC. OTHER THAN 0 OR 1. + HLRZ T,WRDRLC + TRZN B,-2 + TRZE T,-2 +RLCERR: ETSM [ASCIZ /Illegal relocation/] + POPJ P, + +RMOVET: ROT T,-1 + DPB B,[420100,,T] + TLZ C,3DFCLR ;SET RELOC BITS IN C + IOR C,T ;FROM B AND T. + POPJ P, + + ;CHECK WRDRLC FOR VALIDITY (CAPABILITY OF BEING PUNCHED OUT) + ;IF STANDARD THEN JUST RETURN + ;IF NON-STANDARD BUT OTHERWISE OK, PUT $R. ON GLOBAL LIST, RESET WRDRLC, AND RETURN + ;LEAVES B AND C SET UP WITH RH, LH OF WRDRLC. + +$RSET: MOVE C,WRDRLC ;GET RELOCATION + ADDI C,400000 ;WANT TO SEPARATE HALFWORDS + HLRE B,C ;GET LH IN B + HRREI C,400000(C) ;GET RH IN C (WILL EXCHANGE LATER) + MOVE A,[SWAPF+HFWDF,,$R.H] ;PUT THIS ON GLOBAL LIST IF LH NEEDS $R. + TRNE B,-2 ;CHECK LH + PUSHJ P,$RSET1 ;LH NEEDS GLOBAL REFERENCE + EXCH B,C + HRLI A,HFWDF + TRNE B,-2 ;CHECK RH + PUSHJ P,$RSET1 ;RH NEEDS GLOBAL REFERENCE + HRLZM C,WRDRLC ;RELOC OF LH + ADDM B,WRDRLC ;COMPLETE SETTING UP WRDRLC + POPJ P, + +$RSET1: JUMPGE B,$RSET2 ;STRANGE RELOCATION IN B, JUMP IF NON-NEGATIVE + MOVN T,B ;NEGATIVE, GET MAGNITUDE + TLOA A,MINF ;SET FLAG TO NEGATE GLOBAL +$RSET2: SOSA T,B ;POSITIVE, GET ONE LESS THAN IT IN T + TDZA B,B ;NEGATIVE, CLEAR B, RELOCATION LEFT OVER + MOVEI B,1 ;POSITIVE, SET RELOCATION LEFT OVER TO 1 + CAIN T,1 + MOVEI T,0 ;MULTIPLYING BY TWO OR SUBTRACTING TIMES 1 + TRNE T,-2000 + ETSM [ASCIZ /Relocation too large/] ;TOO BIG EVEN FOR $RSET + DPB T,[221200,,A] ;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE + AOS GLSP1 ;NOW PUT $R. ON GLOBAL LIST + MOVEM A,@GLSP1 + POPJ P, + +;PWRD DURING ABSOLUTE ASSEMBLY + +PWRD1: TRNE LINK,DECREL ; DEC REL FMT IS CONSIDERED ABSOLUTE. + JRST DECPW +IFN FASLP,[ + TRNE LINK,FASL + JRST FASPW ;SO IS FASL +] + MOVE A,GLSP1 + CAME A,GLSP2 + ETR ERRILG ;GLOBALS APPEARING ILLEGALLY + SKIPE WRDRLC + ETR ERRIRL ;RELOCATION APPEARING ILLEGALLY + TRNE LINK,ARIM + JRST PRIM ;RIM + TRNE LINK,DECSAV + JRST DSBLK1 +SBLKS1: MOVE A,WRD ;SBLK + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET + +SBLKS2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF + CLEARM SCKSUM +SBLK1: CAML T,OPT1 + JRST SBLK2 + MOVE A,SCKSUM + ROT A,1 + ADD A,(T) + MOVEM A,SCKSUM + MOVE A,(T) + PUSHJ P,PPB + AOJA T,SBLK1 + +SBLK2: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,SCKSUM + JRST PPB + +ESBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK. + PUSHJ P,SBLKS2 + JRST EBLK4 + +PRIM: MOVSI A,(DATAI PTR,) + HRR A,CLOC + PUSHJ P,PPB + MOVE A,WRD + JRST PPB + +; COME HERE TO OUTPUT WD IN ABSOLUTE DEC FMT (DECSAV) + +DSBLK1: MOVE A,WRD + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET, RETURN + +DSBLK2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + SOS BKBUF ; DEC "IOWD" FMT, POINT AT LOC-1 + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF +DSBLK3: CAML T,OPT1 + JRST DSBLK4 + MOVE A,(T) + PUSHJ P,PPB + AOJA T,DSBLK3 + +DSBLK4: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + POPJ P, + +; END A BLOCK IN DEC SAV FMT, COME HERE FROM EBLK. + +EDSBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK. + PUSHJ P,DSBLK2 + JRST EBLK4 + + +;END A BLOCK IN DEC FMT. COME FROM EBLK. +DECEBL: PUSH P,[EBLK5] +DECEB1: MOVSI A,DECWDS ;JUST INIT. AN ORDINARY BLOCK, + +;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A. +DECBLK: PUSH P,A + HRRZ A,BKBUF ;GET DATA-WORD COUNT OF CURRENT BLOCK. + JUMPE A,DECB1 ;NO WORDS => CAN IGNORE. + MOVEI TT,BKBUF+1 +DECB0: MOVE A,-1(TT) ;GET AND PUNCH NEXT WD OF BLOCK. + PUSHJ P,PPB + CAME TT,OPT1 ;STOP WHEN NEXT WD ISN'T IN BLOCK. + AOJA TT,DECB0 +DECB1: POP P,A + HLLZM A,BKBUF ;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0. + MOVEI TT,BKBUF+2 ;ADDR OF PLACE FOR 1ST DATA WD + MOVEM TT,OPT1 ;(LEAVE SPACE FOR WD OF RELOC BITS) + MOVE TT,[440200,,BKBUF+1] + MOVEM TT,BITP ;BP FOR STORING PAIRS OF RELOC BITS. + SETZM BKBUF+1 ;CLEAR THE WD OF RELOC BITS. + TLO FF,$FLOUT + POPJ P, + +;COME HERE TO OUTPUT A WORD IN DEC FORMAT. +DECPW: MOVS A,BKBUF + CAIE A,DECWDS ;BEFORE THE 1ST STORAGE WD IN ORDINARY BLOCK, + JRST DECPW0 + MOVE A,CRLOC ;MUST GO THE LOCATION CTR. + IDPB A,BITP + MOVE A,CLOC + MOVEM A,@OPT1 + AOS OPT1 + AOS BKBUF ;IT COUNTS AS DATA WORD. +DECPW0: MOVE A,BITP + TLNE A,77^4 ;IF NO ROOM FOR MORE RELOC BITS, + JRST DECPW1 + HLLZ A,BKBUF ;START A NEW BLOCK. + PUSHJ P,DECBLK + JRST DECPW + +DECPW1: PUSHJ P,$RSET ;SET UP RELOC BITS OF HALVES IN B,C. + LSH C,1 + IORI B,(C) ;COMBINE THEM. + MOVE A,GLSP1 + CAME A,GLSP2 + JRST DECPG ;GO HANDLE GLOBALS. +DECPW3: IDPB B,BITP ;STORE THE RELOC BITS + MOVE A,WRD +DECPW2: MOVEM A,@OPT1 ;AND THE VALUE. + AOS OPT1 + AOS BKBUF + POPJ P, + +;PUT A WORD DIRECTLY INTO DEC FMT BLOCK. +DECWRD: SETZ TM, +DECWR1: IDPB TM,BITP ;SKIP A PAIR OF RELOC BITS, + JRST DECPW2 ;STORE THE WORD. + +;HANDLE GLOBAL REFS IN DEC FMT. +DECPG: PUSHJ P,DECPW3 ;FIRST, OUTPUT THE WORD, +DECPG0: MOVSI A,DECSYM + PUSHJ P,DECBLK ;THEN STRT A SYMBOLS BLOCK. + MOVE C,GLSP2 + PUSH P,SYM +DECPG1: CAMN C,GLSP1 ;ALL DONE => + JRST DECPG2 ;GO START AN ORDINARY BLOCK FOR NEXT WD. + MOVE A,BITP + TLNN A,77^4 ;BLOCK FULL => START ANOTHER. + JRST DECPG0 + AOS C,GLSP2 ;GET ADDR OF NEXT GLOBAL REF. + MOVE B,(C) + MOVE B,(B) ;GET NAME OF SYM. + TLZ B,740000 + CAMN B,[SQUOZE 0,$R.] + JRST DECPG3 ;(DEC'S LOADER HAS NO SUCH HACK.) + CALL ASQOZR ;RIGHT-JUSTIFY THE SQUOZE FOR DEC SYSTEM. + MOVE A,B + TLO A,600000 ;PUT IN FLAGS SAYING ADDITIVE GLOBAL RQ. + PUSHJ P,DECWRD ;OUTPUT NAME. + HRRZ A,CLOC ;GET ADDR OF RQ, + TLO A,400000 ;MACRO-10 SETS THIS BIT SO I WILL. + MOVE B,(C) + TLNE B,SWAPF ;SWAPPED => TELL LOADER.. + TLO A,200000 + TLNE B,ACF+MINF + ETSM ERRILG ;CAN'T NEGATE GLOBAL OR PUT IN AC. + MOVE TM,CRLOC + PUSHJ P,DECWR1 ;OUTPUT 2ND WD, + JRST DECPG1 ;GO BACK FOR MORE GLOBAL REFS. + +DECPG2: REST SYM + JRST DECEB1 + +DECPG3: ETR ERRIRL ;WE NEEDED $R. BUT DIDN'T HAVE IT. + JRST DECPG1 + +ERRILG: ASCIZ /Illegal use of external/ +ERRIRL: ASCIZ /Illegal use of relocatables/ + + +;OUTPUT PROGRAM NAME BLOCK (AT START OF PASS 2) +;IF 2-SEG PROGRAM, ALSO OUTPUT A TYPE-3 BLOCK (LOAD INTO HISEG) +DECPGN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2. + PUSH P,[EBLK] + MOVSI A,DECNAM + CALL DECBLK + MOVE B,PRGNM + CALL ASQOZR + MOVE A,B + CALL DECWRD + MOVSI A,14 ;IDENTIFY THIS REL FILE AS MADE BY MIDAS. + CALL DECWRD + MOVE A,DECTWO + CAMN A,[MOVE] + RET ;NOT A 2-SEG PROGRAM. +DECP2S: MOVSI A,DECHSG + CALL DECBLK ;START A LOAD-INTO-HISEG BLOCK. + MOVE A,DECTWO + HRL A,DECBRH ;HISEG BRK,,TWOSEG ORIGIN. + SKIPL A + HRLI A,(A) + MOVEI TM,1 ;RELOCATION IS 1. + JRST DECWR1 + +IFN FASLP,[ +;INITIALIZE OUTPUT FOR FASL ASSEMBLY +FASOIN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2 + MOVE A,[SIXBIT /*FASL*/] + PUSHJ P,PPB + MOVE A,[MIDVRS] + LSH A,-6 + TLO A,(SIXBIT /M/) + PUSHJ P,PPB ;"LISP" VERSION NUMBER (USE M AND MIDAS NUMBER) + MOVE A,[440400,,FASB] ;INITIALIZE FASL OUTPUT BUFFER + MOVEM A,FASCBP + MOVEI A,FASB+1 + MOVEM A,FASBP + POPJ P, + + +;COME HERE TO OUTPUT A WORD IN FASL FORMAT +FASPW: MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;"PUNCH" OUT ATOM TBL (IF MORE HAS APPEARED) + PUSHJ P,$RSET ;GET RELOC + PUSH P,C ;SAVE LH RELOC + MOVEM B,FASPWB ;B HAS RELOC, WHICH IS ALSO FASL CODE FOR RELOC =1 + MOVE A,GLSP2 +FASPW3: CAME A,GLSP1 + JRST FASPW1 ;LOOK TO SEE .. +FASPW2: MOVE A,WRD ;B HAS RELOC, WHICH ALSO HAPPENS TO BE FASL CODE TYPE + MOVE B,FASPWB + PUSHJ P,FASO ;OUTPUT WORD IN A WITH FASL CODE IN B + POP P,TM + JUMPE TM,FASPW5 ;NO LEFT HALF RELOC, OK + MOVNI A,1 ;ACTIVATE FASL HACK FOR LH RELOC + MOVEI B,7 ;WOULD OTHERWISE BE GETDDTSYM + PUSHJ P,FASO +FASPW5: MOVE C,GLSP2 +FASPW6: CAMN C,GLSP1 + POPJ P, + HRRZ TM,1(C) + JUMPE TM,[AOJA C,FASPW6] + MOVE SYM,(TM) ;GET SQUOZE OF SYM + TLZ SYM,740000 ;CLEAR CODE BITS + HLRZ D,1(C) + TRZ D,400000 ;DONT WORRY ABOUT THAT BIT + TRZE D,MINF + TLO SYM,400000 ;NEGATE + CAIN D,SWAPF + JRST FSPWSW + CAIN D,HFWDF + JRST FSPWRH + CAIN D,ACF+SWAPF + JRST FSPWAC + JUMPE D,FSPWWD + ETSM [ASCIZ /Global in illegal FASL context/] + +FSPWWD: TLOA SYM,140000 +FSPWAC: TLOA SYM,100000 +FSPWRH: TLO SYM,40000 +FSPWSW: MOVE A,SYM + MOVEI B,7 ;DDT SYM + PUSHJ P,FASO + AOJA C,FASPW6 + +FASPW1: HRRZ TM,1(A) ;GLOTB ENTRY + JUMPE TM,FASPW4 + CAIL TM,AFDMY1 + CAIL TM,AFDMY2 +FASPW4: AOJA A,FASPW3 + MOVE C,1(A) ;ITS A LIST STRUCTURE REF + TLNN C,-1-HFWDF + SKIPE FASPWB + ETA [ASCIZ /Illegal LISP structure reference/] + MOVE TM,AFDMY2-AFDMY1(TM) ;GET FASL BITS + MOVEM TM,FASPWB ;FASL BITS + CLEARM 1(A) ;FLUSH THAT GUY + AOJA A,FASPW3 + +FPATB: CAMN C,FASATP ;PUNCH OUT ATOM TBL, AMT ALREADY PUNCHED IN C + POPJ P, ;THRU + MOVEI B,12 ;ATOM TBL INFO + MOVE A,FASAT(C) + TRNN A,-1 + AOJA C,FPATB3 ;LIST WORD .. SHOULD HAVE PUNCHED ITSELF + PUSHJ P,FASO + HRRZ D,FASAT(C) ;ATOM "LENGTH" + AOS C +FPATB1: SOJL D,FPATB2 + MOVE A,FASAT(C) + PUSHJ P,FASO1 + AOJA C,FPATB1 + +FPATB3: ETR [ASCIZ /Internal loss at FPATB3/] +FPATB2: MOVEM C,FASPCH ;RECORD AMOUNT PUNCHED + JRST FPATB ;LOOP BACK IF MORE + + +FASO: PUSHJ P,FASBO ;WRITE BITS +FASO1: MOVEM A,@FASBP ;STORE A IN FASL OUTPUT BUFFER + AOS TM,FASBP + CAIL TM,FASB+FASBL + ETF [ASCIZ /.FASL output block too long/] + POPJ P, + +FASBO: MOVE TM,FASCBP ;OUTPUT FASL CODEBITS IN B, WRITE PREV BLOCK IF NECC + TLNN TM,770000 + PUSHJ P,FASBE ;WRITE PREV FASL BLOCK + IDPB B,FASCBP + POPJ P, + +FASBE: PUSH P,A + PUSH P,B + MOVEI TT,FASB +FASBO2: CAML TT,FASBP + JRST FASBO3 + MOVE A,(TT) + PUSHJ P,PPB + AOJA TT,FASBO2 + +FASBO3: POP P,B + POP P,A + CLEARM FASB ;NEW CODE WORD + MOVEI TM,FASB+1 + MOVEM TM,FASBP + SOS FASCBP + POPJ P, + +AFATOM: PUSH P,B ;SAVE CODEBITS + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ATOM illegal except in FASL assembly/] + PUSHJ P,AFRATM ;READ "ATOM", RETURN INDEX IN A + POP P,B + HLRZS B +AFLST1: AOS GLSP1 + MOVEI T,AFDMY1(B) ;DUMMY (STORE THIS INFO IN SYM SO CONSTANTS WILL WIN + HRRZM T,@GLSP1 + MOVEI B,0 ;NO RELOCATION + POPJ P, + +;GLOBALS IN THIS TABLE KEEP TRACK OF LIST REFS +;UNDEF GLOBAL GODEBITS +AFDMY1: SQUOZE 44,.%VCEL ;EVENTUALLY POINT TO VALUE CELL + SQUOZE 44,.%SCAL ;EVENTUALLY BECOME "SMASHABLE CALL" + SQUOZE 44,.%ATM ;EVENTUALLY POINT TO ATOM + SQUOZE 44,.%ARY ;EVENTUALLY POINT TO ARRAY +AFDMY2: 2 ;CODE BITS FOR VALUE CELL REF + 3 ;CODE BITS FOR SMASHABLE CALL + 4 ;CODE BITS FOR POINTER TO ATOM + 10 ;CODE BITS FOR POINTER TO ARRAY + +AFRATM: PUSHJ P,AFRTKN ;READ TOKEN, LEAVING IT AT END OF FASAT + PUSHJ P,AFRITN ;"INTERN" IT, SKIP IF NOT FOUND + POPJ P, ;IF FOUND, INDEX IN A + PUSHJ P,AFRENT ;ENTER IN FASAT + POPJ P, + +AFRENT: MOVE A,FASAT1 ;STORE FASAT1 IN FASATP + MOVEM A,FASATP + AOS A,FASIDX ;RETURN LOAD TIME ATOM INDEX + POPJ P, + +AFRTKN: MOVE A,FASATP + ADD A,[700,,FASAT] + MOVEM A,FASAT2 ;BYTE PNTR TO USE TO STORE ATOM + CLEARM (A) + CLEARM 1(A) ;MAKE SURE ALL LOW BITS CLEARED + PUSHJ P,RCH + CAIN A,"# + JRST AFRTK1 ;READ NUMBER INTO FIXNUM SPACE + CAIN A,"& + JRST AFRTK2 ;READ NUMBER INTO FLONUM SPACE +AFRTKL: IDPB A,FASAT2 ;STORE CHAR + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 +AFTERR: ETA [ASCIZ /LISP atom name table full/] + CLEARM 1(A) +AFRTL2: PUSHJ P,RCH + CAIN A,12 + JRST AFRTL2 ;IGNORE LF IN ATOM NAMES (PRIMARILY SO /CR WINS WITH ONE + CAIN A,"/ ;SLASH + JRST AFRQT ;QUOTE CHAR + CAIE A,40 + CAIN A,15 + JRST AFREND + CAIE A,"; + CAIN A,11 + JRST AFREND + CAIE A,"( + CAIN A,") + JRST AFREN2 + CAIL A,"A+40 + CAILE A,"Z+40 + JRST AFRTKL ;THAT CHAR WINS, SALT IT + SUBI A,40 + JRST AFRTKL ;MAYBE MUST CONVERT TO L.C. BEFORE SALTING IT. + +AFRQT: PUSHJ P,RCH ;TAKE NEXT CHR NO MATTER WHAT + JRST AFRTKL + +AFRTK1: SKIPA TM,[100000,,1] ;PUT VAL IN FIXNUM SPACE +AFRTK2: MOVE TM,[200000,,1] ;PUT IT IN FLONUM SPACE + PUSH P,TM + MOVE SYM,[SQUOZE 0,ATOM] + PUSHJ P,FAGTFD + POP P,TM + MOVE B,FASATP + ADDI B,2 + CAIL B,FASAT+FASATL + XCT AFTERR + MOVEM TM,FASAT-2(B) + MOVEM A,FASAT-1(B) + MOVEM B,FASAT1 + POPJ P, + +AFREN2: TLO FF,FLUNRD ;SAVE ( OR ) AS WELL AS FLUSHING +AFREND: MOVEI B,5 ;PAD END OF P.N. WITH 0 S + MOVEI TM,0 +AFREN1: IDPB TM,FASAT2 + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 + XCT AFTERR + CLEARM 1(A) + SOJG B,AFREN1 + SUBI A,FASAT + MOVEM A,FASAT1 ;STORE PNTR TO WORD BEYOND ATOM + ; MAYBE PUT THIS IN FASATP + MOVE B,FASATP ;ADR OF START OF ATOM READ + SUBI A,1(B) ;COMPUTE LENGTH OF FASAT + HRRZM A,FASAT(B) ;PN ATOM 4.8-4.7 =0 STORE LENGTH IN HEADER WD + + POPJ P, + +AFRITN: MOVEI B,0 ;"INTERN" LAST ATOM READ IN + MOVEI A,1 ;A CONTAINS RUNTIME ATOM TBL INDEX + ;B INDEX WITHIN FASAT +AFRIT1: CAML B,FASATP + JRST POPJ1 ;NOT FOUND + MOVE C,FASATP ;POINTS AT HEADER OF WORD OF NEW (?) ATOM + HRRZ D,FASAT(B) ;HEADER WD OF GUY IN TBL(RIGHT HALF HAS LENGTH) + JUMPE D,AFRIT4 ;JUMP ON RESERVED FOR LIST +AFRIT2: MOVE TM,FASAT(C) + CAME TM,FASAT(B) + AOJA B,AFRIT3 ;THIS ONE LOSES + SOJL D,CPOPJ ;THIS ONE WINS! + AOS B + AOJA C,AFRIT2 + +AFRIT3: SOJL D,[AOJA A,AFRIT1] ;FINISH SPACING OVER THIS GUY +AFRIT4: AOJA B,AFRIT3 + +AFENTY: SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ENTRY in NON-FASL/] + SKIPN CRLOC + ETI [ASCIZ /.ENTRY when . is absolute/] + PUSHJ P,AFRATM ;READ FUNCTION NAME + HRLZS A + PUSH P,A + PUSHJ P,AFRATM ;READ TYPE (SUBR, LSUBR, ETC) + HRRM A,(P) + MOVE SYM,[SQUOZE 0,.ENTRY] + PUSHJ P,FAGTFD ;READ ARGS PROP + JUMPGE FF,ASSEM1 ;NOT PUNCHING PASS + PUSH P,A + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ANY NEW ATOMS OUT + POP P,C + POP P,A + MOVEI B,13 + PUSHJ P,FASO + HRL A,C + HRR A,CLOC + PUSHJ P,FASO1 + JRST ASSEM1 + +AFLIST: HLRZM B,AFLTYP + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.LIST illegal except in FASL assembly/] + PUSHJ P,AFRLST ;READ LIST, RTN ATM TBL INDEX IN A + SKIPN AFLTYP + JRST ASSEM1 ;JUST EVAL IN LISP AND THROW AWAY VALUE + MOVEI B,AFDMAI ;"ATOM" INDEX IN AFDMY1 TBL + JRST AFLST1 ;TREAT AS ATOM + +AFRLST: CLEARM AFRLD ;"DEPTH" + CLEARM AFRLEN ;"LENGTH" OF LIST AT CURRENT LEVEL + CLEARM AFRDTF ;DOT CONTEXT FLAG + JUMPGE FF,AFRLI1 + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ALL ATOMS "PUNCHED" + MOVE A,FASATP + MOVEM A,AFRFTP ;SAVED STATE OF FASAT POINTER + MOVE C,AFLTYP + MOVEI B,16 ;EVAL TYPE HACK + CAIN C,1 + MOVEI B,5 ;LIST TYPE HACK + PUSHJ P,FASBO ;WRITE CODE BITS +AFRLI1: +AFRL1: PUSHJ P,RCH + CAIE A,40 ;PREV ATOM (OR WHATEVER) "DELIMITED", SO THESE MEANINGLESS + CAIN A,15 ;UNLESS AT TOP LEVEL AND HAVE READ SOMETHING + JRST AFRL1A + CAIE A,11 + CAIN A,12 + JRST AFRL1A + CAIN A,"( + JRST AFRLO + CAIN A,") + JRST AFRLC + CAIN A,". + JRST AFRDT ;DOT.. + TLO FF,FLUNRD + SKIPE AFRLD + JRST AFRNXT ;READ NEXT GUY THIS LVL + SKIPE AFRLEN +AFRLO2: ETI [ASCIZ /LISP read context error/] +AFRNXT: SKIPN TM,AFRDTF + JRST AFRNX2 ;NOT HACKING DOTS, OK + AOS TM,AFRDTF + CAIE TM,2 + JRST AFRLO2 ;DIDNT JUST SEE THE DOT +AFRNX2: PUSHJ P,AFRATM + JUMPGE FF,AFRNX1 ;XFER ON NOT PUNCHING PASS + PUSHJ P,FASO1 ;TELL LOADER TO PUSH THIS ON ITS STACK +AFRNX1: AOS AFRLEN ;LIST NOW ONE LONGER THIS LVL + JRST AFRL1 + +AFRLO: SKIPN TM,AFRDTF + JRST AFRLO3 ;NOT HACKING DOTS + SOJN TM,AFRLO2 + CLEARM AFRDTF + JRST AFRL1 ;IGNORE BOTH . AND ( + +AFRLO3: SKIPE AFRLD ;( + JRST AFRLO1 + SKIPE AFRLEN + JRST AFRLO2 +AFRLO1: PUSH P,AFRLEN + CLEARM AFRLEN ;START NEW LVL + AOS AFRLD ;DEPTH NOW ONE GREATER + JRST AFRL1 + +AFRLC: SOSGE AFRLD ;) + JRST AFRLO2 ;AT TOP LEVEL, BARF + MOVE A,AFRLEN + SKIPN TM,AFRDTF + JRST AFRLC2 ;NOT HACKING DOTS + CAIE TM,2 + JRST AFRLO2 + SOS A ;MAIN LIST NOW ONE SHORTER + TLOA A,200000 ;DOT WITH LAST THING ON STACK +AFRLC2: TLO A,100000 ;TELL LOADER TO MAKE LIST THIS LONG + JUMPGE FF,AFRLC5 + PUSHJ P,FASO1 +AFRLC5: POP P,AFRLEN ;LENGTH AT PREV LVL + AOS AFRLEN ;NOW ONE MORE + CLEARM AFRDTF ;NOT HACKING DOTS NOW + SKIPE AFRLD ;RETURNING TO TOP LEVEL? + JRST AFRL1 + JRST AFRX1 ;YES THRU + +AFRDT: SKIPN AFRDTF + SKIPN AFRLEN + JRST AFRLO2 ;DOT IN FIRST POSITION OF LIST + AOS AFRDTF ;ENTER STATE 1 OF DOT HACKING + JRST AFRL1 + +AFRL1A: SKIPN AFRLD ;SPACER CHAR TERMINATES AT TOP LVL IF HAVE RD SOMETHING + SKIPN AFRLEN + JRST AFRL1 +AFRX1: JUMPGE FF,AFRX2 ;NOT PUNCHING PASS + MOVE A,AFRFTP + CAME A,FASATP + ETR [ASCIZ /Saw atoms in list on pass 2 for first time/] + SKIPN B,AFLTYP ;TYP LIST OP + SKIPA A,[-1,,] + MOVSI A,-2 ;PUT LIST OR VALUE OF LIST IN ATOM TBL + PUSHJ P,FASO1 ;TERM OP AND PUT IT IN ATOM TBL + MOVEI A,0 + MOVE B,AFLTYP + JUMPE B,CPOPJ ;JUST WANT VALUE OF LIST + CAIN B,1 ;ONLY WANT THIS FOR STRAIGHT LIST + PUSHJ P,FASO1 ;OUTPUT "SXHASH" WORD + AOS A,FASATP + CLEARM FASAT-1(A) ;RESERVE SLOT IN FASAT TBL + MOVEM A,FASPCH ;SAY ALREADY PUNCHED OUT + AOS A,FASIDX + POPJ P, + +AFRX2: TLO I,ILNOPT ;DONT TRY TO OPTIMIZE IF IN CONSTANT + CLEARB A,B + POPJ P, +] + +;.LIBRA, .LIFS, ETC. + +A.LIB: NOVAL ? NOABS + HLRZM B,LIBTYP' ;STORE BLOCK TYPE TO OUTPUT + CLEARM LIBOP ;INITIALIZE SQUOZE FLAGS + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $. +LIB1: PUSHJ P,GETSYL ;GET NAME + TRNN I,IRSYL + JRST LIB2 ;NO SYL, DON'T OUTPUT + IOR SYM,LIBOP + TLO SYM,40000 + PUSHJ P,OUTSM + MOVSI A,400000 + ANDCAM A,LIBOP +LIB2: MOVE B,CDISP ;GET CDISP + TLNN B,DWRD\DFLD ;CHECK FOR WORD TERMINATOR + JRST LIB3 ;WORD TERMINATOR => DONE + MOVE A,LIBOP + MOVE B,LIMBO1 ;RETRIEVE LAST CHAR READ + CAIN B,", + MOVSI A,400000 + CAIN B,"+ + TLZ A,200000 + CAIN B,"- + TLO A,200000 + MOVEM A,LIBOP' ;STORE SQUOZE FLAGS (LESS GLBL BIT) FOR NEXT SYM + JRST LIB1 + +LIB3: MOVE A,LIBTYP ;GET BLOCK TYPE TO OUTPUT + DPB A,[310700,,BKBUF] + PUSHJ P,EBLK + CAIN A,LLIB ;.LIBRA? + JRST ARELC1 ;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO + JRST LIB5 ;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS + +A.ELDC: NOVAL ? NOABS + PUSHJ P,EBLK + MOVEI A,ELTCB + DPB A,[310700,,BKBUF] + TRO FF,FRLOC ;MAKE EBLK OUTPUT NULL BLOCK + PUSHJ P,EBLK + SOSGE LDCCC + CLEARM LDCCC ;LOADER CONDITIONAL UNDERFLOW + JRST ASSEM1 + + ;LOADER CONDITIONAL ON VALUE + +A.LDCV: NOVAL ? NOABS + LSH B,-27. + PUSH P,B + PUSHJ P,AGETWD + POP P,B + DPB B,[400300,,BKBUF] + MOVEI A,LDCV + PUSHJ P,PLDCM + MOVEI A,0 + DPB A,[400300,,BKBUF] +LIB5: AOS LDCCC +CCASM1: JRST ASSEM1 + +;.GLOBAL, .SCALAR, .VECTOR +;LH(B) HAS ILGLI, ILVAR, ILVAR+ILFLO RESPECTIVELY. +; Note that use of ILFLO flag is a crock here. + +A.GLOB: NOVAL + HLLZ LINK,B ;REMEMBER WHICH OF THE THREE PSEUDO'S THIS IS. +A.GLO2: MOVE A,GLSPAS + MOVEM A,GLSP1 + SETOM FLDCNT + PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO NAME => DONE + CALL ES + JRST A.GLO1 + CAIE A,PSUDO_-14. + JRST A.GLO1 + JSP B,GVPSEU ;TRYING TO .GLOBAL A PSEUDO => TYPE APPRO. ERR MSG AND RETURN. + JRST A.GLO2 ;DON'T DO ANYTHING TO IT; MOVE ON TO NEXT ARG. + +A.GLO1: IOR I,LINK ;SET THE GLOBAL FLAG OR THE VARIABLE FLAG. + TLNE LINK,ILVAR ;FOR .VECTOR OR .SCALAR, SAVE # VARS CREATED BEFORE CREATING THIS ONE. + PUSH P,VARCNT ;SO WE CAN TELL IF THIS CALL TO GETVAL ACTUALY CREATES IT. + PUSHJ P,GETVAL ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS) + CAIA + GOHALT + TLNN LINK,ILVAR ; THAT'S IT IF .GLOBAL, ELSE CONTINUE + JRST A.GLO2 + PUSH P,LINK ;.VECTOR OR .SCALAR, MUST READ THE SIZE. + TLO FF,FLUNRD ;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN + MOVE SYM,[SQUOZE 0,.SCALAR] + TLNE LINK,ILFLO ; USE RIGHT SYM + MOVE SYM,[SQUOZE 0,.VECTOR] + CALL AGETFD + REST LINK + REST B ;GET PREV. VARCNT, SO WE CAN SEE IF IT WAS INCREMENTED. + TRNN A,-1 ;MAKE (N) WORK AS SIZE BY USIN L.H. IF R.H. IS 0. + HLRZS A + JUMPN A,A.GLO3 ;JUMP IF NONZERO SIZE SPEC'D + TLNN LINK,ILFLO ; ZERO, USE DEFAULT + JRST A.GLO2 ; WHICH IS ALWAYS 1 FOR .SCALAR + SKIPA A,VECSIZ ; AND VECSIZ FOR .VECTOR. +A.GLO3: TLNE LINK,ILFLO ;NONZERO SIZE, SO + MOVEM A,VECSIZ ;DEFAULT MUST BE REMEMBERED FOR .VECTOR. + SUBI A,1 ;1 WORD WAS ALLOCATED BY GETVAL - HOW MANY MORE WANTED? + CAME B,VARCNT ;(MAYBE SYM ALREADY DEFINED, MAYBE PASS2, ...) + ADDM A,VARCNT ;IF GETVAL REALLY ALLOCATED THE SPACE THIS TIME, ALLOCATE THE + JRST A.GLO2 ;RIGHT AMOUNT. + + ;.LOP + +A.LOP: NOVAL ? NOABS + PUSHJ P,EBLK ;TERMINATE CURRENT BLOCK + REPEAT 3,PUSHJ P,RGETFD ;GET THE FIELDS + MOVEI A,LD.OP + PUSHJ P,PLDCN + JRST ASSEM1 + + ;.LIBRQ + +A.LIBRQ: NOVAL ? NOABS +A.LBR1: PUSHJ P,GETSLD + JRST MACCR + PUSHJ P,PBITS7 + MOVEI A,3 + PUSHJ P,PBITS + TLO SYM,40000 + PUSHJ P,OUTSM + JRST A.LBR1 + +A.LNKOT: AOS (P) ;THIS PSEUDO RETURNS NO VALUE. + NOVAL + +AEND5: JUMPGE FF,CPOPJ ;IGNORE FOLLOWING ON NOT PUNCHING PASS + MOVE D,SYMAOB +AEND5A: MOVE SYM,ST(D) + LDB T,[400400,,SYM] + CAIE T,DEFLVR_-14. + CAIN T,DEFGVR_-14. + JRST AEND5E + CAIE T,LCUDF_-14. + CAIN T,GLOEXT_-14. + JRST AEND5B +AEND5C: ADD D,WPSTE1 + AOBJN D,AEND5A + POPJ P, + +AEND5E: 3GET C,D + TLNN C,3LLV + JRST AEND5C +AEND5B: HLLZ B,ST+1(D) + 3GET C,D + TLNN C,3RLNK + JUMPE B,AEND5C + TLZ SYM,740000 + CAIE T,LCUDF_-14. + CAIN T,DEFLVR_-14. + SKIPA + TLO SYM,40000 + PUSHJ P,LKPNRO + HRRZS ST+1(D) ;CLEAR OUT LIST HEAD POINTER. + TLZ C,3RLNK ;INDICATE NO LIST. + 3PUT C,D + JRST AEND5C + + ;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS + +PLDCM: PUSH P,LINK ;SAVE LINK FOR ALOC AND FRIENDS (CLOBBERS OTHER AC'S) + PUSH P,A ;SAVE LOADER COMMAND TYPE + PUSHJ P,EBLK ;TERMINATE PREV BLOCK, MAKING SURE LOADER KNOWS $. + PUSHJ P,PWRDA ;PUNCH OUT THE WORD + POP P,A ;GET BACK LOADER COMMAND TYPE FOR PLDCN + PUSHJ P,PLDCN ;OUTPUT THE RESULTING BLOCK +PLINKJ: POP P,LINK ;RESTORE LINK + POPJ P, + +PLDCN: HRRM A,BKBUF ;STORE LOADER COMMAND TYPE IN BKBUF HEADER + MOVEI A,LLDCM ;LOADER COMMAND BLOCK TYPE + DPB A,[310700,,BKBUF] ;STORE BLOCK TYPE IN HEADER + TRO FF,FRLOC ;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY + JRST EBLK + +;.RELP RETURNS RELOCATION OF ARG +A.RELP: CALL AGETFD + MOVE A,B + JRST VALRET + +;.ABSP RETURNS ABSOLUTE PART OF ARG. +A.ABSP: CALL AGETFD + JRST VALRET + +;.RL1 IN RELOCATABLE ASSEMBLY RETURNS ZERO WITH RELOCATION FACTOR ONE. +;IN ABSOLUTE ASSEMBLY, IT RETURNS JUST ZERO. +;IFN <.RELP .RL1>, IS A TEST FOR A RELOCATABLE ASSEMBLY. +A.RL1: SKIPGE A,CONTRL + TRNE A,DECREL\FASL + SKIPA B,[1] + SETZ B, + SETZ A, + RET + +AEND: NOVAL + SKIPE ASMOUT ; ERROR IF IN GROUPING. + JSP LINK,CONFLM ;FLUSH CONSTANTS, GIVE ERROR MSG. + SKIPE SCNDEP ;IF THERE ARE UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS, MENTION THEM. + MOVE A,BKCUR + CAIE A,BKWPB ;NOT IN .MAIN BLOCK => ERROR. + ETR ERRUMB + MOVE A,CDISP + TLNN A,DWRD + TLO FF,FLUNRD ;IF LAST TERM. WAS WORD TERM., RE-READ. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + EXCH A,PNTBP + MOVEM A,LISTTM +] + PUSHJ P,AVARI0 + PUSHJ P,CNSTN0 + SKIPL A,CONTRL + JRST [ PUSHJ P,AEND5 ; STINK RELOCATABLE => .LNKOT + JRST AEND6] + TRNE A,DECSAV ; IF DECSAV FMT, + JRST [ MOVE A,CLOC ; USE LOC COUNTER AT END AS LOC OF SYMBOLS + SKIPN DECSYA ; UNLESS LOC ALREADY SPECIFIED. + MOVEM A,DECSYA + JRST AEND6] + TRNN A,DECREL + JRST AEND6 + MOVE A,CLOC ;IN DEC FMT, UPDATE HIGHEST ADDR SEEN, + SKIPN CRLOC ;UPDATE EITHER THE HIGHEST ABS ADDR + JRST [ CAML A,DECBRA + MOVEM A,DECBRA + JRST AEND6] + CAML A,DECTWO ;OR THE HIGHEST REL ADDR IN THE + JRST [ CAML A,DECBRH ;APPROPRIATE SEG. + MOVEM A,DECBRH + JRST AEND6] + CAML A,DECBRK + MOVEM A,DECBRK +AEND6: JUMPL FF,AEND1 ;ON PUNCHING PASS, SPECIAL STUFF + PUSHJ P,GETWRD ;OTHERWISE EAT UP WORD, + JRST RETURN ;AND RETURN + +AEND1: PUSHJ P,EBLK +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE A,LISTTM + MOVEM A,PNTBP +] + MOVE SYM,[SQUOZE 0,END] + TLZ I,ILWORD + PUSHJ P,AGETWD +IFN LISTSW,[ + MOVEM A,LISTWD + MOVEM B,LSTRLC + SETOM LISTAD + SETOM LISTPF + SKIPE LSTONP + PUSHJ P,PNTR + SKIPE LISTP + PUSHJ P,LPTCLS ;DONE LISTING + MOVE A,LISTWD +] ;END IFN LISTSW, + SKIPL B,CONTRL + JRST AEND3 ;RELOCATABLE +IFN FASLP,[ + TRNE B,FASL + JRST FASEN ;FASL FORM +] + TRNE B,DECSAV + JRST AEND4 + TRNN B,DECREL ;IF DEC FORMAT, + JRST AEND1A + TLNN I,ILWORD ;THEN IF THERE7S A STARTING ADDRESS, + JRST AEND2 + MOVSI A,DECSTA ;OUTPUT START-ADDRESS BLOCK. + PUSHJ P,DECBLK + PUSHJ P,PWRD + PUSHJ P,EBLK + JRST AEND2 + +IFN FASLP,[ +FASEN: JRST AEND2 +] + +AEND3: HRRZ A,CLOC + HRRM A,BKBUF ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS + MOVEI A,LCJMP + PUSHJ P,PLDCM + JRST AEND2 + + ; HERE FOR DECSAV FORMAT. +AEND4: TLNE A,-1 + JRST AEND1B ; IF SOMETHING IN LH, MAY BE ENTRY VECTOR. + MOVE B,A + MOVE A,[-1,,120-1] ; NOTHING, SO ASSUME SIMPLE JRST. MUST + PUSHJ P,PPB ; FIRST SAVE S.A. IN .JBSA CROCK. + MOVE A,B + PUSHJ P,PPB + TLO A,(JRST) ; FURNISH JRST FOR PUTTING AT END OF OUTPUT. + JRST AEND1B + +AEND1A: ; CHECK WORD AND MAYBE MAKE IT A JRST + TLNN A,777000 ; CHECK INSTRUCTION PART + TLO A,(JRST) ; WANTS JRST + PUSHJ P,PPB +AEND1B: JUMPG A,.+3 + ETR [ASCIZ /Start instruction negative/] + HRLI A,(JRST) ;END SYMTAB WITH POSITIVE WORD + MOVEM A,STARTA ;SAVE FOR PUNCHOUT AT END OF SYMTAB + PUSHJ P,FEED1 +AEND2: PUSH P,[RETURN] +CNARTP: +IFN DECSW\TNXSW,[ + PUSH P,TTYFLG + SKIPE CCLFLG ;IN DEC VERSION, IF RUN BY CCL, DON'T PRINT + AOS TTYFLG ;THIS STUFF ON THE TTY - ONLY IN ERROR FILE AND LISTING. + CALL CNTPD + REST TTYFLG + RET + +CNTPD: +] + MOVNI D,1 + MOVEI TT,PCNTB +CNTP1: CAML TT,PBCONL + RET + HRRZ B,1(TT) + HLRZ A,1(TT) + CAMN A,B + JRST CNTP2 + AOSN D + TYPR [ASCIZ /Constants area inclusive +From To +/] + LDB B,[.BP (CGBAL),2(TT)] + SKIPE B + TYPR [ASCIZ /Global+/] + HRRZ B,1(TT) + PUSHJ P,OCTPNT + PUSHJ P,TABERR + HLRZ B,1(TT) + SOS B + PUSHJ P,OCTPNT + PUSHJ P,CRRERR +CNTP2: ADDI TT,3 + JRST CNTP1 + +AENDM1: TYPR [ASCIZ /Unterminated successful bracketed conditionals +The first was at /] + AOS A,CONDPN + CALL DPNT + MOVEI A,"- + CALL TYOERR + AOS A,CONDLN + CALL D3PNT2 +IFN TS,[ + TYPR [ASCIZ/ of file /] + MOVE B,CONDFI + CALL SIXTYO +] + JRST CRRERR + +AXWORD: CALL XGETFD ;READ 1ST FIELD, + TLNE I,ILMWRD + CALL IGTXT ;SOAK UP REST OF TEXT PSEUDO. + HRLM A,WRD + HRLM B,WRDRLC + MOVSI C,HFWDF + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + PUSH P,GLSP1 + CALL XGETFD ;NOW THE SECOND FIELD + HRRM A,WRD + HRRES B + ADDM B,WRDRLC + MOVSI C,HFWDF + MOVEI B,0 + POP P,T + PUSHJ P,LINKTC + JRST CABPOP + +A.NTHWD:CALL AGETFD ;READ THE NUMBER OF THE WORD WE WANT. + SOJL A,CABPOP ;NEGATIVE OR 0 => RETURN 0. + SOJL A,A.1STWD ;1 => TURN INTO .1STWD. + ;ELSE SKIP APPRO. # OF WORDS, THEN DO .1STWD. + +A.NTH1: PUSH P,A + PUSH P,WRD + CALL XGETFD + TLZ FF,FLUNRD + REST WRD + REST A + TLNN I,ILMWRD + JRST CABPOP ;IF STRING ENDS BEFORE DESIRED WORD, RETURN 0. + SOJGE A,A.NTH1 + +A.1STWD: CALL XGETFD ;GET THE 1ST WD OF FOLLOWING TEXT PSEUDO, + CALL IGTXT ;THROW AWAY THE REST. + MOVE T,A ;RETURN THE VALUE + JRST TEXT5 ;COMPLAINING IF FOLLOWED IMMEDIATELY BY SYLLABLE. + +A.LENGTH: CALL PASSPS + PUSH P,[0] + PUSH P,A +A.LN1: PUSHJ P,RCH + AOS -1(P) + CAME A,(P) + JRST A.LN1 + SOS T,-1(P) + SUB P,[2,,2] + JRST TEXT5 ;RETURN VALUE IN T + +ARDIX: NOVAL + PUSHJ P,AGETFD ;GET FIELD ARG + MOVEM A,ARADIX + JRST MACCR ;RETURN WITHOUT CLOBBERING CURRENT VALUE + +A.RADIX: CALL AGETFD ;READ THE TEMP. RADIX. + PUSH P,ARADIX ;LAMBDABIND RADIX TO THAT VALUE. + MOVEM A,ARADIX + CALL XGETFD ;READ IN THE NEXT FIELD USING THAT RADIX. + REST ARADIX + JRST VALRET + +;READ A BIT-MASK AS ARG, RETURN THE LH OF BP. FOR THAT BYTE. +A.BP: CALL YGETFD + MOVEI C,SPACE + SKIPE CDISP ;IF ARG WAS ENDED BY A COMMA, TURN IT INTO A SPACE + HRRM C,CDISP ;SO THAT .BP FOO,BAR USES THE FLD SPACE FLD FORMAT. + JUMPE A,VALR1 + PUSH P,A + JFFO A,.+2 + MOVEI B,36. + EXCH B,(P) ;(P) HAS # LEADING ZEROS. + MOVN A,B + AND A,B ;A HAS ONLY THE LOW BIT OF THE BYTE. + JFFO A,.+2 + MOVNI B,1 ;B HAS 35.-<# TRAILING ZREROS.> + MOVEI A,1(B) + SUB A,(P) ;A HAS SIZE OF BYTE + LSH A,30 ;PUT IN S FIELD OF BP. + SUB P,[1,,1] + MOVNS B + ADDI B,35. ;B HAS # TRAILING ZEROS. + DPB B,[360600,,A] ;PUT THAT IN P FIELD OF BP. + JRST VALR1 + +;READ IN BP, RETURN BIT MASK TO SPEC'D BYTE. +;THE ARG SHOULD BE JUST THE LH OF A BP, WHICH MAY BE IN EITHER HALF OF THE ARG. +A.BM: CALL GETBPT ;READ IN A BYTE POINTER ARG, IN A, POINTING AT T. + SETZ T, + SETO C, +A.DPB1: DPB C,A ;PUT 1'S IN SPEC'D PART OF ACCUM T + MOVE A,T + JRST VALRET + +;READ IN A BYTE POINTER (REALLY JUST S AND P FIELDS) AND MAKE POINT AT AC T. +;RETURN IT IN AC A. +GETBPT: CALL YGETFD + TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. + HRLI A,(A) + TLZ A,77 ;MAKE BP. -> AC T + HRRI A,T + RET + +;RETURN # TRAILING ZEROS IN ARGUMENT. +A.TZ: CALL YGETFD + MOVN B,A + AND A,B ;A HAS JUST LOW BIT OF ARG SET. + JFFO A,.+2 + MOVNI B,1 ;# OF ZEROS BEFORE LOW BIT = + MOVN A,B ;35. - <# TRAILING ZEROS> + ADDI A,35. + JRST VALRET + +;RETURN # LEADING ZEROS IN ARG. +A.LZ: CALL YGETFD + JFFO A,.+2 + MOVEI B,36. + MOVE A,B + JRST VALRET + +;.DPB STUFF,BP,WORD DOES A DPB OF STUFF INTO THE FIELD OF WORD SPEC'D BY BP, +;RETURNING THE RESULTING WORD. +A.DPB: CALL YGETFD ;READ STUFF. + PUSH P,A + CALL GETBPT ;READ BP AND TURN INTO ACTUAL BP POINTING AT T + PUSH P,A + CALL YGETFD ;READ IN WORD AND PUT IN T. + MOVE T,A + REST A ;A HAS BP + REST C ;C HAS STUFF + JRST A.DPB1 ;GO DO THE DEPOSIT AND RETURN THE ALTERED WORD. + +;.LDB BP,WORD RETURNS THE CONTENTS OF THE BYTE IN WORD SELECTED BY BP +A.LDB: CALL GETBPT + PUSH P,A + CALL YGETFD + MOVE T,A + REST A + LDB A,A + JRST VALRET + +;.IBP BP RETURNS AN INCREMENTED BP. +A.IBP: CALL YGETFD + TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. + HRLZS A + IBP A + JRST VALRET + +AWORD: NOVAL + PUSHJ P,EBLK + PUSHJ P,GETWRD ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"? + PUSHJ P,PPB + JRST ASSEM1 + +;.BIND - MAKE SYMS BE DEFINED IN CURRENT (SPEC'D) BLOCK. LH(B) HAS 0. +;.KILL - FULLY KILL THE SYMS.LH(B) HAS 3KILL. +;.HKILL - HALFKILL THEM. LH(B) HAS 3SKILL. +;.XCREF - PREVENT CREFFING OF SYMS. LH(B) HAS 3NCRF. +;.DOWN - SET 3DOWN, MAKING SYM VISIBLE IN SUBBLOCKS IN 1 PASS ASSEMBLY. +A.KILL: NOVAL + HLLZ LINK,B ;REMEMBER BIT TO SET. +A.KIL1: CALL GETSLD ;READ NEXT SYMBOL NAME. + JRST MACCR ;NO MORE, EXIT. + SKIPE LINK ;EXCEPT FOR .BIND, DO NOTHING ON PASS 1. + JUMPGE FF,A.KIL1 + CALL ESDEF ;DEFINE THE SYMBOL, D HAS STE IDX. + JRST A.KIL2 ;SYMBOL NEVER SEEN. + IORM LINK,ST+2(D) ;SET THE BIT IN 3RDWRD.. + IOR C,LINK ;(IF .XCREF, PREVENT CREFFING THIS TIME) +IFN CREFSW,XCT CRFINU ;CREF THE SYMBOL + JRST A.KIL1 + +A.KIL2: MOVSI T,LCUDF ;SYMBOL UNDEFINED, MAKE UNDEF LOCAL. + IOR C,LINK ;WITH THE DESIRED BIT SET. + TLO C,3MACOK ;SHOULDN'T BE ERROR IF IT BECOMES MACRO. + CALL VSM2 +IFN CREFSW,XCT CRFINU + JRST A.KIL1 + +;EXPUNG SYM1,SYM2 ... ;UNDEFINE THOSE SYMS. +AEXPUNG: NOVAL +AEXPU2: PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO MORE NAMES + PUSH P,[AEXPU2] ;AFTER THIS SYM, POPJ TO READ ANOTHER. +;EXPUNGE 1 SYMBOL, SQUOZE IN SYM. +AEXPU1: PUSHJ P,ES + JFCL ;NOT FOUND, DON'T COMPLAIN, JUST CREF. +IFN CREFSW,XCT CRFDEF + HRLZI T,400000 ;EXPUNGED ZERO SYM + SKIPE ST(D) + MOVEM T,ST(D) + SKIPL CONTRL ;IF RELOCATABLE ANDLOCAL SYMBOL, + CAIL A,DEFGVR_-33. + RET + PUSHJ P,PBITS7 ;TELL STINK TO EXPUNGE SYM. + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY IS NEW TYPE RQ, + PUSHJ P,OUTSM0 + MOVSI A,400000 ;NEW NAME NULL => DELETE. + JRST $OUTPT + +;EQUAL SYM1,SYM2 ;DEFINE SYM1 SAME AS SYM2. +AEQUAL: NOVAL + PUSHJ P,GETSLD + ETR ERRTFA + PUSH P,SYM ;REMEMBER SYM NAME AND BLOCK TO DEF. IN. + PUSH P,ESBK + PUSHJ P,GETSLD + ETR ERRTFA +IFN CREFSW,XCT CRFINU ;CREF SYM DEFINED AS. + CALL ES ;LOOK UP SYM TO EQUATE TO. + JRST [ REST ESBK ;NOT FOUND => EXPUNGE THE 1ST SYM. + REST SYM + JRST AEXPU1] + REST ESBK + REST SYM +IFN CREFSW,XCT CRFDEF + PUSH P,A + PUSH P,B ;SAVE INFO ON VALUE OF SYM TO EQUATE TO. + PUSH P,C + CALL ESDEF + MOVEM SYM,ST(D) + REST B ;3RDWRD OF 2ND SYMBOL. + REST ST+1(D) ;(WHAT WAS PUSHED FROM B) + REST A + DPB A,[400400,,ST(D)] + TLZ C,3DFCLR ;SAVE OLD 3MAS, 3NCRF OF 1ST SYMBOL (AND ITS BLOCK #). + AND B,[3DFCLR,,] ;SET REST OF 3RDWRD BITS FROM 2ND SYMBOL. + IOR B,C + 3PUT B,D + JRST MACCR + +ERRTFA: ASCIZ /Too few args - EQUAL/ + +;.SEE SYM1,SYM2,... ;CREF THOSE SYMS. +A.SEE: CALL GETSLD ;READ 1 SYMBOL. + JRST MACCR ;NONE TO BE READ. +IFN CREFSW,[ + SKIPN CRFONP ;IF CREFFING, + JRST A.SEE + CALL ES + MOVEI A,SYMC_-33. + XCT CRFINU ;CREF THE SYMBOL. +] + JRST A.SEE + +;UUO HANDLING ROUTINE +;41 HAS JSR ERROR + +VBLK +ERRCNT: 0 ; NUMBER OF ERRORS HIT -- VALUE OF .ERRCNT +ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP. +ERRJPC: 0 ;JPC READ WHEN UUO. +ERROR: 0 +IFN ITSSW, .SUSET [.RJPC,,ERRJPC] + JRST ERRH ;GO HANDLE IT +PBLK +ERRH: PUSH P,T + PUSH P,B ;NOT TYPR => ERROR OF SOME KIND + PUSH P,A + PUSH P,C + LDB T,[331100,,40] ;PICK UP OP CODE + CAIN T,TYPCR_-33 ; TYPCR? + JRST TYPCR1 + CAIN T,TYPR_-33 ; OR TYPR? + JRST TYPR1 ; YES + ;ERROR OF SOME KIND + CAIE T,ETASM_-33 ;CHECK FOR SPECIAL LOSSAGES AT COLON + CAIN T,ETSM_-33 + CAME SYM,SYSYM ;ARE WE ABOUT TO MENTIO THIS LOSING LABEL AS THE LAST ONE? + JRST ERRH1 + MOVE T,SYSYM1 + + MOVEM T,SYSYM ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT + MOVE T,SYLOC1 + MOVEM T,SYLOC +ERRH1: +IFN TS,[ +IFN LISTSW,[ + CALL PNTR ;FORCE OUT BUFFERED LISTING OUTPUT + CALL PNTCRR ;AND CR, SO USER CAN SEE WHERE ERROR WAS. +] + PUSHJ P,ERRTFL ;IF NOT SAME FILE AS LAST, PRINT FILE NAME. +] + SETZM ERRCCT + AOS ERRCNT ; BUMP ERROR TOTAL +IFN DECSW,AOS .JBERR ; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT + MOVE A,SYSYM ;GET LAST TAG DEFINED + JUMPE A,ERR1 ;SKIP PRINTOUT IF NONE THERE + PUSHJ P,SYMTYP ;THERE, TYPE IT OUT + MOVE B,CLOC ;NOW GET CURRENT LOCATION + SUB B,SYLOC ;SUBTRACT VALUE OF LAST TAG + JUMPE B,ERR1 ;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG + MOVEI A,"+ ;NOT AT TAG, + PUSHJ P,TYOERR ;TYPE OUT PLUS SIGN, + AOS ERRCCT ;(1 MORE CHAR TYPED) + PUSHJ P,OCTPNT ;THEN TYPE OUT DIFFERENCE IN OCTAL +ERR1: PUSHJ P,TABERR ;NOW SEPARATE WITH TAB + MOVE A,ERRCCT + CAIGE A,8 ;MAKE SURE MOVE TO COLUMN 16. + PUSHJ P,TABERR + MOVEI B,[ASCIZ/GL+/] + SKIPGE GLOCTP ;LOCATION GLOBAL? + PUSHJ P,TYPR3 ;YES, TYPE OUT THAT FACT. + MOVE B,CLOC ;GET CURRENT LOCATION + PUSHJ P,OCTPNT ;TYPE OUT IN OCTAL +;DROPS THROUGH + +;DROPS THROUGH. + PUSHJ P,TABERR + MOVE A,MDEPTH ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS + MOVSI T,-2 + CALL DPNT0 ;PRINT, IN 2-CHAR FIELD. + MOVEI A,". + CALL TYOERR ;(USED TO BE OCTAL) + MOVE A,CPGN ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0) + PUSHJ P,[AOJA A,D6PNT] ;TYPE IT OUT IN DECIMAL + MOVEI A,"- + CALL TYOERR + MOVE A,CLNN ;ALSO CURRENT LINE NUMBER + PUSHJ P,[AOJA A,D3PNT2] + PUSHJ P,TABERR + MOVEI A,48. ;ASSUME ALL THE STUFF WE'VE PRINTED TAKES 48. CHARS + MOVEM A,ERRCCT ;MAYBE SOMEDAY TABERR, ETC. WILL REALLY UPDATE ERRCCT PROPERLY. + LDB A,[331100,,40] ;PICK UP OP CODE AGAIN + CAIGE A,8 ;ERROR UUO MAX + JRST .+1(A) + JRST [GOHALT ? JRST .-1] ;OPCODE 0, OR TOO BIG. + JRST ERRSM ;ETSM => TYPE SYM AND MESSAGE. + JRST ERRR ;ETR => JUST PRINT MESSAGE + JRST ERRJ ;ERJ => RH(40) HAS JUMP ADR + JRST ERRI ;ETI => IGNORE LINE RET TO ASSEM1 + JRST ERRA ;ETA => RET TO ASSEM1 + JRST ERRASM ;ETASM => TYPE SYM AND GO TO ASSEM1 + JRST IAE ;ERF => FATAL. + +ERRJ: MOVE A,40 ;ERJ => RH(40) HAS JUMP ADR + HRRM A,ERROR + JRST ERRET1 + +ERRI: PUSHJ P,RCH ;ETI => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE + CAIE A,12 + JRST .-2 +ERRA: MOVEI A,ASSEM1 ;ETA => RETURN TO ASSEM1, DON'T TYPE SYM. + MOVEM A,ERROR + JRST ERRR + +ERRASM: MOVEI A,ASSEM1 ;ETASM => TYPE SYM AND RETURN TO ASSEM1 + MOVEM A,ERROR +ERRSM: MOVEI C,56. ;ETSM OR ETASM => TYPE OUT SYM THEN MESSAGE + CALL TYPE37 ;CR NOW IF WHOLE MSG WON'T FIT ON ONE LINE. + MOVE A,SYM + PUSHJ P,SYMTYP + PUSHJ P,TABERR +ERRR: CALL TYPE40 ;TYPE THE ERROR MESSAGE. +ERRET1: REST C + POP P,A ;COMMON RETURN POINT FROM UUOS + POP P,B + POP P,T + JRST 2,@ERROR + +;FINISH UP AN ERROR UUO'S ERROR MESSAGE. PRINT THE SPECIFIED STRING +;AND ALSO "IN DEFINE AT ..." IF NECESSARY, ALONG WITH APPROPRIATE CR'S. +TYPE40: MOVE C,ERRCCT + CALL TYPE37 + CALL TYPR4 ;PRINT THE ASCIZ STRING + CALL CRRERR + SKIPN A,DEFNPS ;IF INSIDE A LONG PSEUDO, + RET + MOVE A,DEFNLN + MOVE B,DEFNPN + CAMN A,CLNN ;WHICH DIDN'T START IN THIS VERY LINE, + CAME B,CPGN + JRST TYPE42 + MOVE A,DEFNFI + CAMN A,INFFN1 + JRST TYPE43 +TYPE42: MOVEI B,[ASCIZ/ in /] + CALL TYPR3 + MOVE A,DEFNPS + CALL SYMTYP ;SAY WHAT PSEUDO, AND WHERE IT STARTED. + MOVEI B,[ASCIZ/ Starting at /] + CALL TYPR3 + MOVE A,DEFNPN ;PAGE # -1. + CALL [AOJA A,DPNT] ;PRINT PAGE #. + MOVEI A,"- + CALL TYOERR + AOS A,DEFNLN + CALL D3PNT2 ;PRINT LINE #. +IFN TS,[ + MOVE B,DEFNFI ;PRINT FILE NAME IF IT ISN'T THE CURRENT FILE. + CAMN B,INFFN1 + JRST TYPE41 + MOVEI B,[ASCIZ/ of file /] + CALL TYPR3 + MOVE B,DEFNFI + CALL SIXTYO +] +TYPE41: CALL CRRERR ;AND CRLF. +TYPE43: MOVE A,ERROR + CAIE A,ASSEM1 ;IF THIS ERROR IS EXITING THE PSEUDO, + RET + SETZM DEFNPS ;SAY WE'RE NOT IN IT ANY MORE. + SETOM TEXT4 + RET + +;JSP TM,ERMARK IN A PSEUDO, TO ARRANGE FOR ERROR MESSAGES TO MENTION +;THAT PSEUDO. SYM SHOULD CONTAIN THE NAME OF THE PSEUDO. +;PUSHES A WORD ON THE STACK SO THAT WHEN THE PSEUDO RETURNS DEFNPS WILL BE CLEARED. +;IF DEFNPS IS SET UP ALREADY, DOES NOTHING (DOESN'T SET DEFNPS; DOESN'T PUSH THE WORD) +ERMARK: SKIPE DEFNPS + JRST (TM) + MOVEM SYM,DEFNPS + MOVE SYM,CLNN + MOVEM SYM,DEFNLN + MOVE SYM,CPGN + MOVEM SYM,DEFNPN + MOVE SYM,INFFN1 + MOVEM SYM,DEFNFI + MOVE SYM,DEFNPS + CALL (TM) + CAIA + AOS (P) + SETZM DEFNPS + RET + +;C SHOULD HAVE CURRENT HORIZ POS. IF TYPING THE STRING 40 POINTS AT +;WOULD OVERFLOW THE LINE, TYPE A CRLF AND TAB NOW ON THE TTY ONLY. +TYPE37: HRRZ B,40 + HRLI B,440700 ;FIRST, FIGURE OUT HOW FAR ON LINE WE'LL TYPE IF WE DON'T CR. + ILDB A,B + CAIE A, ;AND COUNT CHARS IN THE ERR MSG. + AOJA C,.-2 + CAMGE C,LINEL + RET +CRRTBX: MOVEI A,10 + MOVEM A,ERRCCT ;PREVENT THIS FROM BEING DONE TWICE. + SKIPE TTYFLG + RET + MOVEI A,^M ;IF THERE'S NO ROOM, CRLF ON THE TTY ONLY (NOT THE ERR FILE). + PUSHJ P,TYOX + MOVEI A,^J + PUSHJ P,TYOX + MOVEI A,^I + JRST TYOX + + ;TYPE OUT SQUOZE (FLAGS OFF) IN A + +SYMTYP: PUSHJ P,SQCCV ;GET NEXT CHAR IN ASCII. + AOS ERRCCT + PUSHJ P,TYOERR ;TYPE IT OUT. + JUMPE B,CPOPJ ;RETURN IF NOTHING LEFT (TYPED OUT AT LEAST ONE CHAR THOUGH) + IMULI B,50 ;LEFT-JUSTIFY REMAINDER + MOVE A,B ;GET LEFT-JUSTIFIED REMAINDER IN A + JRST SYMTYP ;TYPE OUT REMAINDER OF SYM + + ;TYPE OUT SQUOZE CHARACTER (IN A) + +SQCCV: IDIV A,[50*50*50*50*50] + CAIG A,10. + SOJA A,SQCDTO ;NUMBER (OR BLANK =>SLASH) + CAIL A,45 + SKIPA A,SYTB-45(A) ;SPECIAL + ADDI A,"A-13 ;LETTER + POPJ P, + +SQCDTO: ADDI A,"0 + POPJ P, + +SYTB: ". + "$ + "% + +D3PNT2: MOVE T,[-3,,400000] ;3 CHAR FIELD, NO ZERO SUPPRESSION. + JRST DPNT0 + +DPNT: TDZA T,T ;ORDINARY DECIMAL PRINT. +D6PNT: MOVSI T,-6 ;6 CHAR FIELD, ZERO SUPPRESSION. +DPNT0: IDIVI A,10. + HRLM B,(P) + TRNE T,377777 ;IF NOT LAST DIGIT, + TRNE T,400000 ;AND ZERO-SUPPR. WANTED, + JRST DPNT2 + JUMPN A,DPNT2 ;IF THIS IS A LEADING 0, + JUMPN B,DPNT2 + MOVEI B," -"0 + HRLM B,(P) ;REPLACE WITH A SPACE. +DPNT2: AOBJN T,.+2 ;J IF NOT ENOUGH CHARS YET. + JUMPE A,DPNT1 ;ENOUGH, DON'T MAKE MORE IF NOT NEEDED. + CALL DPNT0 + JRST DPNT1 + +;TYPE HALFWORD IN B IN OCTAL. +OCTPNT: HRRZ A,B + IDIVI A,10 + HRLM B,(P) + JUMPE A,.+2 + PUSHJ P,.-3 + AOS ERRCCT +DPNT1: HLRZ A,(P) +ADGTYO: ADDI A,"0 + JRST TYOERR + +;TYPE OUT THE SIXBIT WORD IN B + +SIXTYO: JUMPE B,CPOPJ + MOVEI A,0 + ROTC A,6 + ADDI A,40 + PUSHJ P,TYOERR + JRST SIXTYO + + ;TYPE CRLF + +CRR: MOVEI A,15 + PUSHJ P,TYO + MOVEI A,12 + JRST TYO + +;OP CODE 0 => NO RECOVERY RETURN TO GO9 +IAE: CALL TYPE40 ;PRINT THE ERROR MESSAGE. + SKIPE ASMOUT + JSP LINK,CONFLZ ;TELL USER ABOUT UNTERM. GROUPINGS. + SKIPE SCNDEP ;MENTION ANY UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS. + MOVEI B,[ASCIZ /Error is fatal. +/] + CALL TYPR3 +IFN ITSSW,[ + .SUSET [.RTTY,,A] + SKIPL A + .RESET TYIC, +] + JRST GO9 + + ;TYPR [ASCIZ /STRING/] ;TYPE OUT STRING + +TYPR1: PUSH P,[ERRET1] +TYPR4: HRRZ B,40 ;GET ADR OF BEGINNING OF STRING +TYPR3: HRLI B,440700 ;CONVERT TO BYTE POINTER +TYPR2: ILDB A,B ;GET NEXT CHAR + JUMPE A,CPOPJ ;JUMP IF ZERO, END OF STRING + PUSHJ P,TYOERR ;NON-ZERO, TYPE IT OUT + JRST TYPR2 + + ; TYPCR [ASCIZ /STRING/] ; Type out string, followed by CRLF + +TYPCR1: PUSH P,[ERRET1] + PUSHJ P,TYPR4 ; When done, fall thru. + +CRRERR: MOVEI A,^M ;CRLF IN ERROR MESSAGE. + CALL TYOERR + SKIPA A,[^J] +TABERR: MOVEI A,^I ;TAB INN ERROR MESSAGE. +TYOERR: +IFN LISTSW,[ + SKIPE LSTTTY ;OUTPUT TO LISTING UNLESS LSTTTY ZERO. + CALL PILPTX +] + SKIPG LSTTTY + JRST TYO ;TO TTY UNLESS LSTTTY POSITIVE. + RET + +;OUTPUT-FORMAT SELECTING PSEUDOS: + +;.SLDR -- ON PASS 2, PUNCH OUT SBLK LOADER AND SELECT SBLK FORMAT +A.SLDR: NOVAL + JUMPGE FF,MACCR ;DO NOTHING ON PASS 1. + PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE FIRST + PUSHJ P,PLOD1A ;PUNCH OUT LOADER +SIMBLK: MOVSI B,SBLKS ;ENTRY FROM PS1, A.SLDR SELECT SBLK + JRST SIMBL1 + +SRIM: MOVE A,SYM ;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL) + PUSH P,B + CALL SYMTYP + TYPR [ASCIZ/ Encountered +/] + REST B +SIMBL1: TRO FF,FRNPSS + HRRI B,TRIV ;SET UP TRIV FLAG FOR LH(CONTRL) + MOVSS B + CAME B,CONTRL ;IF CHANGING MODES, END THE BLOCK IN THE OLD MODE + CALL EBLK + MOVE A,CONTRL ;IF OLD MODE WAS RELOCATABLE OF SOME KIND, + TRNN A,DECREL\FASL + JUMPL A,SIMBL2 + SETZM CRLOC ;INITIALIZE LOCATION COUNTER. + MOVEI A,100 ; USE 100 ASSUMING ITS SBLK + TRNE B,DECSAV + MOVEI A,140 ; BUT USE 140 FOR DEC ABS. + MOVEM A,CLOC +SIMBL2: MOVEM B,CONTRL ;STORE NEW MODE. + TRNE B,ARIM\ARIM10 + TRZ F,FRSYMS ;RIM AND RIM10 MODES IMPLY NO SYMBOLS. + AOS (P) + + ;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC + ;CALLED BY OUTPUT SELECTING PSEUDOS +OUTUPD: NOVAL +IFN A1PSW,[ + TRNE FF,FRNPSS ;IF PASS 1, + TLNN FF,$FLOUT + JRST OUTCHK + AOS OUTN1 ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE +OUTCHK: TLZE FF,$FLOUT + AOS OUTC ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY +] + RET + +ANOSYMS: NOVAL + TRZ FF,FRSYMS + JRST MACCR + +A1PASS: PUSHJ P,OUTUPD +A1PAS1: TLO FF,FLPPSS + MOVEIM A.PPASS,1 ;SET .PPASS TO 1. +IFN CREFSW,[ SKIPE CREFP ;THIS NOW PUNCHING PASS, + PUSHJ P,CRFON ;MAYBE TURN ON CREFFING. +] +IFN LISTSW,[ + SKIPE LISTP + CALL LSTON ;LIST NOW IF WANT LISTING AT ALL. +] + MOVE A,CONTRL + TRNE A,DECREL + CALL DECPGN + TRZA FF,FRNPSS +ARELOC: PUSHJ P,OUTUPD +ARELC1: PUSHJ P,EBLK ;FINISH CURRENT OUTPUT BLOCK + TRO FF,FRLOC ;DOING LOCATION ASSIGNMENT, MAKE SURE NEXT GETS OUTPUT + CLEARM CLOC + MOVEI A,1 + MOVEM A,CRLOC + CLEARM CONTRL + SETZM BKBUF + MOVEI A,LREL + DPB A,[310700,,BKBUF] + MOVEM A,CDATBC + JRST MACCR + + + ; .DECSAV - SELECT DEC ABSOLUTE ZERO-COMPRESSED (SAV) FORMAT +A.DECSAV: NOVAL + MOVSI B,DECSAV ; SET FLAG + JRST SIMBL1 ; THEN HANDLE ALMOST LIKE .SBLK + + +A.DECTWO: CALL AGETFD ;READ THE TWOSEG ORIGIN. + TRNN FF,FRNPSS + ETF [ASCIZ /.DECTWO follows 1PASS/] + MOVE C,ISAV + TRNN C,IRFLD ;NO ARG => DEFAULT IT TO 400000 + MOVEI A,400000 + MOVEM A,DECTWO + +A.DECREL: PUSHJ P,OUTUPD + TRZ FF,FRLOC + PUSHJ P,EBLK ;FORCE OUT BLOCK IN OTHER FMT. + MOVE A,[SETZ DECREL] + CAME A,CONTRL ;SWITCHING TO .DECREL MODE FOR 1ST TIME + TRNE FF,FRNPSS ;IN A 1PASS ASSEMBLY + JRST A.FAS1 + CALL A.FAS1 ;DO THE SWITCH + JFCL + CALL DECPGN ;THEN WRITE THE PROGRAM NAME + JRST MACCR + +A.FAS1: MOVEM A,CONTRL ;DEC FMT COUNTS AS ABS ASSEMBLY. + SETZM BKBUF ;(SO EBLK W0N'T OUTPUT ANYTHING) + SETZM CLOC ;START ASSEMBLING FROM RELOCATABLE 0. + MOVEI A,1 + MOVEM A,CRLOC + PUSHJ P,EBLK ;INITIALIZE AN ORDINARY (DECWDS) BLOCK. + JRST MACCR + +IFN FASLP,[ +A.FASL: PUSHJ P,OUTUPD + PUSHJ P,EBLK + MOVE A,[SETZ FASL] ;FASL ALSO COUNTS AS ABS + JRST A.FAS1 +] + +ATITLE: NOVAL + PUSH P,CASSM1 ;RETURN TO ASSEM1. + PUSHJ P,GSYL + SKIPE SYM + MOVEM SYM,PRGNM + MOVE T,[440700,,STRSTO] +ATIT2: ILDB A,T ;GET CHAR FROM TITLE STRING + SOSG STRCNT + JRST ATIT3 ;CHAR IS SYLLABLE TERMINATOR +IFE ITSSW,[ + SKIPE CCLFLG + TRNN FF,FRPSS2 +] + PUSHJ P,TYO ;NOT TERMINATOR, TYPE OUT AND LOOP BACK + JRST ATIT2 + +ATIT3: CALL ATIT1 ;PRINT THE REST OF THIS LINE. + MOVE A,CONTRL + TRNE A,DECREL + TRNE FF,FRNPSS + CAIA + ETF [ASCIZ /TITLE follows 1PASS/] + MOVE A,TTYINS + ADD A,A.PASS ;SHOULD WE .INSRT TTY: THIS PASS (T SWITCH) + JUMPG A,CPOPJ +IFDEF GTYIPA,JRST GTYIPA ;GO PUSH TO TTY IF CAN, +IFNDEF GTYIPA,GOHALT ;WHY DID YOU SET TTYINS IF CAN'T? + +ATIT1: CAIE A,15 ;CR? + CAIN A,12 ;LF? +IFN ITSSW,JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR +.ELSE [ JRST [ SKIPE CCLFLG + TRNN FF,FRPSS2 + JRST CRR + RET] + SKIPE CCLFLG ;NEITHER OF THESE, PRINT CHAR. + TRNN FF,FRPSS2 ;ON DEC SYS, DON'T PRINT THE TITLE ON P2, OR AT ALL IF RUN BY CCL. +] + PUSHJ P,TYO +A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE + JRST ATIT1 + +;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG. +A.ERR: PUSH P,CASSM1 ;RETURN TO ASSEM1, + ERJ A.ERR1 ;AFTER NUMBERS AND USER'S STRING. + +A.FATAL:PUSH P,[GO9] ;.FATAL - CAUSE A FATAL ERROR. + ERJ A.ERR1 + +APRINT: NOVAL + HLRZS B ;B SAYS WHETHER PRINTX, PRINTC OR COMMENT. + JSP TM,ERMARK + CALL PASSPS + MOVE T,A +APRIN1: PUSHJ P,RCH + CAME A,T + JRST (B) ;GO TO APRIN1 FOR COMMENT, + JRST MACCR + +APRIN2: CAIE A,"! ;COME HERE FOR PRINTX +APRIN3: PUSHJ P,TYO ;HERE FOR PRINTC + JRST APRIN1 + +A.TYO: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A CHARACTER (AS NUMERIC ARG). + CALL TYOERR + JRST MACCR + +A.TYO6: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A WORD OF SIXBIT. + MOVE B,A + CALL SIXTYO + JRST MACCR + +;.BEGIN - START NEW BLOCK WITH NAME = ARG, OR LAST LABEL DEFINED. +A.BEGIN: NOVAL + SKIPE ASMOUT ;IF IN GROUPING, FLUSH IT & ERROR. + JSP LINK,CONFLM + PUSHJ P,GETSLD ;READ A NAME. + MOVE SYM,SYSYM ;NO ARG, USE NAME OF LAST LABEL. + MOVE A,SYM ;NAME TO USE FOR BLOCK. + MOVE B,BKLVL ;CURRENT LEVEL + 1 + HRLZI B,1(B) ;IS LEVEL OF NEW BLOCK. + HRR B,BKCUR ;ITS SUPERIOR IS CURRENT BLOCK. + MOVEI C,0 ;SEE IF AN ENTRY EXISTS FOR THIS BLOCK. + MOVE AA,A.PASS +A.BEG0: CAMN A,BKTAB(C) + CAME B,BKTAB+1(C) + JRST A.BEG1 ;THIS ENTRY ISN'T FOR BLOCK BEING ENTERED. + TDNE AA,BKTAB+2(C) ;FOUND: DEFINED IN THIS PASS? + ETSM [ASCIZ /Multiply defined BLOCK/] + JRST A.BEG2 ;NO, SAY IT'S DEFINED. + +A.BEG1: ADDI C,BKWPB ;LOOK THRU ALL ENTRIES. + CAMGE C,BKTABP + JRST A.BEG0 + CAIL C,BKTABS ;ALL ENTRIES USED => ERROR. + ETF ERRTMB + MOVEM A,BKTAB(C) ;ALLOCATE NEW ENTRY + MOVEM B,BKTAB+1(C) ;STORE NAME, LEVEL, SUPPRO. + MOVEI A,BKWPB(C) + MOVEM A,BKTABP ;POINTS TO 1ST UNUSED ENTRY. +A.BEG2: IORM AA,BKTAB+2(C) ;INDICATE BLOCK SEEN THIS PASS. + MOVEM C,BKCUR ;NEW BLOCK NOW CURRENT BLOCK, + AOS A,BKLVL ;ITS LEVEL NOW CURRENT LEVEL, + CAIL A,BKPDLS ;PUSH IT ON BLOCK PDL + ETF [ASCIZ /.BEGIN nesting too deep/] + MOVEM C,BKPDL(A) + JRST ASSEM1 + +ERRTMB: ASCIZ /Too many symbol blocks/ +ERRUMB: ASCIZ /Unmatched .BEGIN - .END/ + +;.END - POP CURRENT BLOCK. +A.END: NOVAL + SKIPE ASMOUT ;IN GROUPING => TERMINATE IT & ERROR. + JSP LINK,CONFLM + MOVE A,CDISP ;IF FOLLOWED BY WORD TERM, + TLNN A,DWRD ;CAUSE IT TO BE RE-READ + TLO FF,FLUNRD ;SO ARG WILL BE NULL. + PUSHJ P,GETSLD ;READ ARG. + JRST A.END0 ;NO ARG. + MOVE C,BKCUR ;ERROR UNLESS BLOCK BEING TERMINATED + MOVE A,BKTAB(C) ;HAS SAME NAME AS ARG. + EXCH A,SYM ;(MAKE SURE SYM NAME TYPED IS BLOCK'S NAME) + CAME A,SYM + ETSM ERRUMB ;ERROR, PRINT SYM (BLOCK'S NAME) +A.END0: MOVE C,BKCUR ;NOT OK TO END .MAIN BLOCK OR .INIT BLOCK. + CAIG C,BKWPB + ETA ERRUMB + HRRZ C,BKTAB+1(C) + MOVEM C,BKCUR ;POP INTO FATHER OF PREV. CURRENT BLOCK. + SOS BKLVL + JRST ASSEM1 + +;BKTAB: 3-WORD ENTRIES, 1 PER BLOCK, IN NO PARTICULAR ORDER. +;1ST WD HAS SQUOZE NAME OF BLOCK, FLAGS CLEAR. +;2ND WD HAS LEVEL,,BKTAB IDX OF CONTAINING BLOCK("FATHER", "SUPERIOR") +;3RD WD BIT 1.N ON => BLOCK ENTERED ON PASS N. +;SYMBOL TABLE OUTPUT RTN PUTS -2* IN 3RD WD. +;THE FIRST BKTAB ENTRY IS THAT OF THE OUTERMOST BLOCK (.INIT) +;IN WHICH INITIAL SYMS ARE DEFINED. +;THAT ENTRY'S 2ND AND 3RD WDS ARE 0. +;THE NEXT IS THAT OF THE MAIN BLOCK (.MAIN) IN WHICH +;ALL SYMBOLS ARE NORMALLY DEFINED (THAT IS, YOU ARE IN THAT BLOCK +;BEFORE YOU DO ANY .BEGIN'S). +;THAT ENTRY'S 2ND WD IS 1,, ; ITS 3RD, 0. + +;THE BKPDL IS A TABLE OF BLOCKS CURRENTLY ENTERED & NOT ENDED. +;BKPDL'S 1ST ENTRY IS FOR OUTERMOST BLOCK. +;LAST ENTRY IS BKPDL+@BKLVL, FOR CURRENT BLOCK. + +BKTABS==BKTABL*BKWPB + +VBLK +BLCODE [ +BKTAB: BLOCK 3 ;ENTRY FOR .INIT BLOCK. +PRGNM: BLOCK BKTABS-BKWPB ;PROGRAM NAME IS NAME OF MAIN BLOCK. +] +BKTABP: 0 ;IDX IN BKTAB OF 1ST UNUSED ENTRY. +BKPDL: BLOCK BKPDLS ;TABLE OF BLOCKS STARTED, NOT FINISHED. +BKLVL: 0 ;CURRENT BLOCK LEVEL, IDX OF LAST USED IN BKPDL. +BKCUR: 0 ;BKTAB IDX OF CURRENT BLOCK. +ESBK: 0 ;-1 OR BLOCK TO EVAL SYM. IN. +ESL1: 0 ;IN ES, LEVEL OF BLOCK OF BEST SYM SO FAR. +ESL2: 0 ;3RDWRD OF BEST SO FAR. +SADR: 0 ;SYM TAB IDX OF BEST SO FAR. +ESLAST: 0 ;RH IDX OF LAST DEF (EVEN IF NO GOOD) -1 IF NONE + ;SIGN NEG. IF LAST DEF SEEN BEFORE @ESXPUN +ESXPUN: -1 ;IF SEE EXPUNGED OR FREE ENTRY, PUT IDX HERE. +BKTAB1: BLOCK BKTABL ;USED BY SSYMD. +PBLK + +;.SYMTAB ARG ;SAY WANT AT LEAST ARG STE'S IN SYMTAB. +A.SYMTAB: NOVAL + PUSH P,[0] ;THIS WORD WILL BE SETOM'ED IF THERE IS REALLY ANY WORK NEEDED. + PUSHJ P,AGETFD ;GET DESIRED SYM TAB SIZE. + CAMG A,SYMLEN ;IF HAVE ENOGH ROOM ALREADY, + JRST A.SYM1 ;NO NEED TO RE-INIT. + CAILE A,SYMMAX ;IF WANTS MORE THAN MAXIMUM, ERROR. + ETF [ASCIZ/.SYMTAB 1st arg too big/] + MOVEM A,SYMLEN ;TELL INITS ABOUT NEW SIZE. + SETOM (P) +A.SYM1: CALL AGETFD ;READ DESIRED CONSTANTS TABLE SPACE ALLOCATION. + CAMG A,CONLEN ;IF TABLE ALREADY BUG ENOUGH, NOTHING TO DO. + JRST A.SYM2 + CAILE A,CONMAX + ETF [ASCIZ/.SYMTAB 2nd arg too big/] + MOVEM A,CONLEN ;ELSE REMEMBER IT AND SAY REALLOCATION NECESSARY. + SETOM (P) +A.SYM2: CALL AGETFD ;3RD ARG IS # WORDS PER SYMBOL - BUT ONLY 3 IS ALLOWED NOW. + JUMPE A,A.SYM3 ;EVENTUALLY 4 WILL GET 12-CHARACTER SYMBOLS. + CAIL A,MINWPS + CAILE A,MAXWPS + ETF [ASCIZ/.SYMTAB 3rd arg out of range/] + CAME A,WPSTE + SETOM (P) + MOVEM A,WPSTE +A.SYM3: REST A ;IS THERE ANYTHING THAT ACTUALLY NEEDS TO BE CHANGED? + JUMPE A,ASSEM1 ;IF NOT, NEVER GIVE ERROR - ELSE WOULD ALWAYS LOSE ON PASS 2. + MOVE B,PLIM + CAMN B,CONTBA ;IF THERE HAVE BEEN ANY LITERALS + SKIPE INICLB ;OR ANY MACROS, IRPS, REPEATS, ETC., THEN ... + ETF [ASCIZ/Too late to do .SYMTAB/] + MOVE CH1,MACTAD ;SET UP AC -> START OF INIT CODE + SUBI CH1,MACTBA ;SO IT CAN REFER TO ITSELF. + PUSHJ P,INITS(CH1) ;RE-INIT, SET SYMSIZ, SYMAOB, ETC. + PUSHJ P,MACINI ;INIT PTRS TO END OF MACTAB. + JRST ASSEM1 + +A.OP: PUSHJ P,A.OP1 ;.OP, + JRST VALRET ;RETURNS VALUE + +A.AOP: NOVAL + AOS (P) ;.AOP DOESN'T RETURN VALUE +A.OP1: PUSHJ P,AGETFD + PUSH P,A + PUSHJ P,AGETFD + PUSH P,A ;PDL NOW HAS FIELD 0 AND FIELD 1 + PUSHJ P,AGETFD + POP P,B ;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0 + EXCH A,B + POP P,T ;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2 + TLNN T,(0 17,) ;IF AC FIELD NOT PRESENT IN INSN, SUPPLY ONE. + TLO T,(0 A,) + TDNN T,[0 -1(17)] ;IF NO ADDR OR IDX FIELD IN INSTRUCTION, + HRRI T,B ;SUPPLY ONE. + SETOM A.ASKIP' ;.ASKIP WILL BE -1 IFF INSN SKIPPED, ELSE 0. + TLNE T,74000 ;AVOID EXECUTING OPCODE ZERO. + XCT T + SETZM A.ASKIP + MOVEM A,AVAL1' ;STORE C(AC) AS .AVAL1 + MOVEM B,AVAL2' ;STORE C(E) FOR .AVAL2 + POPJ P, ;RETURN TO WHATEVER + +AASCIZ: TDZA T,T +A.ASCII: MOVEI T,1 + MOVEM T,AASCF1 ;STORE TYPE + MOVE D,[440700,,T] + SETZM AASCFT + JRST AASC1 + +AASCII: SKIPA D,[440700,,T] +ASIXBI: MOVE D,[440600,,T] + SETZM AASCFT ;INDICATE NOT .DECTXT + SETOM AASCF1 ;INDICATE REGULAR (NOT ASCIZ) + JRST AASC1 + +A.DCTX: NOVAL + MOVE A,CONTRL + TRNN A,DECREL + ETA [ASCIZ /.DECTXT in non-DECREL assembly/] + CALL EBLK + SETZ B, + SETOM AASCFT + SETOM AASCF1 ;INDICATE ASCIZ-STYLE PADDING + MOVE D,[440700,,T] +AASC1: TLZE I,ILMWRD + JRST TEXT2 ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS + MOVEMM ASMDS1,ASMDSP + MOVEM SYM,DEFNPS ;REMEMBER LOCATION IN FILE OF PSEUDO + MOVEMM DEFNLN,CLNN ;IN CASE THE DELIMITER IS MISSING. + MOVEMM DEFNPN,CPGN +IFN TS, MOVEMM DEFNFI,INFFN1 + HLRZ T,B ;GET FILL CHARACTER + IMUL T,[REPEAT 5,[1_<.RPCNT*7>+]0] ;CONVERT TO ASCII FILL WORD SHIFTED -1 (IMUL SCREW) + LSH T,1 ;SHIFT TO PROPER POSITION (EXTRA IN CASE WANT TO FILL W/ HIGH BIT SET) + MOVEM T,AASEFW ;STORE AS FILL WORD, T NOW SET UP TO ACCUMULATE VALUE + CALL PASSPS + MOVEM A,TEXT4 ;STORE TERMINATOR +TEXT7: PUSHJ P,RCH +AASC8: CAMN A,TEXT4 + JRST AASC1A ;TERMINATOR + TLNN D,760000 + JRST TEXT6 ;WORD FULL +TEXT9: TLNE D,100 ;CHECK BOTTOM BIT OF SIZE FIELD OF BP + JRST AASC2 ;SET => NOT SIXBIT + SUBI A,40 + CAILE A,77 + SUBI A,40 ;CONVERT LOWER CASE ASCII TO UPPER CASE + JUMPGE A,.+2 + ETR ERRN6B +AASC3: IDPB A,D + TRO I,IRSYL + JRST TEXT7 + +ERRN6B: ASCIZ /Character not SIXBIT/ + +;TERMINATOR + +AASC1A: TLNN D,760000 ;SKIP UNLESS END OF WORD + SKIPGE AASCF1 ;SKIP UNLESS REGULAR + JRST [ MOVE CH1,ASMDS1 ;REGULAR OR NOT END OF WORD + MOVEM CH1,ASMDSP ;RESTORE ASMDSP AS SAVED AT START OF PSEUDO. + JRST TEXTX] + MOVEI CH1,1 ;END OF WORD AND NOT REGULAR + JRST AASC1B ;EXTRA 0 NEED FOR Z FLAVOR + +AASC2: CAIN A,"! + SKIPG AASCF1 + JRST AASC3 ;NOT .ASCII OR NOT EXCL + PUSH P,T ;READ FIELD + PUSH P,TEXT4 + PUSH P,D + PUSH P,SYM + PUSH P,ASMOUT ;PREVENT CLOSEBRACKETS FROM TRYING TO TAKE EFFECT. + MOVEIM ASMOUT,4 ;NOTE THIS LOSES IF CALL PSEUDO THAT RETURNS TO ASSEM1. + MOVEI SYM,[SETOM ASUDS1] ;NOW TO SET UP UNDEFINED SYM CONDITION + TLNE FF,FLPPSS + MOVE SYM,[SQUOZE 0,.ASCII] ;PUNCHING PASS, UNDEFINED => REAL ERROR + CLEARM ASUDS1 + PUSHJ P,AGETFD + ;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2 + ;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS, + ;CAUSING LOSSAGE IF NOT IN CONSTANT + REST ASMOUT + POP P,SYM + POP P,D + POP P,TEXT4 + POP P,T + SKIPGE ASUDS1 + MOVNI A,1 ;HAD UNDEFINED SYMS SO ASSUME MAX + SKIPGE ASUDS1 + TLO I,ILNOPT ;ALSO DON'T OPTIMIZE OVER IN CONSTANT + MOVE CH1,[440700,,AASBF] + MOVEM CH1,ASBP1 + MOVEM CH1,ASBP2 + PUSH P,[AASC5] + MOVE CH1,A +AASC6: LSHC CH1,-35. + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,AASC6 + HLRZ A,(P) + ADDI A,"0 + IDPB A,ASBP1 + POPJ P, + +AASC5: MOVEI A,0 + IDPB A,ASBP1 ;END .ASCII NUMBER WITH ZERO +AASC8A: TLNN D,760000 + JRST AASC7 ;END OF WORD + ILDB A,ASBP2 + JUMPE A,AASC9 + IDPB A,D + JRST AASC8A + +AASC9: TLO FF,FLUNRD + JRST TEXT7 + +AASC7: TDZA CH1,CH1 +TEXT6: MOVNI CH1,1 ;WORD FULL +AASC1B: MOVEM CH1,AASCF2 + CLEARM CDISP + MOVEM A,TEXT8 + MOVE A,T + SKIPE AASCFT ;FOR .DECTXT, OUTPUT WORD INSTEAD OF RETURNING IT. + JRST [ CALL PPB + MOVE D,[440700,,T] + JRST TEXT2A] + TLO I,ILMWRD ;ELSE ARRANGE TO BE CALLED BACK TO RETURN NEXT WORD. + MOVEI T,ASSEM2 + MOVEM T,ASMDSP + SKIPLE CONSML ;IF NOT MULTI-LINE MODE, + JRST CLBPOP + MOVE T,ASMOUT ;IF THE TEXT IS IN <>'S OR ()'S, + HRRZ T,ASMOT2(T) + CAIE T,LSSTHA + JRST CLBPOP + CALL IGTXT ;USE ONLY THE FIRST WORD. + SKIPE CONSML ;AND ERROR IF IN ERROR MODE. + ETR [ASCIZ/Multi-word text pseudo in brackets/] + JRST CLBPOP + + ;GET NEXT WORD + +TEXT2: TRO I,IRFLD +TEXT2A: MOVE T,AASEFW ;INITIALIZE T TO FILL WORD + MOVE A,TEXT8 ;GET NEXT CHAR (ALREADY READ BY RCH) + SKIPGE B,AASCF2 + JRST TEXT9 ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN + JUMPE B,AASC8A +TEXTX: SETZM DEFNPS + SETOM TEXT4 + SKIPN AASCFT + JRST TEXT5 ;RETURNING FROM ASCIZ AFTER PUTTING THE TRAILING ZERO OUT. + MOVE A,T + CALL PPB ;FOR .DECTXT, OUTPUT THE FILL WORD INSTEAD. + JRST MACCR + +VBLK + +AASCF1: 0 ;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ +AASCF2: 0 ;MULTIPLE WORD RETURN FLAG -1 REG 0 FINISH ! HACK 1 OUTPUT FILL WORD FOR Z +AASCFT: 0 ;0 REGULAR, -1 => .DECTXT (OUTPUT WORDS TO FILE INSTEAD OF RETURNING THEM) +TEXT4: -1 ;DELIMITER, OR -1 IF NOT INSIDE A TEXT PSEUDO. +TEXT8: 0 ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS +ASBP1: 0 ;IDPB TO AASBF ON .ASCII FIELD +ASBP2: 0 ;ILDB FROM AASBF " +AASBF: BLOCK 8 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY +ASUDS1: 0 ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1 +AASEFW: 0 ;FILL WORD + +PBLK + +IGTXT: TLNN I,ILMWRD + RET + PUSH P,A ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD + SKIPLE AASCF2 ;DETECT SCREW CASE: AFTER ASCIZ OF 5 CHARS, DELIMITER IS + JRST IGTXT1 ;ALREADY GOBBLED, BUT SOME OF THE ASCIZ REMAINS. + PUSHJ P,RCH + CAME A,TEXT4 + JRST .-2 +IGTXT1: TLZ I,ILMWRD + MOVEMM ASMDSP,ASMDS1 + SETZM DEFNPS + SETOM TEXT4 + JRST POPAJ + +;".ASCVL /X" RETURNS THE ASCII VALUE OF "X". NOTE THE DELIMITER IS NOT REPEATED +;AND SERVES ONLY TO ALLOW SPACES TO BE IGNORED WHILE WINNING IF X IS A SPACE. +A.ASCV: CALL PASSPS ;SKIP SPACES TO REACH THE DELIMITER. + CALL RCH ;READ THE CHAR AFTER THE DELIMITER + MOVE T,A + JRST TEXT5 ;AND RETURN ITS ASCII VALUE. + +ASQOZ: HLLM B,(P) ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ . + PUSH P,SYM + PUSHJ P,AGETFD + LSH A,36 + PUSH P,A + PUSHJ P,GETSLD ;GET SYM, SAVE DELIMITER FOR REINPUT + CALL NONAME + REST A + LDB B,[4000,,SYM] ;GET JUST THE SQUOZE. + SKIPGE -1(P) + PUSHJ P,ASQOZR ;FOR .RSQZ, RIGHT-JUSTIFY IT. + SUB P,[1,,1] + ADD A,B + JRST CLBPOP + +;RIGHT-JUSTIFY THE SQUOZE WORD IN B. +ASQOZR: MOVE SYM,B + IDIVI SYM,50 + JUMPN LINK,CPOPJ ;LAST ISN'T BLANK, DONE. + MOVE B,SYM ;ELSE REPLACE BY WHAT'S SHIFTED RIGHT 1 CHAR. + JRST ASQOZR + + ;COMMON PSEUDO ROUTINE TO RETURN MIDAS INTERNAL QUANTITY + ;ADR IN LH(B)) AS VALUE (EG. .RPCNT, .FNAM1, .AVAL2, ETC. + ;INTSYMS MAY APPEAR TO LEFT OF = + +INTSYM: MOVE A,B ;GET ADR IN LH(A) + JRA A,CLBPOP ;RETURN IT + + ;.YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B) + +STGWS: HLRES B ;.NSTGW INCREMENTS STGSW, .YSTGW DECREMENTS. + ADDB B,STGSW + SKIPGE B ;BUT DON'T DECREMENT PAST 0. + SETZM STGSW + JRST MACCR ;STORAGE WORDS ARE ALLOWED IF STGSW IS ZERO. + + ;.TYPE + +A.TYPE: PUSH P,SYM + PUSH P,SYM + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + SUB P,[2,,2] + TRNN I,IRLET ;IF SYLLABLE IS A NUMBER, + JRST [ SETO A, ;RETURN -1. + JRST CLBPOP] + PUSHJ P,ES ;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A + MOVEI A,17 ;DIDN'T SKIP, RETURN 17 => UNSEEN +IFN CREFSW,XCT CRFINU + JRST CLBPOP + +NONAME: MOVE SYM,-2(P) + ETSM [ASCIZ /No arg/] + SETZ SYM, + POPJ P, + + ;.FORMAT + +A.FORMAT: PUSHJ P,AGETFD ;GET FIRST FIELD (FORMAT #) + MOVE B,CDISP ;WORD TERMINATOR ENDED 1ST ARG => + TLNN B,DWRD + JRST A.FOR1 ;RETURN CURRENT SPEC FOR THAT FORMAT. + PUSH P,A + PUSHJ P,AGETFD ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER) + POP P,B + MOVEM A,FORTAB-10(B) + JRST ASSEM1 + +A.FOR1: MOVE A,FORTAB-10(A) + JRST CLBPOP + +A.BYTE: NOVAL + CLEARM NBYTS ;# BYTES ASSEMBLED + CLEARM BYTMT ;TOTAL ACTIVE BYTES IN TABLE + MOVE A,[440700,,BYBYT] ;POINTER TO NEW TABLE + MOVEM A,BYTMP +A.BY1: PUSHJ P,AGETFD ;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE + MOVE C,ISAV + TRNN C,IRFLD + JRST A.BY2 ;NO FIELD + MOVM B,A + SKIPGE A + TRO B,100 + IDPB B,BYTMP + AOS BYTMT +A.BY2: TLNE CH1,DWRD ;CDISP LEFT IN CH1 BY AGETFD + JRST A.BY1 ;NOT WORD TERMINATOR + SKIPN BYTMT ;WORD TERMINATOR, ANY FIELDS? + JRST A.BY3 ;NO, DO .WALGN AND RESET TO WORD MODE + SETOM BYTM ;ENTERING BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETOM BYTM1 + PUSHJ P,BYSET + MOVE A,GLSPAS + MOVEM A,GLSP1 + JRST ASSEM1 + + ;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD + +BYSET: CLEARM BYTMC ;COUNT OF BYTES PROCESSED THIS TABLE SCAN + MOVE A,[440700,,BYBYT] ;POINTER TO DESCRIPTOR TABLE + MOVEM A,BYTMP + ILDB A,BYTMP ;FIRST DESCRIPTOR BYTE + AOS BYTMC + DPB A,[300600,,BYTWP] ;DEPOSIT AS FIRST BYTE SIZE + POPJ P, + +A.BY3: CLEARM BYTM ;NO LONGER IN BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETZM BYTM1 + JRST A.WAL1 + +A.WALGN: NOVAL +A.WAL1: LDB A,[360600,,BYTWP] + CAIN A,44 + JRST ASSEM1 ;ALREADY AT BEGINNING OF WORD + MOVEI A,44 + DPB A,[360600,,BYTWP] ;MAKE IT POINT TO BEGINNING OF WORD + PUSHJ P,BYSET + CLEARM T1 + JRST PBY1 + +BYTIN1: CLEARM BYTMC + MOVE A,[440700,,BYBYT] + MOVEM A,BYTMP +BYTINC: AOS A,BYTMC + CAMLE A,BYTMT + JRST BYTIN1 + ILDB A,BYTMP + DPB A,[300600,,BYTWP] + MOVEM A,T1 + HLLZ A,BYTWP + IBP A + TRNN A,-1 + JRST BYTINR + ;NEXT BYTE GOES IN NEXT WORD +PBY1: MOVE P,ASSEMP ;PCONS NEEDS THIS. + MOVEI A,WRD-1 + PUSH A,BYTW ;INTO WRD, + PUSH A,BYTRLC ;INTO WRDRLC + CLEARM BYTW + SETZM BYTRLC + MOVEI A,44 + DPB A,[360600,,BYTWP] + MOVE AA,ASMOUT + JRST @ASMOT4(AA) ;TO PBY4 OR PBY5 OR PBY3 + +PBY4: SKIPE STGSW + ETR ERRSWD + PUSHJ P,PWRD ;NOT IN CONST., OUTPUT WORD. + AOSA CLOC +PBY3: JSP T,PCONS ;OUTPUT INTO CONST. +PBY5: MOVE A,GLSPAS + MOVEM A,GLSP1 +BYTINR: MOVE A,T1 ;CURRENT BYTE SIZE + TRNN A,100 + JRST @ASMDSP + SETZB A,B ;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE + JRST PBY2 + +PBYTE: AOS NBYTS +PBY2: MOVEI AA,WRD-1 + PUSH AA,BYTW ;INTO WRD + PUSH AA,BYTRLC ;INTO WRDRLC + IBP BYTWP + LDB T,[301400,,BYTWP] + PUSHJ P,INTFLD + POP AA,BYTRLC ;WRDRLC + POP AA,BYTW ;WRD + JRST BYTINC + + ;VARIABLES FOR .BYTE, .BYTC, .WALGN + +VBLK +BYTM: 0 ;-1 FOR IN BYTE MODE, LAMBDA BOUND BY <'S, ('S, AND ['S ;] +BYTMC: 0 ;COUNT CORRESP WITH BYTMP +BYTMP: 0 ;POINTER TO BYTE DESC TABLE +BYTMT: 0 ;TOTAL ACTIVE BYTES IN TABLE +BYTM1: 0 ;GLOBAL VALUE OF BYTM - WHAT IT WAS OUTSIDE THE OUTERMOST BRACKET + +;FORMAT OF BYTE DESC TABLE +;SEVEN BIT BYTES +;1.7=0 ASSEMBLE =1 BLANK +;1.1 - 1.6 NUMBER OF BITS + +IFNDEF LBYBYT,LBYBYT==5 ;LENGTH OF BYBYT +BLCODE [BYBYT: BLOCK LBYBYT] ;BYTE DESC TABLE, 7 BITS PER DESC + +BYTWP: 440000,,BYTW ;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE +BYTW: 0 ;WORD BEING ASSEMBLED IN BYTE MODE +BYTRLC: 0 ;RELOC OF BYTW. +NBYTS: 0 ;NUMBER BYTES ASSEMBLED (FOR .BYTC) +BYTMCL==.-BYTMC +PBLK + +;;MACRO PROCESSOR +IFN MACSW,[ + ;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A + +REDINC: MOVE CH1,A + IDIVI CH1,4 + LDB B,PTAB(CH2) + AOJA A,CPOPJ + +VBLK ;THIS STUFF ALL RELOCATED WHEN MACTAB ADDR CHANGED. +PTAB: (341000+CH1)MACTBA ;BYTE TABLE + (241000+CH1)MACTBA + (141000+CH1)MACTBA + (41000+CH1)MACTBA + (341000+CH1)MACTBA+1 + + ;IN FOLLOWING MACROS, B = -1, 0, OR +1 (+ SIGN MUST BE GIVEN) + ;0 => BP SAME AS CHAR ADR, -1 => BP FOR ILDB, 1 => BP ONE AHEAD + + ;CHAR ADR IN A, RETURNS BP IN A, CLOBBERS A+1 + +DEFINE BCOMP A,B/ + IDIVI ,4 + ADD ,(+1)BCOMPT!B +TERMIN + +STOPPT: 041000,,MACTBA-1 +BCOMPT: 341000,,MACTBA + 241000,,MACTBA +BCOMPU: 141000,,MACTBA + 041000,,MACTBA + 341000,,MACTBA+1 + +;BP IN A RETURN CHAR ADR IN A, CLOBBERS A-1 (YES, A MINUS 1) +;2ND ARG IS SUBTRACTED - -1 GIVES ADDR OF THE NEXT CHAR. +DEFINE CCOMP A,B/ + MOVEI -1,0 + ASHC -1,2 + SUB ,(-1)CCOMPT!B +TERMIN + + ;BP IN A RETURN CHAR ADR IN A+1, CLOBBERS A + +DEFINE CCOMP1 A,B/ + MULI ,4 + SUB +1,(A)CCOMPT!B +TERMIN + +;FROM HERE THRU CCOMPE SET BY MACINI. +CCOMPB: 0 ;4*<41000,,MACTBA>-4 +CCOMPT: REPEAT 5,0 ;4*<41000,,MACTBA>+.RPCNT-3 +CCOMPE::PBLK + + ;BP IN A, DECREMENT IT + +DEFINE DBPM A + ADD A,[100000,,] + SKIPGE A + SUB A,[400000,,1] +TERMIN + +;SET UP CPTR FROM CHAR ADR IN A + +ACPTRS: MOVEI CH1,(A) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE COMPUTED CPTR + POPJ P, + +AFCOMP: HRRZM A,FREEPT ;ENTRY TO STORE C(A) INTO FREEPT +FCOMP: MOVE CH1,FREEPT ;COMPUTE FREPTB FROM FREEPT + BCOMP CH1,-1 + MOVEM CH1,FREPTB ;STORE CALCULATED BYTE POINTER + POPJ P, + +STPWR: MOVEI A,375 + JRST PUTREL + +VBLK +PUT377: MOVEI A,377 +PUTREL: JRST PUTRE1 ;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE + AOS A,FREEPT ;CLOBBERS ONLY A. + AOS PUTCNT + CAMGE A,MACHI + POPJ P, + JRST GCA +PBLK +PUTRE1: PUSH P,[IDPB A,FREPTB] + POP P,PUTREL ;COME HERE ONLY ON 1ST CALL TO PUTREL. + SETOM INICLB ;HAVE WRITTEN IN MACRO TAB & CLOBBERED INIT. + JRST PUTREL ;NOW GO BACK AND REALLY WRITE CHAR. + +;200 BIT SET ON CHAR READ FROM MACTAB, PROCESS SPECIAL CONDITION +;CLOBBERS A,CH1,CH2. + +MACTRM: CAIN A,176 ;376? + JRST RCHTRA ;376 => IGNORE, CHARACTER USED TO CLOBBER UNDESIRED CHARACTERS IN MACRO STORAGE + PUSH P,B ;SAVE B + CAIE A,177 + CAIN A,175 + JRST MRCH1 ;377, 375 => STOP + ADD A,BBASE ;DUMMY, RELOCATE TO POINT TO DUMMY TABLE + MOVEI B,RCHSAV ;RETURN TO RCHSAV ON END OF DUMMY + PUSHJ P,PUSHEM ;SAVE CURRENT STATUS + HRRZ A,(A) ;GET CHAR ADR OF DUMMY + BCOMP A,-1 ;CONVERT TO BYTE POINTER + MOVEM A,CPTR ;STORE AS NEW CPTR + MOVE A,TOPP + MOVEM A,BBASE +RCHTRB: POP P,B +RCHTRA: POP P,A ;POP RETURN + TLZN FF,FLUNRD ;IF NO CHAR TO RE-READ, JUST RETURN BACK TO THE ILDB A,UREDP. + JRST -3(A) + ANDI A,-1 ;IF A CHAR TO RE-READ, IF CALLED FROM RREOF, WE CAN RETURN TO RRU + CAIN A,RREOF+1 + JRST RRU + PUSH P,A ;OTHERWISE, CALL RCH TO RE-READ THAT CHAR, AND RETURN IT FROM + JRST RCH1 ;THE CURRENT ATTEMPT TO READ A CHAR. + +MRCH1: MOVE B,MACP +BPOPJ: POPJ B, ;RETURN AT END OF STRING EXPANSION + +;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR + +RCHMAC: TLO FF,FLMAC ;SET FLAG + JSP A,CPOPJ +RCHMC0: REPEAT 2,[ ;GETCHR, RR1 + ILDB A,CPTR ;GET CHAR + TRZE A,200 ;200 BIT... + PUSHJ P,MACTRM ;=> SPECIAL, PROCESS +] + GOHALT +IFN .-RCHPSN-RCHMC0,.ERR RCHMC0 LOSES. + ILDB A,CPTR ;SEMIC + TRZE A,200 + PUSHJ P,MACTRM + CAIE A,15 + JRST SEMIC ;NOT YET + JRST SEMICR ;YET + + ;PUSH INPUT STATUS IN FAVOR OF MACRO + ;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER) + ;SEE ALSO PMACP + +PUSHEM: PUSH P,A + PUSH P,F + MOVE F,MACP ;GET MACRO PDL POINTER + MOVE CH1,CPTR + CCOMP1 CH1,-1 ;CONVERT TO CHARACTER ADDRESS + HRL CH2,BBASE + PUSH F,CH2 ;PUSH BBASE,,CPTR + MOVEI A,1 ;=> EXPAND MACRO + PUSHJ P,PSHLMB ;SAVE LIMBO1 STATUS AND RETURN + JRST PSHM1 + + ;UNDO A PUSHEM + ;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT) + +POPEM: PUSH P,A + PUSH P,F + MOVE F,MACP + PUSHJ P,POPLMB ;RESTORE LIMBO1 STATUS + POP F,B ;BBASE,,CPTR + MOVEI CH1,(B) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE NEW CPTR +PSHM1: MOVEM F,MACP ;STORE BACK MACRO PDL POINTER +POPFAJ: POP P,F +POPAJ: POP P,A + POPJ P, + +PMACP: MOVE B,MACP ;POP MACRO PDL + HRRZ A,(B) + SUB B,[1,,1] +IFN RCHASW,CAIE A,A.TYM8 + CAIN A,AIRR + JRST A.GO6 ;IRP OR .TTYMAC + CAIN A,REPT1 + JRST A.GO4 ;REPEAT + CAIE A,RCHSV1 ;MACRO + CAIN A,RCHSAV ;ARG + JRST A.GO6 + GOHALT ;DON'T HAVE RETURN, + JRST A.GO6 ;BUT TRY A.GO6 LIKE EVERYTHING BUT REPEAT + +A.GO4: HLLZS -1(B) ;REPEAT, CLEAR OUT COUNT REMAINING +A.GO6: TRO FF,FRMRGO ;EVERYTHING ELSE, SET FLAG TO QUIT + JRST (A) + + ;4.9(B) => .STOP ELSE .ISTOP + +A.STOP: HRRZ A,MACP + JUMPL B,A.STP1 + HRRZ B,(A) ;.ISTOP + CAIN B,REPT1 + HLLZS -2(A) ;REPEAT, STOP ALL INTERATIONS + CAIN B,AIRR + HRRZS -1(A) ;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE +A.STP1: MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP + JRST POPJ1 + +A.QOTE: JFCL +ATERMI: ETSM [ASCIZ/Not in macro/] + JRST MACCR ;MAYBE FLUSH MESSAGE IF PEOPLE HAVE PROBLEMS + +;PDL STRUCTURE FOR REPEAT +;TWO TWO WORD ENTRIES +;BBASE,,CPTR +;LIMBO1 STATUS,,# TIMES LEFT +;OLD .RPCNT,,BEG OF BODY +;GARBAGE,,REPT1 + +AREPEAT: PUSHJ P,AGETFD + JUMPLE A,COND5 ;NO REPEAT PLAY LIKE STRING COND FALSE + PUSH P,A + MOVE A,FREEPT + MOVEM A,PRREPT ;CHAR ADR BEGINNING OF REPEAT + MOVEI A,373 ;CHECK CHAR FOR REPEAT + PUSHJ P,PUTREL ;STORE AS FIRST CHR OF BODY + JSP D,RARL1 + CAIA + CALL RARGCP ;READ THE ARG & COPY INTO MACRO STORAGE. + MOVEI A,^M ;IF THE ARG WASN'T BRACKETED, + TLNE FF,FLUNRD + CALL PUTREL ;INCLUDE THE TERMINATING CR. +SWRET1: PUSHJ P,STPWR ;ALSO RETURN FROM STRING WRITE (.F .I) + POP P,B ;# TIMES TO GO THROUGH + PUSHJ P,PUSHEM + MOVE B,MACP ;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY + MOVNI T,1 + EXCH T,CRPTCT ;GET OLD .RPCNT, INITIALIZE NEW ONE TO -1 +CREPT1: SETZI TT,REPT1 + EXCH TT,PRREPT ;GET LOC BEGINNING OF BODY, CLEAR OUT PRREPT, DON'T NEED IT ANYMORE + HRL TT,T + PUSH B,TT ;SAVE OLD .RPCNT,,ADDRESS OF BODY. + PUSH B,CREPT1 ;PUSH CRUD,,REPT1 FOR RETURN + MOVEM B,MACP ;STORE BACK UPDATED MACRO POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE IMMEDIATE CYCLE + JRST MACCR + +IFN .I.FSW,[ ;CODING FOR .I, .F + +SWINI: MOVE A,FREEPT ;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1 + MOVEM A,PRREPT + MOVEI A,373 + JRST PUTREL + +SWRET: PUSH P,[1] ;REPEAT COUNT + JRST SWRET1 + +SWFLS: MOVE A,PRREPT ;FLUSH RETURN + PUSHJ P,AFCOMP + JRST MACCR +] + +;RECYCLE AROUND REPEAT + +REPT1: PUSH P,A + PUSH P,C + HRRZ A,(B) ;CHAR ADR BEG BODY + PUSHJ P,REDINC + CAIE B,373 + GOHALT ;FIRST CHAR OF REPEAT BODY NOT 373 + HRRZ C,MACP + HRRZ B,-2(C) ;# TIMES LEFT + SOJL B,REPT2 ;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH + AOS CRPTCT + PUSHJ P,ACPTRS ;SET UP CPTR (CHAR ADR IN A) + HRRM B,-2(C) ;STORE UPDATED COUNTDOWN +REPT3: POP P,C + POP P,A + JRST REPT6 + +REPT2: SOS A ;MOVE BACK TO BEG OF REPEAT + ;(IN CASE GETS STORED INTO FREEPT) + MOVE CH2,CPTR + CCOMP CH2,-1 ;CONVERT TO CHARACTER ADDRESS + CAMN CH2,FREEPT + PUSHJ P,AFCOMP + MOVE A,[-3,,-2] + ADDB A,MACP + HLRZ A,1(A) + MOVEM A,CRPTCT + PUSHJ P,POPEM + JRST REPT3 + +;STRING CONDITIONALS (IFSE, IFSN) + +SCOND: MOVE A,FREEPT + MOVEM A,PRSCND + MOVEM A,PRSCN1 + PUSH P,SYM + HRRI B,SCONDF + PUSH P,B ;REMEMBER TEST INSTRUCTION. + SETOB C,SCONDF + JSP D,RARG ;COPY THE 1ST OF THE 2 STRINGS + CAIA + CALL RARGCP ;INTO MACRO STORAGE, FOLLOWED BY 375. + CALL STPWR + JSP D,RARG ;THEN START READING THE 2ND ARG, + JRST SCOND3 ;GO TO SCOND3 WHEN REACH END OF 2ND ARG. + JSP D,RARGCH(T) ;READ NEXT CHAR OF 2ND ARG, + JRST SCOND3 + EXCH A,PRSCND + PUSHJ P,REDINC ;RE-FETCH NEXT CHAR OF 1ST ARG + EXCH A,PRSCND + CAMN B,A ;COMPARE CHARACTERS + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CAIL A,"A+40 + CAILE A,"Z+40 ;NOT EQUAL => CONVERT BOTH TO UPPER CASE. + CAIA + SUBI A,40 + CAIL B,"A+40 + CAILE B,"Z+40 + CAIA + SUBI B,40 + CAMN B,A ;ARE THEY SAME EXCEPT FOR CASE? + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CLEARM SCONDF ;STRINGS DIFFER + CALL RARFLS ;IGNORE REMAINDER OF 2ND ARG. +SCOND3: CLEARB A,C ;END OF (SECOND) STRING ARG ENCOUNTERED + EXCH C,PRSCN1 + MOVEM C,FREEPT + PUSHJ P,FCOMP + EXCH A,PRSCND + PUSHJ P,REDINC + CAIE B,375 + CLEARM SCONDF + REST B + REST SYM + XCT B ;DO THE TEST. + JRST COND4 + JRST COND2 + +VBLK +BLCODE [DMYDEF: BLOCK DMDEFL] ;TABLE OF DUMMY NAMES FOR THING BEING DEFINED +DMYTOP: DMYDEF ;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD + ;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP +DMYBOT: DMYDEF ;-> 1ST DMYDEF WD USED AT THIS LEVEL. + ;RIGHT NOW, ALWAYS -> DMYDEF SINCE CAN'T HAVE DEFINITION + ;WITHIN A DEFINITION YET. + +PBLK + +PDEF: PUSHJ P,GSYL ;READ IN SYL + CAIE T,", ;IF DELIMITING CHR NOT , + JUMPE SYM,CPOPJ ;AND SYM NULL, RETURN +PDEF1: MOVEM SYM,@DMYTOP ;STORE SYM + AOS D,DMYTOP ;INCR PNTR + CAIL D,DMYDEF+DMDEFL ;CHECK FOR TABLE SIZE EXCEEDED + ETF [ASCIZ/Too many dummies in DEFINE or IRP/] + POPJ P, + +VBLK +BLCODE [DSTG: BLOCK DSSIZ] ;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION +RDWRDP: DSTG ;POINTER TO DSTG, POINTS TO FREE WORD + ;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN + ;BE EXPANDED DURING FIELD READ FOR DUMMY +PBLK + +ADDTR1: CLEARM PUTCNT +ADDTRN: MOVE A,FREEPT +ADDTR2: MOVEM A,@RDWRDP + AOS A,RDWRDP + CAIL A,DSTG+DSSIZ + ETF [ASCIZ/Too many dummies in all macros & IRPs being expanded/] + RET + +VBLK +BLCODE [DMYAGT: BLOCK DMYAGL] ;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED + ;DMYAGT TRACKS WITH THE MACRO PDL; + ;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN +BBASE: DMYAGT ;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED) + ;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY +TOPP: DMYAGT ;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER +PBLK + + ;ACTIVATE DUMMYS ON TOP OF DSTG TABLE + ;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE + +DMYTRN: MOVE B,TOPP + MOVEM B,BBASE + PUSH P,A +DMYTR2: CAML A,RDWRDP + JRST DMYTR1 + MOVE B,(A) + MOVEM B,@TOPP + AOS B,TOPP + CAIL B,DMYAGT+DMYAGL + ETF [ASCIZ /Too many dummy args active/] + AOJA A,DMYTR2 +DMYTR1: POP P,RDWRDP + POPJ P, + +;THE MACRO TABLE IS FILLED MAINLY WITH 8-BIT BYTES. +;THE FIRST WORD'S ADDR IS IN MACTAD; THE LAST+1'S IN MACTND. +;THE CHARACTER NUMBER OF THE LAST+1ST CHAR IS IN MACHI. +;MACHIB IS BP. TO HIGHEST BYTE OK TO FILL (LAST IN C(MACTND)-1) + +;IF A BYTE IN THE TABLE HAS ITS HIGH BIT OFF, IT IS AN ASCII CHARACTER. +;OTHERWISE, IT IS SPECIAL. IF THE 100 BIT IS OFF IT MEANS +;SUBSTITUTE A MACRO DUMMY ARG WHEN READ; THE CHAR IS THE NUMBER OF THE ARG+200 . + +;377 AND 375 ARE STOP CODES, CAUSING A POP OUT OF THE CURRENT STRING. +;GC CONSIDERS THE CHAR. AFTER A 375 TO START A NEW STRING. + +;376 IS IGNORED WHEN READ; USED TO CLOBBER UNWANTED CHARACTERS IN STRINHGS. + +;374 STARTS EVERY MACRO-DEFINITION. +;373 STARTS THE BODY OF A REPEAT. + +;370 STARTS A WORD STRING: +;THE WORD AFTER THAT WHICH CONTAINS THE 370 +; HAS THE LENGTH IN WORDS OF THE STRING IN ITS LH, +; IN ITS RH, THE ADDRESS OF WD WHICH POINTS BACK TO THIS ONE. +; THEN FOLLOW RANDOM WDS HOLDING ANYTHING AT ALL. +; GC WILL MAKE SURE IT STAYS ON WD BOUNDARY. +; THE LENGTH INCLUDES THE WD HOLDING THE LENGTH. +; IF THE RH OF 1ST WD HAS 0, GC WILL FLUSH THE STRING + +STRTYP: PUSHJ P,REDINC ;DEBUGGING AID ONLY + EXCH A,B + TRZE A,200 + JRST STRTP1 +STRTP2: PUSHJ P,TYO ;NORMAL CHAR, JUST TYPE OUT + MOVE A,B + JRST STRTYP + +STRTP1: PUSH P,A + MOVEI A,"* ;SPECIAL CHAR, TYPE * + PUSHJ P,TYO + POP P,A + TRNE A,100 + JRST STRTP3 ;CONTROL CHAR + ADDI A,260 ;DUMMY, CONVERT TO # + JRST STRTP2 ;TYPE OUT (SINGLE DIGIT) NUMBER + +STRTP3: CAIN A,175 + SKIPA A,C% ;STOP, TYPE % + MOVEI A,"/ ;SOMETHING ELSE, TYPE / + JRST STRTP2 + + + ;.GSSET, SET GENERATED SYM COUNTER + +A.GSSET: CALL AGETFD + MOVEM A,GENSM + JRST ASSEM1 + +;GSYL-LIKE ROUTINE, READ A SYL FOR WRQOTE + +WRQRR: PUSHJ P,RCH ;GET CHAR (MAYBE WANT THIS TO BE FASTER YET) + IDPB A,FREPTB ;DEPOSIT IN MACRO TABLE + CAMN F,FREPTB ;WAS THIS LAST CHAR IN TABLE? + JRST WRQRGC ;YES, NEED GARBAGE COLLECTION +WRQRR2: XCT GDTAB(A) ;DISPATCH ON CHAR + JFCL ;(MAYBE SKIPS) + SOJGE D,WRQRR ;LOOP FOR FIRST SEVEN CHARS + HRRI D,0 + JRST WRQRR + + ;HERE FROM WRQRR WHEN NEED GARBAGE COLLECTION OF MACRO TABLE + +WRQRGC: MOVEM C,WRQTBP ;PUT POINTER TO BEGINNING OF SYL WHERE IT WILL BE GC'D + MOVE A,MACHI + PUSHJ P,GCA ;GARBAGE COLLECT + MOVE F,MACHIB ;RESET F TO POINT TO NEW LAST CHAR IN MACTAB + MOVEI C,0 + EXCH C,WRQTBP ;GET BACK POINTER TO CHAR BEFORE SYL + MOVE A,LIMBO1 ;RETRIEVE LAST CHAR READ + JRST WRQRR2 ;LOOP BACK, PROCESS CHAR + + ;HERE FROM WRQOTE IF .QUOTE SEEN + ;.QUOTE TAKES ARG LIKE ASCII, PRINTC, ETC. + +A.QOT1: MOVE A,WRQBEG(P) ;GET BACK BP TO CHAR BEFORE .QUOTE + PUSHJ P,A.QOTS ;SET UP FREEPT AND FREPTB PROPERLY + MOVE A,LIMBO1 ;NOW GET CHAR AFTER .QUOTE + CAIE A,^I + CAIN A,40 ;COMPARE WITH SPACE + PUSHJ P,RCH ;SPACE, GOBBLE NEXT CHAR FOR DELIMITER, ELSE THIS ONE + MOVEM A,A.QOT2 ;STORE AS TERMINATOR OF STRING +A.QOT3: PUSHJ P,RCH ;GET CHAR TO QUOTE + CAMN A,A.QOT2 ;TERMINATOR? + JRST WRQOT1 ;TERMINATOR, BACK FOR MORE DEFINITION + PUSHJ P,PUTREL ;DEPOSIT CHAR + JRST A.QOT3 + +;READ IN BODY OF MACRO, IRP, OR WHATEVER + +WRQOTE: PUSH P,[0] ;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT). +WRQLEN==,-2 + PUSH P,[0] ;THIS WD USED FOR DEFINE/TERMIN COUNT. +WRQLVL==,-1 + PUSH P,[0] ;USED TO REMEMBER BEGINNING OF SYMBOL. +WRQBEG==0 + SETOM INICLB ;CLOBBERED INITS, .SYMTAB NOW ILLEGAL. + PUSHJ P,RCH ;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-INPUT + MOVE F,MACHIB ;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F + TRO I,IRSYL\IRLET ;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT +WRQOT0: +WRQOT1: MOVEI D,6 ;SQUOZE COUNTER + MOVEI SYM,0 ;INITIALIZE SYM + MOVE C,FREPTB ;GET POINTER TO CHAR BEFORE SYL ABOUT TO READ + PUSHJ P,WRQRR ;READ SYL + JUMPE SYM,.-2 ;LOOP UNTIL NON-NULL + ;NOW SEE IF DUMMY; **NOTE**: C STILL HAS BYTE POINTER, A SYL TERMINATOR + MOVE B,DMYBOT + CAML B,DMYTOP + JRST WRQOT2 ;NOT DUMMY + CAME SYM,(B) ;COMPARE WITH DUMMY NAME + AOJA B,.-3 ;LOOP ON NO MATCH + SUB B,DMYBOT ;DUMMY, CONVERT TO NUMBER + 200 + SUBI B,200 + LDB T,C ;GET LAST CHAR BEFORE SYL + CAIE T,"! ; ^ NOTE THAT THIS CAN LOSE IF MACRO HAS 33. ARGS + IDPB B,C ;NOT EXCLAMATION POINT, LEAVE THERE, DEPOSITING DUMMY CHAR + CAIN T,"! + DPB B,C ;EXCL, WIPE IT OUT + MOVEM C,FREPTB ;RESET FREPTB + CAIE A,"! ;A HAS DUMMY TERMINATOR, COMPARE WITH EXCL + TLO FF,FLUNRD ;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT + JRST WRQOT1 ;LOOP BACK FOR NEXT SYL + +;SYL ISN'T DUMMY, CHECK FOR PSEUDO +WRQOT2: MOVEM D,WRQLEN(P) ;REMEMBER START OF AND LENGHTH OF THE SYMBOL. + MOVEM C,WRQBEG(P) + SETOM ESBK ;EVAL IN CURRENT BLOCK. + PUSHJ P,ES ;EVALUATE SYM (DOESN'T CLOBBER F) + JRST WRQOT0 ;NOT SEEN + CAIE A,PSUDO/40000 + JRST WRQOT0 ;NOT PSEUDO + TLZ B,-1 ;CLEAR OUT LH OF VALUE, ONLY INTERESTED IN RH + CAIN B,A.QOTE + JRST A.QOT1 ;.QUOTE + CAIE B,ADEFINE + CAIN B,AIRP + AOS WRQLVL(P) ;DEFINE OR IRP +IFN RCHASW,[CAIN B,A.TTYM + AOS WRQLVL(P) ;.TTYMAC +] + CAIE B,ATERMIN + JRST WRQOT0 + SKIPGE WRQLEN(P) + ETR [ASCIZ /TERMIN longer than 6 chars/] + SOSL WRQLVL(P) ;TERMIN, SKIP IF THE TERMINATING ONE + JRST WRQOT0 ;NOT MATCHING TERMIN, BACK FOR NEXT SYL + POP P,A ;GET BACK BP TO LAST CHAR BEFORE TERMIN + SUB P,[2,,2] .SEE WRQLVL,WRQBEG + MOVE T,DMYBOT ;WE'RE NO LONGER USING SPACE IN DMYDEF. + MOVEM T,DMYTOP +A.QOTS: LDB T,A ;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN + CAIE T,"! + JRST A.QTS2 ;NOT EXCLAMATION POINT => OK + DBPM A, ;EXCLAMATION POINT, DECREMENT POINTER +A.QTS2: MOVEM A,FREPTB ;STORE AS NEW FREPTB + CCOMP1 A,-1 ;CONVERT TO CHAR ADR + MOVEM B,FREEPT ;STORE CHAR ADR AS NEW FREEPT + POPJ P, + +;FORMAT OF A MACRO: +;IT STARTS WITH A 374. +;THEN COME ARGUMENT DESCRIPTORS, ONE PER ARGUMENT. +MCF==777650 ;BITS AND FIELDS ARE: +MCFDEF==200 ;ARG IS DEFAULTED. MCFDEF AND MCFGEN NEVER BOTH SET. +MCFGEN==100 ;ARG SHOULD BE GENSYMMED IF NOT GIVEN IN CALL. +MCFKWD==40 ;ARG IS A KEYWORD ARG, SELECTED BY = RATHER THAN POSITION. +MCFSYN==7 ;FIELD THAT SPECIFIES THE ARGUMENT'S SYNTAX. + MCFNRM==1 ;MCFSYN CONTAINS MCFNRM => NORMAL-SYNTAX ARG + MCFLIN==2 ;MCFSYN CONTAINS MCFLIN => WHOLE LINE ARG + MCFBAL==3 ;MCFSYN CONTAINS MCFBAL => BALANCED ARG + MCFSTR==4 ;MCFSYN CONTAINS MCFSTR => ARG IS A DELIMITED STRING, AS IN "ASCIZ". + MCFKST==5 ;MCFSYN CONTAINS MCFKST => JUST LIKE MCFSTR, BUT DELIMITERS ARE RETAINED. + MCFEVL==6 ;MCFSYN CONTAINS MCFEVL => ARG IS BY VALUE (PREEVALUATED). +;IF MCFKWD IS SET, THE DESCRIPTOR IS FOLLOWED BY THE NAME OF THE ARGUMENT, +;TERMINATED BY A 377. +;IF MCFDEF IS SET, THE DESCRIPTOR IS FOLLOWED BY THE DEFAULT VALUE OF THE ARG, +;TERMINATED BY A 377. +;IF MCFKWD AND MCFDEF ARE BOTH SET, THE ARG NAME COMES FIRST. +;A ZERO BYTE ENDS THE DESCRIPTOR LIST. +;THEN COMES THE BODY OF THE MACRO, FOLLOWED BY A 375. + +ADEFINE: NOVAL ;ERROR IF CONTEXT WANTS A VALUE. + PUSH P,CASSM1 ;RETURN TO ASSEM1 EVENTUALLY + JSP TM,ERMARK ;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE. + PUSH P,SYM ;THESE 2 PUSHES ARE FOR NONAME'S SAKE. + PUSH P,SYM + CALL GETSLD + CALL NONAME + TLZ FF,FLUNRD + SUB P,[2,,2] + PUSH P,SYM + PUSH P,ESBK ;SAVE BLOCK TO DEFINE IN FOR ES'S SAKE. +IFN CREFSW,XCT CRFMCD + CALL A.TYM1 + POP P,ESBK + REST SYM + PUSHJ P,ESDEF ;FIND SLOT IN SYMBOL TABLE FOR IT + TLO C,3MACOK ;NEVER SEEN, OK TO MAKE MACRO. + TLON C,3MACOK ;ELSE ERROR IF NUMERIC OR ALREADY USED. + ETSM [ASCIZ/Non-macro made macro/] + MOVEI B,MACCL ;RH(VALUE) = MACCL + HRL B,PRDEF ;LH(VALUE) = CHAR ADR OF MACRO + CLEARM PRDEF ;NO LONGER NEED PRDEF + MOVSI T,PSUDO ;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO + JRST VSM2 + +IFN RCHASW,[ + ;.TTYMAC NAME + ;BODY + ;TERMIN + + ;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE) + +A.TTYM: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WE'RE INSIDE A .TTYMAC + CALL A.TYM1 ;READ IN A MACRO-DEFINITION. + MOVEI A,40 ;DON'T LET THE CHAR ENDING THE TERMIN + MOVEM A,LIMBO1 ;MAKE MACCL THINK THERE ARE NO ARGS. + CALL GTYIP1 ;PUSH INTO TTY FOR INPUT + HRLZ B,PRDEF ;PHONY UP A MACRO WHOSE DEFN IS WHAT WE READ. + SETZM PRDEF + MOVEI A,A.TYM8 + JRST A.TYM2 ;CALL THE MACRO: + ;READ THE ARGS, POP OUT OF TTY, EXPAND THE MACRO + ;AND THEN EXIT TO A.TYM8 +] + +A.TYM1: MOVE A,FREEPT + MOVEM A,PRDEF + MOVEI LINK,MCFNRM ;INITIALLY, DUMMIES ARE NORMAL. + MOVEI A,374 + PUSHJ P,PUTREL ;MARK BEGINNING OF MACRO +DEFNI: MOVE T,LIMBO1 + MOVE A,LINK +DEFNC: CAIE T,12 + CAIN T,15 + JRST DEFNA ;NO MORE ARGS (DONE WITH LINE) + CAIE T,LBRACE + CAIN T,LBRKT + JRST DEFNB1 + CAIE T,RBRACE + CAIN T,RBRKT + JRST DEFNB2 + CAIE T,"< ;OPENS TURN ON BALANCEDNESS. + CAIN T,"( + JRST DEFNB1 + CAIE T,"> ;CLOSES TURN OFF BALANCEDNESS. + CAIN T,") + JRST DEFNB2 + CAIN T,"? ;? TURNS BALANCEDNESS ON OR OFF. + JRST DEFBAL + CAIN T,"+ ;+ COMPLEMENTS KEYWORDNESS + XORI LINK,MCFKWD + CAIN T,"\ ;\ COMPLEMENTS GENSYMMEDNESS + XORI LINK,MCFGEN + CAIN T,"- ;- TURNS WHOLELINENESS ON OR OFF. + JRST DEFWHL + CAIN T,"* ;* TURNS ASCIZ-STYLE-NESS ON OR OFF. + JRST DEFASC + CAIN T,"& ;& TURNS KEEP-STRUNGNESS ON OR OFF. + JRST DEFKST + CAIN T,"# ;# TURNS EVALUATEDNESS ON OR OFF. + JRST DEFEVL + CAIN T,": ;: MAKES FOLLOWING ARGS NORMAL + MOVEI LINK,MCFNRM ;IN ALL RESPECTS + CAIN T,"; + JRST DEFNSM ;ALLOW DEFINE LINE TO BE COMMENTED +DEFND: PUSH P,A + CALL GSYL ;READ IN SYMBOL AS SQUOZE IN SYM. + REST A + CAIN T,"/ ;/ MEANS PREVIOUS ARG IS WHOLE-LINE. + XORI LINK,MCFLIN#MCFNRM + JUMPE SYM,DEFNC ;JUMP IF SYMBOL NAME WAS NULL. + CALL PDEF1 ;ELSE PUSH IT ON LIST OF DUMMIES. + MOVE A,LINK + CAIE T,"= + JRST DEFNL + IORI A,MCFDEF ;ONE ARG, WITH DEFAULT VALUE. + ANDCMI A,MCFGEN ;NOT TO BE GENSYMMED. +DEFNL: CALL PUTREL ;OUTPUT A DESCRIPTOR FOR THIS ARG + TRNE LINK,MCFKWD + CALL DEFNM ;PUT OUT ARG NAME IF KWD ARG + CAIE T,"= ;THEN DEFAULT VALUE IF DEFAULTED. + JRST DEFNI + JSP D,RARG ;INIT. FOR READING THE DEFAULT VALUE. + CAIA + CALL RARGCP ;COPY THE ARG INTO MACRO SPACE, + CALL PUT377 ;TERMINATED BY A 377. + JRST DEFNI ;NOW FOR THE NEXT ARG. + +DEFNM: MOVE D,[440700,,STRSTO] +DEFNM1: ILDB A,D + CAMN D,STRPNT + JRST PUT377 + CALL PUTREL + JRST DEFNM1 + +DEFEVL: SKIPA A,[MCFEVL] ;TURN EVALUATEDNESS ON OR OFF. +DEFASC: MOVEI A,MCFSTR ;TURN ASCIINESS ON OR OFF. + JRST DEFN9 +DEFKST: MOVEI A,MCFKST ;TURN KEEP-STRUNGNESS ON OR OFF. + JRST DEFN9 +DEFBAL: SKIPA A,[MCFBAL] ;TURN ON BALANCEDNESS, BUT IF ALREADY ON TURN OFF. +DEFWHL: MOVEI A,MCFLIN ;SIMILAR FOR WHOLELINENESS. +DEFN9: LDB B,[.BP MCFSYN,LINK] + CAMN A,B ;IF CURRENT STATE IS SAME AS IN A, + MOVEI A,MCFNRM ;SWITCH TO NORMAL MODE INSTEAD. + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNB2: SKIPA A,[MCFNRM] ;TURN OFF BALANCEDNESS +DEFNB1: MOVEI A,MCFBAL ;TURN ON BALANCEDNESS + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNSM: PUSHJ P,RCH ;SEMICOLON IN DEFINE LINE + CAIE A,15 + CAIN A,12 +DEFNA: SKIPA A,LINK ;END OF DEFINE LINE, GET COUNT + JRST DEFNSM + MOVEI A,0 + PUSHJ P,PUTREL ;DEPOSIT END-OF-DESCRIPTORS MARK + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD ;CHAR AFTER CR NOT LF + PUSHJ P,WRQOTE ;READ IN BODY + JRST STPWR + +;COME HERE TO EXPAND MACRO; LH OF B POINTS TO STRING. +;SYM HOLDS NAME OF MACRO (USED BY CALL TO AGETFD IN MACEVL). +MACCL: JSP TM,ERMARK ;ERROR MESSAGE DURING ARG SCAN SHOULD SAY WE'RE IN IT. + MOVEI A,RCHSV1 +A.TYM2: PUSH P,I + AOS PRCALP + AOS MDEPTH + PUSH P,RDWRDP + PUSH P,A ;RCHSV1 FOR MACRO, A.TYM8 FOR .TTYMA + MOVEI LINK,0 + HLRZ A,B + PUSHJ P,REDINC + CAIE B,374 + GOHALT + MOVEM A,@PRCALP + PUSHJ P,REDINC + TLZ I,ILPRN + JUMPE B,MACCLE ;MACRO TAKES NO ARGS => UN-READ NEXT CHARACTER. + MOVE A,LIMBO1 + CAIE A,") ;MACRO NAME TERMINATED WITH A CLOSE-BRACKET OF SOME SORT + CAIN A,"> ;=> UN-READ THE FOLLOWING CHARACTER. + JRST MACCLE + CAIN A,RBRKT + JRST MACCLE + CAIE A,15 ;MACRO NAME ENDED BY A CR OR LF => + CAIN A,12 + JRST MACCLD ;NO ARGS IN THIS CALL; NULLIFY ALL ARGS. + CAIE A,"< + CAIN A,"( + TLO I,ILPRN ;BUT MAYBE THERE IS A (. IF SO, IT'S A PAREN'D CALL, + CAIN A,LBRKT ;AND WON'T END TILL THE MATCHING CLOSE. + TLO I,ILPRN + CAIE A,40 ;IF THE CHAR ENDING THE MACRO NAME ISN'T AN OPENPAREN, + CAIN A,^I ;EOL, OR SPACE, RE-READ IT AS PART OF 1ST MACRO ARG. + JRST MACNX0 + TLNN I,ILPRN + TLO FF,FLUNRD +MACNX0: TDZ LINK,LINK +MACNXD: CALL MACDES ;FETCH NEXT DESCRIPTOR + JRST MACPUS ;NO MORE => THIS IS END OF THE CALL + TRNE LINK,MCFKWD + JRST MACK ;KEYWORD PARAM => SPECIAL SCANNER +;READ IN THE VALUE OF THE NEXT ARG, WHICH IS NORMAL (NOT KEYWORD) +MACNRM: CALL ADDTRN ;PUSH WORD TO HOLD VALUE OF ARG ONTO DSTG, + ;INITIALIZED -> FREEPT, WHERE WE WILL NOW WRITE THE ARG. + SOS C,A ;TELL MACRED WHERE THAT WORD IS. + CALL MACRED ;READ IN THE ARGUMENT VALUE. + JRST MACNXD ;THEN HANDLE ANOTHER ARG + GOHALT + JRST MACCLD ;END OF ARG LIST => NULLIFY REMAINING ARGS. + +MACCLE: TLO FF,FLUNRD ;SAVE CHR FOLLOWING MACRO W/NO ARGUMENTS + ;AND IF THAT CHAR WAS A CLOSE-BRACKET, + SKIPE B,ASMOUT ;CLEAR OUT THE CHANGE IT MADE TO ASMDSP. + CAIN B,4 + CAIA + JSP LINK,SAVAS2 + SETZ LINK, + JRST MACCLD ;NOW GO NULLIFY ANY ARGS THE MACRO WANTED, AND EXIT. + +;READ IN THE NEXT MACRO ARGUMENT ACC TO SYNTAX FLAGS IN LINK. +;C HAS ADDRESS OF WORD ON THE RDWRDP STACK WHICH HOLDS THE POINTER TO THIS ARG +;IN CASE WE WISH TO SET THE ARG TO THE NULL STRING. B AND LINK NOT CLOBBERED. +;RETURNS SKIPPING TWICE IF NO ARG BECAUSE END OF MACRO CALL SEEN. +MACRED: MOVEI D,MACNXR ;RARL3, RARB, RARGBR RETURN TO MACNXR + CALL RCH + CAIE A,^M + CAIN A,^J + JRST MACEND ;MAYBE WE HAVE REACHED THE END OF THE MACRO CALL. + LDB B,[.BP MCFSYN,LINK] + CAIN B,MCFLIN + JRST RARL3 ;ELSE, IF WHOLELINE ARG, NOTHING ELSE TO CHECK, + ;SO INIT FOR READING IT IN. + CAIN A,", + JRST MACNUL ;NON-WHOLELINE ARG IS NULL IF NEXT CHAR IS COMMA + CAIN A,"; ;SEMICOLON ENDS ARG LIST UNLESS INSIDE WHOLELINE ARG + JRST MACEND + CAIN B,MCFBAL + JRST RARB ;FOR BALANCED ARG, NOTHING ELSE SPECIAL, SO INIT. + CAIE B,MCFSTR ;FOR BOTH FLAVORS OF STRUNGNESS, + CAIN B,MCFKST ;GO GOBBLE AN ASCIZ-STYLE ARGUMENT. + JRST MACSTR + CAIN B,MCFEVL ;FOR EVALUATED ARG, READ FIELD AND EXPRESS AS NUMERAL. + TLOA FF,FLUNRD ;AND THE CHAR WE JUST READ WAS THE 1ST CHAR OF THE FIELD. + CAIN A,"\ ;NORMAL ARG STARTING WITH "\" TREATED THE SAME WAY, BUT FIELD + JRST MACEVL ;STARTS WITH NEXT CHAR. + CAIN A,LBRKT + JRST RARGBR ;FOR ORDINARY ARG, OPEN-BRACKET MAKES IT SPECIAL +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + MOVEI T,RARGN ;OTHERWISE IT'S A NORMAL ARG + TLOA FF,FLUNRD ;AND THE CHAR WE RCH'ED IS THE 1ST CHAR OF IT +MACNXR: JRST MACEN1 ;NON-SKIP RETURN FROM RARB, RARL3 OR RARGBR => ARG NULL + CALL RARGCP ;ARG NON-NULL => COPY IT INTO STRING SPACE + CAIE A,"; +CSTPWR: JRST STPWR ;AND TERMINATE IT +MACSC: MOVE A,(C) ;EXCEPT THAT SEMICOLONS INVALIDATE ALL THE SPACES + CAME A,FREEPT ;AND TABS THAT PRECEDE THEM. + JRST STPWR ;IF, AS A RESULT OF THAT, THE ARG IS NULL, END THE ARGLIST. +;COME HERE WHEN THE END OF THE MACRO'S WHOLE ARGLIST IS SEEN. +MACEND: TLO FF,FLUNRD +MACEN1: AOS (P) ;2-SKIP RETURN FROM MACRED INDICATES END OF ARGLIST + AOS (P) ;END OF ARGLIST => THIS ARG IS NULL. +;COME HERE TO NULLIFY CURRENT ARG (WHERE C POINTS) +MACNUL: TRZE LINK,MCFDEF + JRST MACDEF ;MAYBE DEFAULT IT + TRNE LINK,MCFGEN + JRST MACGEN ;MAYBE GENSYM IT + SETZM (C) ;ELSE SET TO NULL STRING. + RET + +MACST1: CALL RCH + CAIN A,", + JRST MACNUL +MACSTR: CAIE A,40 ;HERE FOR ARG DELIMITED LIKE TEXT STRINGS: /TEXT/. + CAIN A,^I ;SKIP ALL SPACES AND TABS BEFORE THE ARG. + JRST MACST1 + JSP D,RARB ;FIND END OF LINE, COMMENT, OR CLOSEBRACKET => + JRST MACEND ;NULLIFY ARG AND END MACRO CALL. + MOVEI T,(A) ;ELSE SAVE THIS CHAR; IT'S THE DELIMITER. + TLZ FF,FLUNRD ;DON'T RE-READ DELIMITER, + CAIN B,MCFKST ;BUT IF ARG IS KEEP-STRUNG, DROP THRU TO STORE IT. +MACST2: CALL PUTREL + CALL RCH ;READ ANOTHER CHARACTER. IF IT ISN'T THE DELIMITER, + CAIE A,(T) + JRST MACST2 ;STORE IT AND READ ANOTHER. + CAIN B,MCFKST ;HIT DELIMITER, DONE. BUT IF ARG IS KEEP-STRUNG, + CALL PUTREL ;KEEP DELIMITER BY STORING IT TOO. + CALL STPWR +MACST3: CALL RCH ;PASS BY SPACES AFTER THE CLOSING DELIMITER + CAIE A,40 + CAIN A,^I + JRST MACST3 + CAIE A,", ;COMMA HERE ENDS THE ARG BUT NOT THE MACRO CALL. + JSP D,RARB ;ELSE CHECK FOR OTHER TERMINATORS. + RET ;WE FOUND AN ACCEPTABLE ARG TERMINATOR. + ETR [ASCIZ /Garbage in ASCIZ-style macro arg/] + JRST RARFLS ;IF THERE'S ANYTHING ELSE, COMPLAIN AND SKIP IT. + +;COME HERE TO GIVE AN ARG ITS DEFAULT VALUE. +;MCFDEF WAS CLEARED SO MACDES WILL KNOW THE DEFAULT VALUE HAS +;ALREADY BEEN PASSED OVER AND WON'T TRY TO SKIP OVER IT. +;IF MCFKWD IS SET, WE MUST SKIP OVER THE KWD ARG'S NAME FIRST. +MACDEF: TRZN LINK,MCFKWD + JRST MACDF1 + MOVE A,@PRCALP +MACDF0: CALL REDINC ;SKIP ARG NAME IF KEYWORD ARG. + CAIE B,377 + JRST MACDF0 + MOVEM A,@PRCALP +MACDF1: MOVE A,@PRCALP ;COPY THE DEFAULT VALUE AS THE ARGUMENT VALUE. + CALL REDINC ;AS THE ARGUMENT STRING. + MOVEM A,@PRCALP + CAIN B,377 + JRST STPWR ;END OF THE DEFAULT VALUE. + EXCH A,B + CALL PUTREL + EXCH A,B + JRST MACDF1 + +;COME HERE IF GENSYMMABLE ARG IS SPEC'D AS NULL. +MACGEN: MOVEI A,5 + MOVEM A,SCKSUM + MOVEI A,"G + PUSHJ P,PUTREL + PUSH P,CSTPWR + AOS A,GENSM + IDIVI A,10 + HRLM B,(P) + SOSLE SCKSUM + PUSHJ P,.-3 + JRST MACEV2 + +;PROCESS ARG THAT STARTS WITH \, OR #-TYPE ARG. +MACEVL: CALL RCH ;FIRST, CHECK FOR IMMEDIATE END OF MACRO CALL. + JSP D,RARB + JRST MACEN1 + PUSH P,C + PUSH P,LINK ;SAVE LINK, NEED FLAGS + PUSHJ P,AGETFD ;GET THE FIELD + SKIPE B + ETR [ASCIZ /Relocatable \'d macro arg/] + POP P,LINK + REST C ;IF AGETFD EXPANDED A MACRO, FREEPT HAS CHANGED, SO + MOVE CH1,FREEPT ;PUT NEW VALUE INTO THE POINTER TO THIS DUMMY. + MOVEM CH1,(C) + MOVE CH1,A ;SAVE VALUE OF FIELD FROM CLOBBERAGE + PUSH P,CSTPWR +MACEV1: LSHC CH1,-35. ;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,MACEV1 +MACEV2: HLRZ A,(P) + ADDI A,60 + JRST PUTREL ;OUTPUT TO MACTAB STRING BEING DEFINED + +;HANDLE KEYWORD PARAMETERS. COME HERE WHEN A DESCRIPTOR IS SEEN +;THAT SPECIFIES A KEYWORD PARAMETER. +MACK: PUSH P,RDWRDP + MOVE A,@PRCALP ;PUSH A COPY OF POINTER TO 1ST KWD ARG'S DESCRIPTOR + AOS PRCALP ;SO WE CAN ADVANCE THE COPY WHILE KEEPING ORIGINAL FIXED. + MOVEM A,@PRCALP + PUSH P,LINK +;FIRST, PUSH A "NOT SET" MARKER FOR EACH OF THE KEYWORD PARAMS IN THIS RUN OF SUCH. +MACK2: SETO A, + CALL ADDTR2 + CALL MACDES ;NOTE THAT THERE IS ONLY ONE PARAM PER DESCRIPTOR + JRST MACK1 ;FOR KEYWORD PARAMS, SO NO NEED TO COUNT DOWN. + TRNE LINK,MCFKWD + JRST MACK2 +MACK1: MOVE LINK,(P) ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM. + MOVE B,PRCALP + MOVE B,-1(B) + MOVEM B,@PRCALP +MACKLP: CALL GPASST ;NOW SEE IF THERE'S AN ARGUMENT TO BE FOUND + CAIE A,^M ;IF SO, IT SHOULD START WITH A KEYWORD. + CAIN A,^J + JRST MACKND ;CR OR LF => NO KEYWORD, AND END SCAN. + CAIN A,"; + JRST MACKND + CAIN A,", + JRST MACKN1 ;NULL ARG => NO KEYWORD, BUT DON'T END SCAN. + CAIE A,") + CAIN A,"> + JRST MACKND ;DETECT END OF PARENTHESIZED CALLS, ETC. + CAIE A,RBRKT + CAIN A,RBRACE + JRST MACKND + TLO FF,FLUNRD + CALL GSYL ;THERE SHOULD BE ANOTHER ARG, SO TRY READING KEYWORD NAME + CALL PASSPS + MOVE C,-1(P) ;NOW SCAN THROUGH THIS RUN OF KEYWORD PARAMS FOR THE ONE + CAIE A,"= ;WHOSE NAME MATCHES WHAT GSYL READ. + JRST MACKL5 ;NOT FOLLOWED BY "="?? + DPB A,STRPNT +MACKL4: MOVE D,[440700,,STRSTO] + MOVE A,@PRCALP +MACKL1: CALL REDINC + ILDB AA,D + CAIN B,377 ;IF REACHED END OF KEYWORD'S NAME, AND EQUAL SO FAR + JRST MACKL2 ;SEE IF ARG'S NAME ALSO OVER. + CAMN B,AA + JRST MACKL1 ;ELSE KEEP COMPARING IF NAMES STILL SAME SO FAR. +MACKL6: MOVEM A,@PRCALP + CALL MACDES ;THIS KEYWORD DOESN'T MATCH SO FIND THE NEXT + JRST MACKL3 ;THERE ARE NO MORE; LOSE - ARG WITH BAD KEYWORD. + TRNN LINK,MCFKWD + JRST MACKL3 + AOJA C,MACKL4 + +MACKL5: ETR [ASCIZ /Bad format keyword argument/] + TLOA FF,FLUNRD ;INCLUDE THE BAD NON-"=" AS PART OF WHAT WE DISCARD +MACKL3: ETR [ASCIZ /Arg with undefined keyword/] + MOVEI T,RARGN + CALL RARFLS ;SKIP AN ORDINARY-SYNTAX MACRO ARG TO TRY TO RECOVER. + JRST MACK1 + +;COME HERE AFTER FINDING THE PARAM THAT MATCHES THIS ARG. +;C POINTS TO THE WORD IN DSTG FOR THAT ARG (DSTG IS WHAT ADDTRN PUSHES IN) +MACKL2: TRZ LINK,MCFKWD ;(IN CASE WE GO TO MACKL6, SINCE KWD NAME SKIPPED ALREADY) + CAIE AA,"= + JRST MACKL6 ;KWD NAME OVER BUT SPEC'D NAME NOT => MISMATCH + MOVEMM (C),FREEPT + CALL MACRED ;READ IN THE VALUE OF THE ARG, THUS SETTING THIS PARAM. + JRST MACK1 ;THERE ARE MORE ARGS => HANDLE THEM + GOHALT +MACKND: TLO FF,FLUNRD ;MACRO CALL TERMINATOR SEEN. +;NULL ARG SEEN; ENDS THIS RUN OF KEYWORD ARGS BUT NOT THE CALL. +MACKN1: REST LINK ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM. + SOS PRCALP + REST C ;GET PTR TO 1ST KWD ARG'S VALUE-WORD +MACKN2: MOVE A,(C) + AOJN A,MACKN4 ;IF THIS ARG WASN'T SPECIFIED, + MOVEMM (C),FREEPT + CALL MACNUL ;NULLIFY IT (MAYBE DEFAULT OR GENSYM) +MACKN4: CALL MACDES ;NOW SKIP OVER THE DESCRIPTORS OF THIS RUN OF KEYWORD PARAMS + JRST MACPUS ;EXHAUSTED ALL THE DESCR'S => END OF MACRO CALL. + TRNE LINK,MCFKWD ;SAME IF REACH A NON-KWD ARG. + AOJA C,MACKN2 + TLNN FF,FLUNRD ;REACHED A NON-KEYWORD PARAM: IF TERMINATOR WAS A NULL ARG, + JRST MACNRM ;GO ON TO READ THE VALUE OF THE NON-KEYWORD PARAM. + JRST MACCLS ;ELSE CALL WAS REALLY ENDED, SO NULLIFY REMAINING ARGS. + +;COME HERE TO FIND THE NEXT DESCRIPTOR. +;SKIPS OVER THE NAME AND DEFAULT VALUE OF THE PREVIOUS DESCRIPTOR, IF ANY. +;THE CONTENTS OF LINKK SAY WHETHER THEY EXIST TO BE SKIPPED OVER. +MACDES: MOVE A,@PRCALP + CALL REDINC ;READ NEXT CHAR OF MACRO + MOVEM A,@PRCALP + TRNE LINK,MCFKWD\MCFDEF + JRST [ CAIE B,377 ;IF THERE'S NAME OR DEFAULT TO SKIP, GO PAST TERMINATOR + JRST MACDES + TRZN LINK,MCFKWD ;AND SAY WE FOUND ONE + TRZ LINK,MCFDEF ;NOTE THERE MAY BE ANOTHER, IN WHICH CASE WE WILL + JRST MACDES] ;SKIP TILL ANOTHER 377 + JUMPE B,CPOPJ ;THIS DESC IS TERMINATOR => RETURN NO SKIP. + MOVEI LINK,(B) ;ELSE PUT FLAGS IN LINK. + JRST POPJ1 + +;COME HERE WHEN A MACRO CALL TERMINATOR IS ENCOUNTERED, TO NULLIFY ALL +;THE REMAINING PARAMS THAT THE MACRO WANTS, THEN ENTER THE MACRO. +;ENTER AT MACCLS IF HAVE JUST READ A DESCRIPTOR AND NOT NULLIFIED THE ARG, +;OR AT MACCLD IF HAVE JUST PROCESSED AN ARG, TO READ THE NEXT DESCRIPTOR. +MACCLS: TRNE LINK,MCFDEF\MCFGEN + JRST MACCL2 + SETZ A, ;NULLIFY NON-GENSYMMED, NON-DEFAULTED ARGS QUICKLY + CALL ADDTR2 +MACCLD: CALL MACDES ;THEN READ THE NEXT DESCRIPTOR. + JRST MACPUS ;IF NO MORE ARGS, ENTER THE MACRO. + JRST MACCLS + +MACCL2: CALL ADDTRN ;FOR GENSYMMED OR DEFAULTED ARG, PUSH PTR TO FREE STG + SOS C,A + CALL MACNUL ;THEN WRITE THE DESIRED VALUE THERE + JRST MACCLD ;THEN HANDLE NEXT DESCRIPTOR. + +;COME TO MACPUS WHEN ALL THE PARAMS HAVE HAD VALUES PUT IN DSTG (USING ADDTRN) +;TO ENTER THE MACRO. +MACPUS: TLZE I,ILPRN ;SPECIAL PARENTHESIZED CALL? + CALL MACPRN ;YES, SKIP PAST THE CLOSING PAREN. + MOVE B,(P) ;IS THIS A .TTYMAC? + CAIN B,A.TYM8 + CALL A.INEO ;YES, POP OUT OF TTY AFTER READING ARGS. + JFCL + REST B ;RCHSV1 OR A.TYM8 + PUSHJ P,PUSHEM + MOVE A,@PRCALP + PUSHJ P,ACPTRS ;SET UP CPTR + POP P,A + PUSHJ P,DMYTRN + SOS PRCALP + REST I +MACCR: AOS (P) ;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE +CMACCR: POPJ P,MACCR + +MACPRN: MOVEI TT,1 ;START PAREN-DEPTH AT 1 + JSP D,RARBC ;AND READ CHARS, UPDATING THE DEPTH, UNTIL + GOHALT + JUMPN TT,.-2 ;THE DEPTH GETS TO BE 0. + RET + +A.GOMC: ILDB B,A ;.GO ROUTINE TO SKIP PAST DESCRIPTORS + JUMPN B,A.GOMC ;IN HEADER OF MACRO DEFINITION. + JRST A.GORT + +RCHSV1: SOS MDEPTH ;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS +A.TYM8: PUSH P,A ;ENTRY FROM .TTYMAC END OF EXPANSION + MOVE B,TOPP +RCHSV3: CAMG B,BBASE + JRST RCHSV2 + HLRZ A,-1(B) + ADD A,-1(B) + MOVEI A,1(A) + CAME A,FREEPT + JRST RCHSV2 + HRRZ A,-1(B) ;GET NEW FREEPT + SOJA B,RCHSV3 + +RCHSV2: POP P,A + ;RETURN ROUTINE FOR END OF DUMMY +RCHSAV: MOVE B,BBASE + MOVEM B,TOPP + PUSHJ P,POPEM + HLRM B,BBASE +REPT6: TRZE FF,FRMRGO + POPJ P, ;RETURN TO .GO + JRST RCHTRB + +;IRP, IRPS, IRPC, IRPW, IRPNC ALL CALL HERE. +;ALL USE 2 FRAMES ON THE MACRO PDL: +; ,, +; ,, +; \<# GROUPS>,, +; ,,AIRR +;THE 3RD WORD HAS IN BITS 4.1-4.3 THE IRP TYPE CODE +; (NIRPO, NIRPC, ETC) +;AND IN THE REST OF THE LH, THE NUMBER OF GROUPS +; (TRIPLES OF TWO DUMMIES AND A LIST) + +.SEE NIRPO ;FOR DEFINITIONS OF IRP TYPE CODES. + +AIRP: JSP TM,ERMARK ;ERROR MESSAGES SHOULD SAY WE'RE INSIDE IT. + PUSH P,I + PUSH P,RDWRDP + HLRZ LINK,B ;GET IRP TYPE CODE TO INDEX BY. + CAIE LINK,NIRPN + JRST AIRP0 + CALL AGETFD ;IRPNC, READ THE 3 NUMERIC ARGS. + PUSH P,A + CALL AGETFD + PUSH P,A + CALL AGETFD + MOVEM A,AIRPN2 ;THE LAST ARG, + REST AIRPN1 ;THE MIDDLE, + REST AIRPN0 ;THE FIRST. + MOVEI LINK,NIRPN +AIRP0: SETZM IRPCR ;NO GROUPS SEEN YET. + +;FALLS THROUGH. + +;FALLS THROUGH. + +;TRY TO READ IN ANOTHER GROUP. +AIRP1: CALL PDEF ;READ IN DUMMY NAME, PUSH ON DMYTOP. + CAIE T,", ;TERMINATOR WASN'T COMMA AND NAME WAS NULL + JUMPE SYM,AIRP2 ;=> NO MORE GROUPS. + CALL PDEF ;NONNULL GROUP, READ & PUSH 2ND NAME. + CAIN T,"[ ;] TRY TO DETECT "IRP X,[", ETC. ] + CALL [ETR [ASCIZ/Comma missing in IRP/] + TLO FF,FLUNRD ;GENERATE A COMMA. + RET] + CALL ADDTRN ;PUSH CHAR ADDR OF 1ST DUMMY, + CAIE LINK,NIRPS + CAIN LINK,NIRPC ;LEAVE SPACE FOR IRPC'S 1ST ARG, IRPS'S 2ND. + CALL PUT377 + MOVE A,RDWRDP + CAIN LINK,NIRPS + AOS -1(A) ;IRPS - 1ST ARG GOES AFTER NEXT 377. + CALL ADDTRN ;PUSH CHAR ADDR OF 2ND DUMMY. + CALL PUT377 + MOVE A,RDWRDP + XCT AIRP1T-1(LINK) ;MAYBE INCREMENT THAT ADDR. + AOS IRPCR ;ONE MORE GROUP SEEN. + JSP D,RARG ;INITIALIZE READING LIST. + JRST AIRP3 ;NO LIST. + JRST @.(LINK) + OFFSET 1-. +NIRPO:: AIRPO ;IRP +NIRPC:: AIRPC ;IRPC +NIRPS:: AIRPS ;IRPS +NIRPW:: AIRPW ;IRPW +NIRPN:: AIRPN ;IRPNC + OFFSET 0 + +AIRP1T: AOS -1(A) + AOS -1(A) ;INCR. THE 2ND DUMMY ADDR FOR IRP, IRPC. + SOS -1(A) + JFCL ;DECR. FOR IRPS, NOTHING FOR IRPW. + AOS -1(A) ;INCR. FOR IRPNC. + +;READ LIST FOR IRPC OR IRP AND STUFF INTO STRING. +AIRPC: +AIRPO: CALL RARGCP ;COPY UP TO END OF ARG INTO MACRO SPACE. + JRST AIRP3 + +AIRPW3: CALL PUT377 ;END A LINE, + CAIGE C, + CALL PUT377 ;IF NO ; YET, MAKE NULL 2ND ARG. +;COME HERE FOR IRPW, LOOP BACK FOR NEXT LINE. +AIRPW: SETO C, ;NO ; SEEN YET IN LINE. +AIRPW1: JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST, GO WRITE 375. + CAIE A,^M + CAIN A,^J + JRST AIRPW1 ;IGNORE NULL LINES. +AIRPW4: CAIN A,"; + AOJE C,AIRPW2 ;ON 1ST SEMI, SWITCH TO 2ND ARG. + CAIE A,^J + CAIN A,^M + JRST AIRPW3 ;END OF LINE => END BOTH ARGS, START OVER. +AIRPW5: CALL PUTREL + JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST. + JRST AIRPW4 + +AIRPW2: MOVEI A,377 + JRST AIRPW5 + +AIRPS: SETO C, ;NO SQUOZE CHAR SEEN YET. +AIRPS2: JSP D,RARGCH(T) + JRST AIRP3 + HLRZ CH1,GDTAB(A) + CAIN CH1,(RET) + CAIN A,"! + AOJA C,AIRPS0 ;A SQUOZE CHAR OR !. + JUMPL C,AIRPS2 ;NON SQUOZE FOLLOWING ANOTHER, FLUSH. + DPB A,AIRPSP ;NONSQUOZE ENDING NONNULL SYL, PUT BEFORE SYL. + SETZM AIRPSP + CALL PUT377 ;FOLLOW SYL WITH 377. + JRST AIRPS + +AIRPS0: JUMPN C,AIRPS3 ;NOT 1ST CHAR IN SYL? + PUSH P,A + CALL PUT377 ;1ST, LEAVE A SPACE FOR THE SYL'S TERMINATOR. + MOVE A,FREPTB + MOVEM A,AIRPSP ;REMEMBER WHERE THE SPACE IS. + REST A +AIRPS3: CALL PUTREL + JRST AIRPS2 + +AIRPN: SKIPG C,AIRPN0 ;ANY CHARS TO IGNORE? + JRST AIRPN4 + JSP D,RARGCH(T) + JRST AIRP3 + SOJG C,.-2 +AIRPN4: SKIPN C,AIRPN2 ;GET MAX # GRPS OF CHARS. + JRST AIRPN7 ;0 => IGNORE THE REST. +AIRPN5: MOVE B,AIRPN1 ;DO NEXT GRP, GET # CHARS/GRP. +AIRPN6: JSP D,RARGCH(T) + JRST AIRP3 + CALL PUTREL ;STORE THE NEXT CHAR. + SOJG B,RARGCH(T) ;COUNT CHARS IN GRP. + MOVEI A,376 + CALL PUTREL ;FOLLOW GRP BY 376. + SOJN C,AIRPN5 ;MAYBE CAN DO MORE GRPS. +AIRPN7: CALL RARFLS ;DID AS MANY GRPS AS CAN DO, + ;IGNORE REMAINDER OF LIST. + +;COME HERE WHEN EXHAUST THE LIST. +AIRP3: CALL STPWR + JRST AIRP1 ;READ ANOTHER GROUP. + +;ALL GROUPS READ IN; NOW READ IN BODY. +AIRP2: CAIE T,"; ;IF A SEMICOLON ENDED THE ARGS, SKIP THE COMMENT. + JRST AIRP4 +AIRP5: CALL RCH + CAIE A,^M + JRST AIRP5 +AIRP4: PUSH P,LINK + MOVE A,FREEPT ;SAVE CHAR ADDR START OF BODY + MOVEM A,PRIRP ;WHERE GC WILL RELOCATE IT. + PUSHJ P,RCH ;IF NEXT CHAR LF, THEN FLUSH IT + CAIE A,12 + TLO FF,FLUNRD + PUSHJ P,WRQOTE ;READ BODY OF IRP + PUSHJ P,STPWR ;WRITE STOP + PUSHJ P,PUSHEM ;SAVE WORLD + REST LINK + POP P,A ;RESTORE RDWRDP FROM LONG AGO + PUSH P,TOPP ;NOW SAVE TOPP + PUSHJ P,DMYTRN ;ACTIVATE DUMMYS + MOVE B,MACP ;NOW GET MACRO PDL POINTER + MOVE A,CIRPCT ;GET .IRPCNT + HRRM A,(B) ;CLOBBER "RETURN" ON PDL TO OLD IRPCNT + SETOM CIRPCT ;INITIALIZE IRPCNT + MOVS A,IRPCR ;GET # GROUPS + HRR A,PRIRP ;CHAR ADR OF BEGINNING OF BODY + SETZM PRIRP + DPB LINK,[410300,,A] ;PUT IN TYPE OF IRP. + PUSH B,A ;PUSH ,,CHAR ADR BEGINNING + POP P,A ;NOW GET OLD TOPP + HRLS A ;MOVE TO LEFT HALF + HRRI A,AIRR ;RETURN TO AIRR ON END OF BODY + PUSH B,A ;PUSH OLD TOPP,,AIRP4 + MOVEM B,MACP ;STORE BACK UPDATED MACRO PDL POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP RIGHT AWAY TO CAUSE CYCLING + REST I + JRST MACCR + +;RECYCLE THROUGH IRP + + ;AC ALLOCATIONS: +AIRR: PUSH P,A ;A GETS BP ILDBING THRU ARG LIST. + PUSH P,C ;C # GROUPS LEFT + PUSH P,T ;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS + PUSH P,TT ;TT TYPE OF IRP (NIRPO, NIRPC, ETC) + AOS CIRPCT ;INCREMENT .IRPCNT + HRRZ A,(B) ;GET CHARACTER ADR BEG BODY FROM PDL + PUSHJ P,ACPTRS ;SET UP CPTR + SETOM AIRPT + TRNE FF,FRMRGO + JRST AIRR9 ;RETURN TO .GO + HLRZ T,1(B) ;DUMMY TAB ADR + LDB C,[220600,,(B)] ;# GROUPS + JUMPE C,AIRR9 ;JUMP IF NO GROUPS + LDB TT,[410300,,(B)] ;GET TYPE OF IRP (NIRPO, ETC) +AIRR6: JRST @.+1(TT) +AIRRER ? AIRRO ? AIRRC ? AIRRS ? AIRRW ? AIRRN ? AIRRER ? AIRRER +AIRRER: GOHALT + +;MOVE 1 ARG THRU 1 GROUP OF IRP. +AIRRO: HRRZ A,1(T) ;THE 1ST ARG WILL START THIS TIME + HRRZM A,(T) ;WHERE THE "REST OF STRING" STARTED LAST TIME. + BCOMP A,-1 ;GET BP THAT'LL ILDB THAT CHAR. + SETO CH1, ;COUNT [-] DEPTH. +AIRRO1: ILDB B,A + CAIN B,375 + JRST AIRRO4 ;END OF STRING IS END OF ARG. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIN B,"[ + AOJE CH1,AIRRO3 ;FLUSH OUTERMOST [-] PAIRS. + CAIN B,"] + SOJL CH1,AIRRO3 + JUMPGE CH1,AIRRO1 ;DON'T LOOK FOR , WITHIN [-]. + CAIE B,^J + CAIN B,", + JRST AIRRO2 ;END OF ARG. + CAIE B,^M ;^M IS IGNORED (FLUSHED.) + JRST AIRRO1 +AIRRO3: MOVEI B,376 ;FLUSH A CHAR BY REPLACING WITH 376 + DPB B,A + JRST AIRRO1 + +AIRRC4: SUB P,[1,,1] +AIRRC3: SETZM (T) ;NULLIFY BOTH ARGS PERMANENTLY. +AIRRO4: SETZM 1(T) ;NULLIFY 2ND ARG PERMANENTLY + JRST AIRR8 ;DONE WITH THIS GROUP. + +AIRRO2: MOVEI B,377 ;REPLACE CHAR THAT ENDED ARG WITH TERMINATOR. + DPB B,A +AIRRW3: CCOMP1 A,-1 ;GET ADDR OF CHAR AFTER. + HRRZM B,1(T) ;"REST OF STRING" STARTS THERE. + JRST AIRR8 + +AIRRN: MOVE A,1(T) ;NEW 1ST DUMMY STARTS AT OLD "REST OF STRING". + MOVEM A,(T) + BCOMP A,-1 ;NEW "REST OF STRING" STARTS AFTER 376, + JRST AIRRW2 ;WHICH WILL BECOME A 377. + +AIRRW: MOVE A,1(T) ;GET CHAR ADDR START OF 2ND HALF OF PREV LINE. + CALL AIRRM ;SET 1ST DUMMY -> AFTER NEXT 376 OR 377 . +AIRRW2: ILDB B,A ;MOVE UP TO NEXT 377 OR END OF STRING. + CAIN B,375 ;END OF STRING ENDS 1ST DUMMY'S ARG => + JRST AIRRO4 ;NULLIFY THE 2ND DUMMY. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIGE B,376 + JRST AIRRW2 + JRST AIRRO2 ;SET UP 2ND DUMMY -> NEXT CHAR. + + +;MOVE UP IN 1 GROUP OF IRPS. +AIRRS: MOVE A,(T) ;MOVE FROM 1ST DUMMY, + CALL AIRRM ;PUT 1ST DUMMY AFTER NEXT 377, + AOS (T) ;MOVE IT PAST THE SYL'S TERMINATING CHAR, + ILDB CH1,A ;GET THAT CHAR, + MOVE A,1(T) + JRST AIRRS2 ;STORE AS 2ND DUMMY. + +AIRRM: BCOMP A,-1 ;A HAS CHAR ADDR; WILL ILDB THAT CHAR. +AIRRM1: ILDB B,A + CAIN B,375 ;END OF STRING => NULLIFY BOTH ARGS + JRST AIRRC4 ;AND FINISHED WITH GROUP. + CAIE B,377 + JRST AIRRM1 + MOVE CH1,A + CCOMP1 CH1,-1 ;GET CHAR ADDR OF CHAR AFTER 377 + MOVEM CH2,(T) ;PUT 1ST DUMMY THERE. + RET ;NOTE A NOT CLOBBERED, CAN GO ON ILDB'ING. + +;MOVE UP IN ONE GROUP OF IRPC. +AIRRC: AOS A,1(T) ;DELETE 1ST CHAR FROM "REST OF STRING". + BCOMP A,-1 ;GET BP -> THAT CHAR. + LDB CH1,A ;GET THE CHAR. + MOVE A,(T) ;GET CHAR ADDR OF PLACE TO PUT IT. +AIRRS2: CAIN CH1,375 ;REACHED END OF STRING => + JRST AIRRC3 ;NULLIFY BOTH ARGS. + BCOMP A,0 + DPB CH1,A ;STORE IT IN THE 1-CHAR ARG. +AIRR7: SETZM AIRPT ;THIS GROUP NOT EXHAUSTED YET. +AIRR8: ADDI T,2 + SOJG C,AIRR6 ;MORE GROUPS => DO THE NEXT. +AIRR9: POP P,TT ;RETURN FROM AAIRPC + POP P,T + SKIPL AIRPT + JRST REPT3 + MOVN A,[2,,2] ;ARGS EXHAUSTED, RETURN + ADDB A,MACP + HRRZ A,(A) + MOVEM A,CIRPCT + POP P,C + POP P,A + JRST RCHSAV + +;IRP ARG-STRING READING COROUTINES: CALL WITH JSP D, +;INITIALIZE FOR READIN OF ARG BUT DON'T GET A CHAR. +;SKIPS IF NONNULL ARG AVAILABLE. +;COROUTINES REMEMBER INFO IN T AND TT BETWEEN CALLS. +;THE CALLER SHOULDN'T CLOBBER THEM. +RARG: CALL RCH ;DECIDE WHAT TYPE OF ARG FOLLOWS, IF ANY. + CAIN A,LBRKT ;RARG ALLOWS [-] AND MAYBE {-} ARGS AS WELL AS SIMPLE ONES. + JRST RARGBR +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + TLO FF,FLUNRD + JSP T,RARGXT ;CAUSE FAILURE RETURN ON SEMI, CR, LF. +RARGN: CALL RCH ;RARGCH RTN FOR NORMAL ARG. +RARGX1: CAIN A,", + JRST (D) ;COMMA ENDS ARG. +RARGXT: CAIN A,"; + JRST RARGSM ;SEMI ENDS SCAN. +RARGX2: CAIE A,^M + CAIN A,^J ;CR, LF END SCAN. +RARGSM: TLOA FF,FLUNRD + JRST 1(D) + JRST (D) + +RARGBR: SETZ TT, ;TT USED AS BRACKET COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR [-] TYPE ARGS. +RARGBC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRKT + AOJA TT,1(D) + CAIN A,RBRKT + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACKET. + +RARGRR: SETZ TT, ;TT USED AS BRACE COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR {-} TYPE ARGS. +RARGRC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRACE + AOJA TT,1(D) + CAIN A,RBRACE + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACE. + +;TO GET THE NEXT CHAR OF THE ARG IN A, DO JSP D,RARGCH(T). +;SKIPS UNLESS NO MORE CHARS TO GET. +;NO SKIP AND SET => SCAN SHOULD BE TERMINATED. +;RARG SHOULD NOT BE CALLED AGAIN IN THAT CASE. +RARGCH==0 ;THIS SYMBOL IS FOR CREF'S SAKE. + +;COPY THE ARG BEING READ INTO MACRO SPACE. +;ON RETURN, A WILL HOLD "; IF ARGUMENT WAS ENDED BY ";". +RARGCP: JSP D,RARGCH(T) + JRST RARGC1 + CALL PUTREL + JRST RARGCH(T) + +RARGC1: CAIE A,"; ;IF SEMI ENDED THE ARG, FLUSH THE + RET ;SPACES AND TABS BEFORE IT. +RARGC2: LDB A,FREPTB + CAIN A,^I + JRST RARGC3 + CAIE A,40 + JRST [ MOVEI A,"; ;LAST CHAR OF ARG ISN'T SP OR TAB. + RET] ;MAKE SURE A HAS ";" IF ARG WAS ENDED BY ";". +RARGC3: SOS FREEPT ;IT IS ONE; BACK OVER IT. + MOVE A,FREPTB + DBPM A + MOVEM A,FREPTB + JRST RARGC2 + +;IGNORE THE REST OF THE ARG NOW BEING READ. +RARFLS: JSP D,RARGCH(T) + RET + JRST RARGCH(T) + +;COME HERE TO SET UP TO READ A BALANCED ARG. +;IF THERE'S NO ARG, RETURNS WOTH JRST (D). +;ELSE RETURNS WITH JRST 1(D) SETTING UNRCHF. +RARB: TLO FF,FLUNRD + SETZ TT, ;TT USED AS BRACKET COUNTER. + CAIE A,RBRACE + CAIN A,") ;IF 1ST CHAR IS A CLOSE, + JRST RARB4 ;THERE'S NO ARG. + CAIE A,"> + CAIN A,RBRKT + JRST RARB4 + JSP T,RARGXT ;CHECK FOR CR, LF, SEMI, AND RETURN. +;1-CHAR RTN FOR READING BALANCED ARG. +RARBC: CALL RCH + CAIE A,RBRACE + CAIN A,"> ;FOR CLOSES, MAYBE END ARG. + JRST RARB2 + CAIE A,") + CAIN A,RBRKT + JRST RARB2 + CAIE A,LBRACE + CAIN A,"< ;FOR OPEN BRACKETS, INCR. THE COUNT. + AOJA TT,1(D) ;OPENS CAN'T END THE ARG. + CAIE A,"( + CAIN A,LBRKT + AOJA TT,1(D) + JUMPN TT,1(D) + JRST RARGX1 ;NOT WITHIN BRACKETS, TEST FOR COMMA, ETC. + +RARB2: SOJGE TT,1(D) ;COME HERE FOR CLOSEBRKTS. +RARB4: TLO FF,FLUNRD + JRST (D) + +;COME HERE TO INIT FOR AN ARG FOR REPEAT, ETC. +;THAT IS, EITHER A BRACKETED ARG OR A 1-LINE ARG. +RARL1: CALL RCH +RARL2: +IFN BRCFLG,[ +RARL4: CAIN A,LBRACE + JRST RARGRR ;1ST CHAR A BRACE => BRACED ARG. +] + CAIN A,LBRKT ;1ST CHAR A BRKT => BRKT ARG. + JRST RARGBR + TLO FF,FLUNRD + +;INIT FOR A 1-LINE ARG. +RARL: JSP T,1(D) +;1-CHAR RTN FOR 1-LINE ARGS. +RARLC: CALL RCH + JRST RARGX2 + +IFE BRCFLG,[ +;IF BRACES AREN'T USED BY MOST THINGS, THE NORMAL ROUTINE RARL1 DOESN'T +;CHECK FOR THEM, BUT RALR4 (CALLED BY CONDITIONALS) STILL MUST. +RARL4: CAIN A,LBRACE + JRST RARGRR + JRST RARL2 +] + +;1-LINE ARGS TO MACROS: DON'T TERMINATE THE SPEC, +;AND SKIP OVER THE CR AND LF. +RARL3: TLO FF,FLUNRD + JSP T,1(D) + CALL RCH + CAIN A,^J + JRST (D) ;LF IS THE END - SKIP IT. + CAIE A,^M + JRST 1(D) + CALL RCH ;CR => SKIP FOLLOWING LF, END ARG. + CAIE A,^J + TLO FF,FLUNRD + JRST (D) + +;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4) +;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY +;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A + +A.GST: MOVEM A,A.GST3 ;SAVE BYTE POINTER +A.GST1: ILDB B,A.GST3 ;GET CHAR + CAIL B,300 + POPJ P, ;END OF STRING => STOP + CAIE B,". + JRST A.GST1 ;WAIT FOR POINT + PUSHJ P,A.GSYL ;FOUND POINT, GET REST OF NAME + JUMPL T,CPOPJ ;RETURN ON END OF STRING + CAME SYM,[SQUOZE 0,TAG] ;TAG? + JRST A.GST1 ;NO, KEEP GOING + PUSHJ P,A.GSYL ;GET THE TAG + JUMPL T,CPOPJ ;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP) + CAME SYM,A.GST4 + JRST A.GST1 ;NOT THE ONE BEING LOOKED FOR + MOVE A,A.GST3 + LDB B,A ;GET DELIMITER + CAIE B,15 ;CR? + JRST POPJ1 + ILDB B,A ;CR, GET NEXT CHAR + CAIE B,12 ;LINE FEED? + MOVE A,A.GST3 ;NO, DON'T FLUSH + JRST POPJ1 + + ;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A + ;LEAVES POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B + +AG.SP: MOVE B,(A) ;GET WORD FROM MACTAB + XOR B,[300_28.+300_20.+300_12.+300_4] ;DO XOR TO ANITIALLY SET UP + LDB CH1,[400400,,A] ;PICK UP 4 HIGH ORDER BITS OF POSITION FIELD + JRST A.GSP2-1(CH1) ;DISPATCH ON POSITION FIELD (-1 SINCE BIT SET IN POSITION FIELD) + +AG.SP3: MOVE B,(A) + XOR B,[300_28.+300_20.+300_12.+300_4] + +A.GSP2: TRNN B,300_4 + JSP CH1,AG.SF + TLNN B,3 + JSP CH1,AG.SF + TLNN B,300_2 + JSP CH1,AG.SF + TLNN B,300_10. + JSP CH1,AG.SF + SOJA A,AG.SP3 + +AG.SF: SUBI CH1,A.GSP2-1 ;GET HERE WHEN STOP CHAR FOUND + DPB CH1,[400400,,A] ;CLOBBER POSITION FIELD OF BYTE POINTER AGAIN + ILDB B,A ;INCREMENT TO UNIVERSALLY ACCEPTABLE POINTER, GETTING STOP CHAR IN B AT SAME TIME + POPJ P, ;THAT'S ALL + +A.TAG: PUSHJ P,GSYL + CAIE T,15 + JRST MACCR + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD + JRST MACCR + +A.GO: PUSHJ P,GSYL ;DOESN'T WORK RELIABLY FROM DUMMY + MOVEM SYM,A.GST4 + +A.GO1: TLNN FF,FLMAC + JRST MACCR ;NOT GETTING CHARS FROM MACRO => STOP + MOVE A,CPTR + PUSHJ P,AG.SP ;BACK TO BEGINNING + CAIN B,374 + JRST A.GOMC ;MACRO, SKIP PAST HEADER +A.GORT: PUSHJ P,A.GST + JRST A.GO2 ;END OF STRING, TRY POPPING UP ONE + MOVEM A,CPTR + JRST MACCR + +A.GO2: PUSHJ P,PMACP + JRST A.GO1 + +A.GSYL: MOVNI D,100000 ;GET SYL FOR .GO WHILE LOOKING FOR TAG + MOVEM D,STRCNT ;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F) + MOVEI SYM,0 + JSP F,GSYL1 +A.GSY3: ILDB A,A.GST3 ;GET CHAR + TRZN A,200 ;CHECK FOR SPECIAL + JRST A.GSY2 ;NO, FALL BACK IN + CAIG A,100 ;BIG ENOUGH TO BE SPECIAL? + JRST A.GSY3 ;NO, MUST BE DUMMY, IGNORE + HRROI T,(A) ;SPECIAL => ASSUME STOP: T .LT. 0 SIGNAL TO CALLING ROUTINE + POPJ P, ;RETURN TO CALLING ROUTINE + +;INITIALIZE MACRO STATUS + +MACINI: MOVEI A,3 + MOVEM A,FREEPT ;FORGET ALL STRINGS IN MACTAB + PUSHJ P,FCOMP + MOVE A,MACTAD + HRLI A,41000 ;SET UP CCOMPB THRU CCOMPE + LSH A,2 ;(THEIR VALUES CAN'T BE ASSEMBLED IN BECAUSE + SUBI A,4 ;THEY ARE MUTLTIPLY RELOCATABLE, AND IN DEC + MOVSI AA,CCOMPB-CCOMPE ;VERSION THAT CAN'T BE DONE) +MACIN0: MOVEM A,CCOMPB(AA) + AOJ A, + AOBJN AA,MACIN0 + MOVE A,MACTAD + ADDI A,MACL+1777 + ANDI A,-2000 ;ADDR OF 1ST WD AFTER MACTAB. + CALL MACIN2 ;SET UP PTRS TO END OF MACTAB. + SETZM GCCNT ;CLEAR OUT GC COUNT SO WILL GET MORE CORE FIRST THREE +MACIN1: SETZM MDEPTH ;NOW INITIALIZE MACRO EXPANSION STATUS + SETZM PRSTG ;NOW TO CLEAR OUT BYTE POINTERS + MOVE A,[PRSTG,,PRSTG+1] + BLT A,EPRSTT-1 + MOVEI A,DSTG + MOVEM A,RDWRDP + MOVEI A,DMYAGT + MOVEM A,TOPP + MOVEM A,BBASE + MOVE A,[-MPDLL,,MACPDL] + MOVEM A,MACP + POPJ P, + +;A -> 1ST WD AFTER MACTAB, SET UP ALL POINTERS TO END OF MACTAB. +MACIN2: MOVEM A,MACTND + SUB A,MACTAD + LSH A,2 ;1ST BYTE MACTAB DOESN'T HAVE. + MOVEM A,MACHI + SUBI A,MACRUM*4 + MOVEM A,GCRDHI + MOVE A,STOPPT + HRR A,MACTND + SOS A ;LAST WD IN MACTAB. + MOVEM A,MACHIB ;INITIALIZE BYTE POINTER TO HIGHEST BYTE OK TO FILL + RET + + ;MACRO VARIABLE AREA (MOST THEREOF) + +VBLK +MACP: 0 ;MAC PDL POINTER +BLCODE [MACPDL: BLOCK MPDLL+1] ;MACRO PDL +FREEPT: 0 ;MACRO STG PNTR POINTS TO FREE CHAR +FREPTB: 0 ;FREEPT IN BYTE POINTER FORM +MACTAD: MACTBA ;ADDR OF START OF MACRO TABLE. +MACTND: 0 ;ADDR OF 1ST WD AFTER MACTAB. +MACHI: 0 ;CHAR ADR ONE ABOVE ACTIVE MACTAB +MACHIB: 0 ;POINTS TO LAST BYTE IN MACTAB + +SCONDF: 0 ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT +GENSM: 0 ;GENERATED SYM COUNT +DEFNPS: 0 ;NONZERO => NAME OF PSEUDO NOW READING ITS ARG. + ;A FATAL ERROR WILL TYPE THE PSEUDO'S NAME. +DEFNPN: 0 ;PAGE # -1 OF THAT PSEUDO. ALSO TYPED BY FATAL ERRORS. +DEFNLN: 0 ;LINE # -1. +DEFNFI: 0 ;SIXBIT FN1 OF FILE CONTAINING PSEUDO THAT DEFNPS REFERS TO. +MDEPTH: 0 ;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS +PUTCNT: 0 ;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION) +IRPCR: 0 ;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " " +AIRPT: 0 ;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0 +AIRPN0: 0 ;1ST NUMERIC ARG TO IRPNC +AIRPN1: 0 ;2ND, +AIRPN2: 0 ;3RD. +A.QOT2: 0 ;DELIMITER FOR .QUOTE +CRPTCT: -1 ;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT) +CIRPCT: -1 ;COUNT THOUGH CURRENT IRP (FOR .IRPCNT) +A.GST3: 0 ;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR +A.GST4: 0 ;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG +PRCALP: PRCAL-1 ;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY + +PRSTG: ;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D + +CPTR: 0 ;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER +IFE WRQTSW-1,WRQTBP: 0 ;POINTS TO LAST CHAR BEFORE CURRENT SYL AT WRQOTE +AIRPSP: 0 ;-> PLACE TO STORE SYL-TERMINATOR, IN IRPS READIN. +GCBPL==.-PRSTG ;END BYTE POINTERS, BEGIN CHARACTER ADDRESSES +PRSCND: 0 ;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND +PRSCN1: 0 ;CHAR ADR BEG OF FIRST STRING IFSE, IFSN +PRREPT: 0 ;CHAR ADR BEG OF BODY OF REPT +PRIRP: 0 ;CHAR ADR BEG OF IRP BODY +PRDEF: 0 ;CHAR ADR BEG OF MACRO BEING DEFINED +PRCAL: REPEAT 10,0 ;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS +EPRSTT: ;END CHAR ADR WORDS GARBAGE COLLECTED + + ;BEGIN GARBAGE COLLECTOR VARIABLES + +GCCNT: 0 ;CNT OF GC'S +SYMSTR: 0 ;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE" +REDPT: 0 ;CHAR ADR READING FROM WHEN MOVING STRING DOWN +REDPTB: 0 ;REDPT IN BYTE POINTER FORM + ;GC WRITES WITH FREEPT/FREPTB +COFST: 0 ;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE +SVF: 0 ;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING +FREPTS: 0 ;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN +FRPTBS: 0 ;FREPTS IN BYTE POINTER FORM +GCENDF: 0 ;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT +GCHI: 0 ;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT +GCRDHI: *4 ;GC DROPS DEAD (MACTAB FULL) IFWRITING INTO THIS CHAR ADR +BLCODE [GCSV: BLOCK 16] ;AC SAVE AREA FOR GC +PBLK + +;GARBAGE COLLECT THE MACRO TABLE + +GCA1: MOVE A,FREEPT ;GC ALL IN MACTAB. +GCA: MOVEM A,GCHI ;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT +IFN 17-P+FF,.ERR GC ac saver wants FF=0, P=17! +GC: MOVEM 16,GCSV+15 ; Save all ACs except FF and P. + MOVE 16,[1,,GCSV] + BLT 16,GCSV+14 +IFN TS,[AOS A,GCCNT + CAIGE A,4 + PUSHJ P,GCCORQ ;EXPAND CORE ON FIRST THREE GC'S +] CLEARB T,GCENDF + MOVEI A,3 + MOVEM A,REDPT ;SET UP FOR READING + MOVEM A,FREEPT ;ALSO FOR WRITING + MOVE A,BCOMPU ;ALSO SET UP CORRESPINDING BYTE POINTERS + MOVEM A,FREPTB + MOVEM A,REDPTB + MOVE C,[-GCBPL,,PRSTG] +GCLP1: SKIPN B,(C) ;NOW CONVERT BYTE POINTERS... + JRST GCLP1B ;(INACTIVE) + CCOMP B,-1 ;TO CHARACTER ADDRESSES + MOVEM B,(C) ;STORE BACK CHARACTER ADDRESS +GCLP1B: AOBJN C,GCLP1 ;LOOP FOR ALL SUCH BYTE POINTERS + MOVE A,SYMAOB ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION +SYMMG: ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST + LDB B,[400400,,ST(A)] ;GET SQUOZE FLAGS THIS SYM + CAIN B,PSUDO_-14. ;PSEUDO? (=> MAYBE MACRO) + JRST SYMMG1 ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2) +SYMMG2: ADD A,WPSTE1 + AOBJN A,SYMMG ;LOOP FOR ENTIRE SYMTAB + MOVEM T,SYMSTR ;STORE INITIAL LIST ENTRY FOR MACROS + ;DROPS THROUGH + ;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375 + ;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE + ;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING + ;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT + ;DROPS THROUGH + +MSTG: MOVE C,REDPT ;SET UP C TO POINT TO BEG OF STRING BEING READ + ;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE) + MOVE TT,FREEPT + CAML TT,GCHI ;IF ALL OF ACTIVE PART OF MACTAB ALREAD GC'D, STOP NOW. + JRST GCEND + MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING + MOVE TT,FREPTB + MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING + PUSHJ P,RDTRNS ;COPY CHARACTER + CAIN B,370 + JRST MSTGB ;THAT WAS NO STRING, THAT WAS MY IO-BUFFER! + MOVE TT,B ;SAVE CHARACTER JUST COPIED +MSTG1: CAML LINK,GCHI + JRST GCEND ;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE + CAIN B,375 + JRST MSTG2 ;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG + PUSHJ P,RDTRNS ;STRING NOT EXHAUSTED, COPY NEXT CHAR + JRST MSTG1 + +SYMMG1: HRRZ B,ST+1(A) ;PSEUDO FOUND IN SYMTAB, GET "VALUE" + CAIE B,MACCL ;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH) + JRST SYMMG2 ;NO, JUST FALL BACK INTO LOOP + HRRM T,ST+1(A) ;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT + MOVEI T,ST+1(A) ;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED + PUSH P,A + HLRZ A,ST+1(A) + PUSHJ P,REDINC + CAIE B,374 + GOHALT + POP P,A + JRST SYMMG2 + + ;COPY CHARACTER DOWN (REDPTB -> FREPTB) + ;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B + +RDTRNS: ILDB B,REDPTB + IDPB B,FREPTB + AOS LINK,REDPT + AOS A,FREEPT + POPJ P, + +MSTGB: ADDI A,3 ;COPY AN IO-BUFFER: + TRZ A,3 + MOVEM A,FREEPT ;WRITE INTO WORD BOUNDARY. + ADDI LINK,3 + TRZ LINK,3 + MOVEM LINK,REDPT ;READ FROM WORD BOUNDARY. + MOVEI B,041000 + HRLM B,REDPTB + HRLM B,FREPTB + MOVE B,FREPTB + MOVE A,REDPTB + ADDI B,1 ;NEW ADDR OF 1ST WD. + HRRZ LINK,1(A) ;GET ADDR OF POINTER TO STRING. + MOVEM LINK,SVF ;REMEMBER WHETHER TO FLUSH STRING. + SKIPE LINK + HRRM B,(LINK) ;RELOCATE THAT POINTER (IF ANY) + HRLI B,1(A) ;SET UP AC FOR BLT. + HLRZ LINK,1(A) ;GET LENGTH OF STRING. + ADDM LINK,REDPTB + LSH LINK,2 + ADDM LINK,FREEPT + ADDM LINK,REDPT + LSH LINK,-2 + ADDB LINK,FREPTB + BLT B,(LINK) + MOVE LINK,REDPT + CAML LINK,GCHI ;IF THIS IO-BUFFER IS LAST THING IN MACRO SPACE, + SETOM GCENDF ;DON'T LOOK FOR ANYTHING FOLLOWING IT. + JRST MSTGB1 ;NOW MAYBE FLUSH THIS STRING, COPY NEXT. + +;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN + +GCEND1: IFN TS,[ + MOVE A,FREEPT + ADDI A,2000*4 + CAML A,MACHI + PUSHJ P,GCCORQ +] MOVE A,FREEPT + CAML A,GCRDHI + ETF [ASCIZ /Macro space full/] + SKIPN T,SYMSTR + JRST USYMG1 ;EMPTY LIST + MOVEI C,MACCL ;SET UP C FOR HRRM'ING +USYMG: HRRZ TT,(T) ;GET ADR ON LIST + HRRM C,(T) ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL + HLRZ A,(T) + PUSHJ P,REDINC + CAIE B,374 + GOHALT + SKIPE T,TT ;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST + JRST USYMG + +USYMG1: MOVE C,[-GCBPL,,PRSTG] +GCLP2: MOVE A,(C) ;NOW CONVERT CHARACTER ADDRESSES... + BCOMP A,-1 ;BACK TO BYTE POINTERS + MOVEM A,(C) + AOBJN C,GCLP2 +IFN 17-P+FF,.ERR GC AC restorer wants FF=0 and P=17! + MOVS 16,[1,,GCSV] ; Restore all ACs except FF and P. + BLT 16,16 + POPJ P, ;EXIT FROM GARBAGE COLLECTOR + + ;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING + ;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR + ;T POINTS TO LAST WORD IN TABLE + 1 + ;RELOCATE POINTERS IN TABLE POINTED TO + ;C POINTS TO BEGINNING OF STRING, B -> END + 1 + +MSCN: CAIG T,(CH1) + POPJ P, ;TABLE EXHAUSTED + HRRZ TT,-1(T) ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN) + CAML TT,C + CAML TT,B + JRST MSCN1 ;DOESN'T POINT TO CURRENT STRING + SUB TT,COFST ;POINTS TO STRING, RELOCATE + HRRM TT,-1(T) ;STORE BACK RELOCATED POINTER + SETOM SVF ;SET FLAG TO SAVE STRING +MSCN1: SKIPGE CH1 + SOS T ;CH1 NEGATIVE => SKIP A WORD + SOJA T,MSCN + +GCEND: SETOM GCENDF ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING +MSTG2: CLEARM SVF ;NO POINTERS FOUND TO STRING YET + MOVE D,REDPT + SUB D,FREEPT + MOVEM D,COFST ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION + MOVE B,REDPT + CAIE TT,374 + JRST MSTG3 ;NOT A MACRO + MOVE T,SYMSTR + JUMPE T,MSTG3 ;JUMP IF NO MACROS ON LIST +MSTG5: HLRZ TT,(T) ;GET CHAR ADR THIS MACRO + CAML TT,C ;SKIP IF POINTS BELOW BEGINNING THIS STRING + CAML TT,B ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ + JRST MSTG4 ;DOESN'T POINT TO THIS STRING + SETOM SVF ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING + SUB TT,COFST ;RELOCATE + HRLM TT,(T) ;STORE BACK UPDATED CHAR ADR THIS MACRO +MSTG4: HRRZ T,(T) ;NOW GET POINTER TO NEXT MACRO + JUMPN T,MSTG5 ;LOOP FOR ALL MACROS ON LIST + +MSTG3: MOVE T,TOPP + MOVEI CH1,DMYAGT + PUSHJ P,MSCN ;RELOCATE POINTERS IN DUMMY ARG TABLE + HRRZ T,MACP + HRROI CH1,MACPDL + PUSHJ P,MSCN ;RELOCATE POINTERS IN MACRO PDL + HRRZ T,PRCALP + AOS T + MOVEI CH1,PRSTG + PUSHJ P,MSCN ;RELOCATE POINTERS IN PRSTG + HRRZ T,RDWRDP + MOVEI CH1,DSTG + PUSHJ P,MSCN ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED + SKIPGE GCENDF + JRST GCEND1 ;EXIT +MSTGB1: SKIPE SVF + JRST MSTGB2 ;FOUND POINTERS TO THIS STRING, DON'T FLUSH + MOVE TT,FREPTS ;NO POINTERS FOUND, FLUSH STRING + MOVEM TT,FREEPT + MOVE TT,FRPTBS + MOVEM TT,FREPTB +MSTGB2: SKIPGE GCENDF ;IF WE JUST HACKED AN I-O BUFFER, MAYBE IT'S THE LAST + JRST GCEND1 ;THING IN MACRO SPACE. + JRST MSTG + +] ;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES) + +IFN .I.FSW,[ ;;.I.F ;ALGEBRAIC COMPILER ROUTINE +; 'ALGEBRAIC' CRUFT MARO DEFINITIONS + +DEFINE MOAN ARG/ + MOVEI D,[SIXBIT /ARG!!/] + JRST ERRCON +TERMIN + +DEFINE RETLIN + MOVEI A,15 ;CARRIAGE RETURN + PUSHJ P,PUTREL + MOVEI A,12 ;LINE FEED + PUSHJ P,PUTREL +TERMIN + +DEFINE NUMBER + MOVE A,BTPNT + ILDB I,A + CAIE I,"# + CAIGE I,"@ +TERMIN + +DEFINE RESTOR + MOVE D,BTPNT + SETZM STRING + SETZM STRING+1 + SETZM STRING+2 +TERMIN + + +DEFINE SPECN + POP P,RANDM + MOVE A,ENN + SUB A,RANDM + MOVEM A,ENN +TERMIN + +DEFINE $GET + EXCH I,ACSVI + PUSHJ P,RCH + EXCH I,ACSVI +TERMIN + +DEFINE GETT + EXCH I,ACSVI + PUSHJ P,RCH + EXCH I,ACSVI + IDPB A,TPN +TERMIN + +; START OF COMPILER PROPER + +OPDL: CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR + CH?SP?CH?CH?CH?CR?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + SP?CH?CH?CH?DL?CH?CH?CH + LP?RP?TX?PL?CM?MN?CH?DV + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?KL?LB?EQ?RB?CH + +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?UP?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH + +VBLK + +ENN: 60 ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9 + +BTPNT: 440700,,STRING ;D +STRING: BLOCK 10 ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS + +TPN: 0 +DIRPNT: 440700,,DIROUT ;TPN +DIROUT: BLOCK 40 ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS + +OPSTKL==40 + 0 +OPSTK: BLOCK OPSTKL ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS + 0 + + + +ENDSTT: 0 ;ON IF END OF STATEMENT ENCOUNTERED +CHARF: 0 ;LAST WAS NOT OPERATOR +NUMFL: 0 ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ]) +R1SV: 0 ;SAVED A +R2SV: 0 ;SAVED I, CALLED V EARLIER ON + +INTEGR: 0 ;INTEGER ARITHMETIC +WARN: 0 ;ON AFTER ) TO STOP NON-OPERATOR +RANDM: 0 ;DUMP COMMA COUNT HERE +TEMP: 440600,,(D) ;INDIRECT VIA D +BYTPNT: 0 + ; Save 7 acs here, done by move(m)s for robustness +IRP AC,,[AA,A,B,C,D,I,P] +ACSV!AC: 0 +TERMIN +PBLK + +; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR + +A.I: SETOM INTEGR + SKIPA +A.F: SETZM INTEGR + PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER +IRP AC,,[AA,A,B,C,D,I,P] + MOVEM AC,ACSV!AC +TERMIN + SETZM ENDSTT ;RESET END OF STMNT FLAG + SETZM EQHIT' ;RESET LAST CHAR WAS= FLAG + SETZM WARN ;SET OFF ERROR DETECTOR + MOVEI A,"0 ;INITIALISE POINTERS + MOVEM A,ENN + MOVE A,DIRPNT + MOVEM A,TPN ;POINTER TO SAVED INPUT + MOVE SYM,[-OPSTKL,,OPSTK] + PUSH SYM,[0,,ENDSAT] + PUSH P,[0] ;INITIALISE COMMA-COUNTER + SETZM CHARF +CLSTR: RESTOR +RDITTS: SKIPE ENDSTT + JRST BDEND +RDITA: GETT + CAIGE A,100 ;FOR ABBREVIATED DISPATCH TABLE + JRST @OPDL(A) + CAIN A,"\ + JRST AB + CAIN A,"^ + JRST UP + +CH: SETZM EQHIT + SKIPE WARN + JRST CHBRT +CHEY: IDPB A,D + SETOM CHARF ;NON UNARY FLAG + JRST RDITA + +GAMB: RESTOR +COMMT: MOVE I,R2SV + JRST GOPURT + +SHORT: ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS + SETZM IMMED' + SKIPN STRING + POPJ P, ;NO STRING + MOVE A,BTPNT + ILDB I,A + CAIN I,"# + JRST APUPJ ;YEPE HE ASKED FOR IT + SKIPE STRING+1 + POPJ P, ;STRING IS LONG + SKIPA + +TSTSHL: ILDB I,A + JUMPE I,APUPJ ;ITS OK FOUND ONLY NUMBERS + CAILE I,"@ + POPJ P, ;NON-NUMBER IN STRING + CAIE I,". + JRST TSTSHL + ILDB I,A + SKIPN I ;ANYTHING FOLLOW '.' QST +APUPJ: SETOM IMMED' ;INDICATE IMMEDIATE USAGE IS POSSIBLE + POPJ P, + +SZPRT: SETZM CHARF +GOPRT: SETZM WARN +GOPART: MOVEM I,R2SV +GOPURT: HLRZ B,I + HLRZ C,(SYM) + CAMLE B,C + JRST PSOPR ;GO PUSH OPERATOR + SKIPN INTEGR + SETOM IMMED ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE + PUSHJ P,SHORT ;ESTABLISH IF STRING CAN BE IMMEDIFIED + POP SYM,A ;POP AN OPERATOR + JUMPN A,(A) + + MOAN OVERPOPPED OPERATOR STACK + +CHEX: MOVE A,R1SV + JRST CHEY + +RP: SKIPE EQHIT + AOS ENN ;TAKE CARE OF UNSATISFIED = AT END + SKIPN CHARF + JRST RTONOP + SETOM CHARF +BUDDY: SETOM WARN + MOVEI I,RPAR + JRST GOPART + +RTONOP: MOVE I,(SYM) + CAIN I,FUNCT + JRST BUDDY ;NO ARGUMENT FUNCTION + + MOAN ) FOLLOWS OPERATOR + +BDEND: MOAN TOO MANY ('S + +CHBRT: MOAN NON-OPERATOR FOLLOWS ) + +CR: SKIPE EQHIT + AOS ENN ;HANDLES UNSATISFIED = AT END + SETOM ENDSTT + MOVEI I,RCAR + JRST GOPRT + +LP: SETZM EQHIT + SKIPE WARN + JRST LFRHT + SETZM CHARF + SKIPE STRING + JRST INDX + PUSH P,[0] ;INITIALISE COMMA-COUNTER + PUSH SYM,[0,,LFTPR] + JRST RDITA + +INDX: NUMBER + JRST NUSTRB + GETT + CAIG A,"9 + JRST NMRINX + MOVEI I,"( + IDPB I,D +INDY: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDN + CAIN A,"- + JRST CMPNDN + CAIE A,") ;SEARCH FOR NEXT RP + JRST INDY + IDPB A,D +CMBAN: SETOM CHARF ;MAKE BELIEVE CHARATER LAST + SETOM WARN ;YET SET ) TRAP + JRST RDITA + +NMRINX: CAIN A,"- ;IS IT A MINUS + JRST INDZ + CAIN A,"+ + JRST INDZ + MOVEI I,"+ ;NUMERICAL SUBSCRIPT + IDPB I,D +INDZ: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDC + CAIE A,") + JRST INDZ + JRST CMBAN + +CMPNDN: MOVEI I,") + IDPB I,D + JRST INDZ + +CMPNDC: MOVEI I,"( + IDPB I,D + JRST INDY + +LFRHT: MOAN ( FOLLOWS DIRECTLY ON ) + +SP=RDITA ;USE FOR NON ARITH STATS + +CM: MOVE I,[1,,COMMX] + SKIPN CHARF + AOS ENN + JRST SZPRT + +EQ: SETOM EQHIT + SETZM WARN + SKIPN CHARF ;TEST FOR EXISTANCE OF L H S + JRST EQFLOP + NUMBER ;IS L H S A NUMBER + JRST EQNUMB + MOVEI I,EQAAL +EQVAL: SETZM CHARF + PUSH SYM,I + PUSH P,STRING + PUSH P,STRING+1 + PUSH P,STRING+2 + PUSH P,[0] + JRST CLSTR + +PL: MOVE I,[2,,PLUS] + SKIPN CHARF + JRST RDITA ;UNARY PLUS + JRST SZPRT + +MN: MOVE I,[2,,MINUX] + SKIPN CHARF + MOVE I,[5,,UMINU] + JRST SZPRT + +AB: SKIPE CHARF ;ABSOLUTE VALUE + JRST ABERR ;NOT UNARY + MOVE I,[5,,UABS] + JRST SZPRT + +LB: SKIPN CHARF + JRST LP ;TREAT LIKE ( + NUMBER + JRST NUBRST + MOVEI I,FUNCT + JRST EQVAL + +RB=RP + +NUBRST: MOAN '<' FOLLOWS NUMBER + +NUSTRB: MOAN '(' FOLLOWS NUMBER + +EQFLOP: MOAN '=' FOLLOWS OPERATOR + +EQNUMB: MOAN '=' FOLLOWS NUMBER + +ABERR: MOAN NON-UNARY ABS + +TX: MOVE I,[4,,TIMES] + SKIPN CHARF + JRST RDITA ;UNARY TIMES + JRST SZPRT + +DL: $GET ;CONTINUE STATEMENT RC + $GET ;LF + $GET ;. + CAIE A,". ;DOT + JRST BDCONT + $GET ;F OR I + $GET ;CONTROL I OR SPACE + MOVE A,DIRPNT + MOVEM A,TPN ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER + MOVEI A,"$ + IDPB A,TPN + MOVEI A,40 + IDPB A,TPN + JRST RDITA + +ERRCON: TRNE FF,FRPSS2 ;NO OUTPUT ON SECOND PASS + JRST CONRBT +;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC + MOVE B,DIRPNT +OUTRR: ILDB A,B + PUSHJ P,TYO + CAME B,TPN + JRST OUTRR + SKIPE ENDSTT + JRST CONERT +DORSTL: MOVEI A,40 + PUSHJ P,TYO + MOVEI A,"? ;POINT AT ERROR + PUSHJ P,TYO + MOVEI A,40 + PUSHJ P,TYO +DORSAL: $GET ;COPY UP TO LINE FEED + PUSHJ P,TYO + CAIE A,12 ;LF + JRST DORSAL +CONERT: PUSHJ P,TIPIS + PUSHJ P,CRR +CONRAT: +IRP AC,,[AA,A,B,C,D,I,P] + MOVE AC,ACSV!AC +TERMIN + JRST SWFLS ;GO BACK AND FLUSH + + +CONRBT: $GET + CAIE A,12 ;LF + JRST CONRBT + JRST CONRAT + +UP: SKIPN WARN ;FOR (NUMBER)^N + SKIPN STRING + JRST ITSEX + MOVEM A,R1SV ;SAVE THE ARROW + NUMBER + JRST CHEX ;ITS PART OF A NUMBER +ITSEX: MOVE I,[6,,STRSTR] + SKIPN CHARF + JRST EXMB + JRST SZPRT + +EXMB: MOAN UNARY ^ + +BDCONT: MOAN BAD CONTINUATION + +KL=CR ;SEMICOLON ACTS LIKE CR IN TERMINATING + +STRSTR: SKIPN STRING + JRST EXLS + NUMBER + SKIPA + JRST EXLS + SUBI I,61 + TDNE I,[-1,,777774] + JRST EXLS + MOVE A,STRING + TDNE A,[3777,,-1] + JRST EXLS + ADDI I,POWR + JRST @(I) + +EXLS: PUSH P,[ASCII !EXPLO!] + PUSH P,[ASCII !G !] + PUSH P,[0] + PUSH P,[1] + SETOM EXRET' + JRST FUNET + +DV: MOVE I,[4,,DIVIX] + SKIPN CHARF + MOVE I,[5,,UDIVI] + JRST SZPRT + +PSOPR: PUSH SYM,I ;PUSH OPERATOR FOR LATER EXCECUTION + SKIPN STRING + JRST RDITTS + PUSHJ P,SHORT ;CAN WE IMMEDIFY + PUSHJ P,MVOI ;AND MOVE OPERAND INTO STACK + JRST CLSTR + +PRODB: NUMBER ;OUTPUT WHAT IS IN STRING + SKIPE IMMED ;NO [ & ] IF IMMEDIATE USE + JRST OVNM + PUSH P,A + MOVEI A,"[ ;[ FOR CONSTANT + PUSHJ P,PUTREL + POP P,A + SETOM NUMFL +OVNM: CAIN I,"# + JRST PRDOC + + EXCH A,I + PUSHJ P,PUTREL + MOVE A,I +PRDOC: ILDB I,A + JUMPN I,OVNM + SKIPN NUMFL + POPJ P, + MOVEI A,"] ;] FOR CONSTANT + PUSHJ P,PUTREL + SETZM NUMFL + POPJ P, + +PRODC: HRLI A,440700 ;MAKE BYTE POINTER + JRST PRDOC + +LFTPR: SPECN + JRST RDITTS ;IGNORE LP ON STACK + +RCAR: GOHALT ;IMPOSSIBLE FOR THESE TO BE ON STACK +RPAR: GOHALT + +EQAAL: SPECN + SKIPE STRING + PUSHJ P,MVOI + MOVEI A,[ASCIZ ! MOVEM A!] + PUSHJ P,PRODC + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +ENDSAT: SPECN + SKIPN ENDSTT + JRST TOEARL + SKIPE STRING + PUSHJ P,MVOI +GETLF: $GET + CAIE A,12 ;LF + JRST GETLF +IRP AC,,[AA,A,B,C,D,I,P] + MOVE AC,ACSV!AC +TERMIN + JRST SWRET ;GO BACK + +MVOI: MOVE A,BTPNT + ILDB I,A + CAIN I,"& + JRST MVOALR ;OPERAND ALREADY THERE + MOVEI A,[ASCIZ ! MOVE A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVEI A!] +MVOIK: PUSHJ P,PRODC + MOVE A,ENN + AOS ENN +FINOF: PUSHJ P,PUTREL + MOVEI A,", + PUSHJ P,PUTREL + PUSHJ P,PRODB + RETLIN + POPJ P, + +MVOALR: AOS ENN + POPJ P, + +TOEARL: MOAN TOO MANY )'S + +PLUS: MOVEI A,[ASCIZ ! FADR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! ADD A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! ADDI A!] +OPERT: PUSHJ P,PRODC + SKIPE STRING + JRST GAINS + SOS ENN +OPRTE: MOVE A,ENN + SOS A + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +COMMAA: MOVEI A,", + PUSHJ P,PUTREL + MOVEI A,"A + JRST PUTREL + +GAINS: MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +MINUX: MOVEI A,[ASCIZ ! FSBR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! SUB A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! SUBI A!] + JRST OPERT + +TIMES: PUSHJ P,TMSTR + SKIPE IMMED + MOVEI A,[ASCIZ ! IMULI A!] + JRST OPERT + +DIVIX: MOVEI A,[ASCIZ ! FDVR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IDIV A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! IDIVI A!] + JRST OPERT + +UMINU: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE STRING + JRST MOABC + MOVEI A,[ASCIZ ! MOVNS A!] +UMINUC: PUSHJ P,PRODC + MOVE A,ENN + SOS A + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +MOABC: MOVEI A,[ASCIZ ! MOVN A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVNI A!] + PUSHJ P,MVOIK + JRST GAMB + +UABS: CAMN B,C + JRST BAKWD + SKIPE STRING + JRST MOABS + MOVEI A,[ASCIZ ! MOVMS A!] + JRST UMINUC + +MOABS: MOVEI A,[ASCIZ ! MOVM A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVMI A!] + PUSHJ P,MVOIK + JRST GAMB + +MVONT: MOVEI A,[ASCIZ ! MOVE A!] + PUSHJ P,PRODC + MOVE A,ENN + JRST ONMVS + +TMSTR: MOVEI A,[ASCIZ ! FMPR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IMUL A!] + POPJ P, + +BAKWD: PUSH SYM,A + JRST PSOPR + +UDIVI: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE INTEGR + JRST UINDV + SKIPN STRING + PUSHJ P,MVONT + MOVEI A,[ASCIZ ! HRLZI A!] + PUSHJ P,PRODC + MOVE A,ENN + SKIPN STRING + SOS A + PUSHJ P,PUTREL + MOVEI A,[ASCIZ !,201400!] + PUSHJ P,PRODC + RETLIN + AOS ENN + JRST DIVIX + +ONTMS: PUSHJ P,TMSTR + PUSHJ P,PRODC + MOVE A,ENN + SOS A +ONMVS: PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A +LSTCHX: PUSHJ P,PUTREL + RETLIN + POPJ P, + +POWR: GAMB?POWR2?POWAA?POWR4 + +POWR4: PUSHJ P,ONTMS +POWR2: PUSHJ P,ONTMS + JRST GAMB + +POWAA: PUSHJ P,MVONT + AOS ENN + PUSHJ P,ONTMS + SOS ENN + PUSHJ P,TMSTR + PUSHJ P,PRODC + RESTOR + JRST OPRTE + +COMMX: AOS (P) + SKIPE STRING + PUSHJ P,MVOI + JRST GAMB + +UINDV: MOAN INTEGER UNARY DIVIDE + +FUNCT: SETZM EXRET +FUNET: SKIPE STRING + PUSHJ P,MVOI + SPECN + PUSHJ P,MORFMC + MOVEI A,[ASCIZ ! PUSHJ P,!] + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + PUSHJ P,PRODC + PUSHJ P,PRODB + RESTOR + RETLIN + PUSHJ P,MORFNC + SKIPN EXRET + JRST RDITTS ;AS USED FROM FUNCT + JRST COMMT ;AS USED FROM STRSTR + +MORFMC: MOVE A,RANDM + MOVEM A,RANSV' + SKIPN CHARF ;NO ARGUMENTS + AOS ENN + SETOM CHARF + MOVEI A,"1 + CAMN A,ENN ;ARE ARGUMENT ALREADY IN A0 AND UP + POPJ P, + SETZM CORDM +MORYLP: PUSHJ P,ZENBD + AOS CORDM + SOSL RANSV + JRST MORYLP + POPJ P, + +MORFNC: MOVEI A,"1 + CAMN A,ENN + POPJ P, + MOVE A,RANDM + MOVEM A,CORDM' +MORXLP: PUSHJ P,ZENBD + SOSL CORDM + JRST MORXLP + POPJ P, + +ZENBD: MOVEI A,[ASCIZ ! EXCH A!] + PUSHJ P,PRODC + MOVE A,CORDM + ADDI A,"0 + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A + ADD A,CORDM + JRST LSTCHX + +TIPIS: MOVE A,TEMP + MOVEM A,BYTPNT +MORTP: ILDB A,BYTPNT + CAIN A,1 ;EXCLAMATION + POPJ P, + ADDI A," ;SPACE + PUSHJ P,TYO + JRST MORTP + +] ;END .I.FSW CONDITIONAL + +IFN LISTSW,[ + +;LISTING ROUTINES. + +PNTR: MOVEM 17,PNTSA+17 + MOVEI 17,PNTSA + BLT 17,PNTSA+16 + MOVE P,PNTSA+P ; P = 17 so must restore. +IFN P-17, .ERR P=17 assumption at PNTR! + SKIPL LSTONP + JRST PNTR5 + AOSE LISTPF + JRST PNTR1 + SKIPGE T,LISTAD + JRST PNTR2 + PUSHJ P,P6OD + HLRZS T + PUSHJ P,PSOS ;PRINT SPACE OR ' + PUSHJ P,PILPTS +PNTR3: HLRZ T,LISTWD + PUSHJ P,P6OD + MOVS T,LSTRLC + TLNE T,400000 + AOJ T, + PUSHJ P,PSOS + HRRZ T,LISTWD + PUSHJ P,P6OD + HRRZ T,LSTRLC + PUSHJ P,PSOS + PUSHJ P,PILPTS + PUSHJ P,PILPTS +PNTR4: MOVE TT,[440700,,LISTBF] +PNTR6: CAMN TT,PNTBP + JRST PNTR5A + ILDB A,TT + PUSHJ P,PILPT + JRST PNTR6 + +PNTR5A: CALL PNTCR + MOVE A,LISTBC + CAIE A,14 + JRST PNTR7 +PNTR5C: CALL PILPT ;OUTPUT THE ^L, + CALL PNTHDR ;AND THE PAGE NUMBER. + JRST PNTR5D + +PNTR7: MOVEI A,12 + PUSHJ P,PILPT +PNTR5D: SETOM LISTBC +PNTR5: MOVNI A,LISTBS*5-1 + MOVEM A,PNTSW ;DETECT OVERFLOW OF LISTBF + MOVE TT,[440700,,LISTBF] + MOVEM TT,PNTBP + MOVSI 17,PNTSA + BLT 17,17 + POPJ P, + +PNTR5B: MOVE A,LISTBC + CAIN A,14 + JRST PNTR5C + JRST PNTR5D + +PNTR2: MOVEI T,8 + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR3 + +PNTR1: MOVE TT,[440700,,LISTBF] + CAMN TT,PNTBP + JRST PNTR5B + MOVEI T,25. + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR4 + +PSOS: MOVEI A,"' + TRNN T,-1 +PILPTS: MOVEI A,40 + JRST PILPT + +P6OD: MOVE TT,[220300,,T] +P6OD1: ILDB A,TT + ADDI A,"0 + PUSHJ P,PILPT + TLNE TT,770000 + JRST P6OD1 + POPJ P, + +PNTCR: MOVEI A,^M ;OUTPUT ^M TO LST IF OPEN. +PILPTX: SKIPE LSTONP;OUTPUT CHAR TO LST IF LSTING. + JRST PILPT + RET + +PNTHDR: MOVEI A,^I + MOVEI B,10. ;MOVE TO COLUMN 80., + CALL PILPT + SOJG B,.-1 + PUSH P,LSTTTY + HLLOM B,LSTTTY ;POSITIVE SO TYOERR GOES ONLY TO LST. + TYPR [ASCIZ/Page /] + MOVE A,CPGN + CALL [AOJA A,DPNT] + REST LSTTTY +PNTCRR: CALL PNTCR ;OUTPUT CRLF TO LST IF OPEN. +PNTLF: MOVEI A,^J + JRST PILPTX + +DEFINE LSTM %A,B,C +IF1 [ [B] ? [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+LSTM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-LSTM0 +] +TERMIN + +A.LSTFF: AOS (P) ;RETURN NO VALUE. +; ADDR, CONTENTS IF NOT LISTING, CONTENTS IF LISTING. +LSTOFF: LSTM LSTONP,0,-1 + LSTM LSTPLM,[TLO B,4^5][JRST PSHLML] + LSTM RCHLST,RCHLS1,AOSN PNTSW + LSTM RCH1LS,RET,[CAILE A,^M] + LSTM POPLML,JFCL,[IDPB A,PNTBP] + JRST MDSCLR +LSTM0==.-LSTOFF + +LSTON: BLOCK LSTM0-1 + JRST MDSSET + +A.LSTN: SKIPN LISTP1 ;IF SHOULD LIST THIS PASS + JUMPGE FF,MACCR + SKIPE LISTP ;AND WANT LISTING, + CALL LSTON ;TURN ON LISTING OUTPUT. + JRST MACCR + +IFNDEF LISTBS,LISTBS==50. ;LISTBF SIZE IN WORDS. + +VBLK ;LISTING FEATURE VARIABLES + +PNTBP: 0 ;POINTER TO LISTING LINE BUFFER +LSTONP: 0 ;NONZERO WHEN OUTPUTTING TO LISTING FILE. +LISTP: +LISTON: 0 ;-1 IF LISTING ON +PNTSW: 0 ;-1 IF LAST CHR CR OR LF, OR -<# CHARS SPACE LEFT IN LISTBF> +LISTBF: BLOCK LISTBS +LISTAD: 0 ;ADDRESS OR -1 NONE 3.1 RELOC +LISTWD: 0 ;WORD +LSTRLC: 0 ;RELOCATION +LISTPF: 0 ;-1 OTHERS CONTAIN SOMETHING +LISTBC: 0 ;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR +LISTTM: 0 ;TEMP AT AEND +PNTSA: BLOCK 20 ;AC SAVE AREA FOR LISTING FEATURE +LISTP1: 0 ;POSITIVE => WANT TO LIST EVEN ON PASS 1. +] ;END IFN LISTSW, + +IFE LISTSW,VBLK + +;THESE VARIABLES ARE REFERENCED EVEN IF LISTSW IS 0. +LSTTTY: 0 ;TYOERR TYPES ON TTY IFF LE 0, ON LST IF NOT 0. +LSTPLM: TLO B,4^5 ;OR JRST PSHLML ;XCT'D BY PSHLMB. +POPLML: JFCL ;OR IDPB A,PNTSW ;XCT'D IN POPLMB. + +PBLK +IFE LISTSW, A.LSTN: A.LSTF: RET + +VBLK +IFN CREFSW,[ +CREFP: 0 ;SET BY C SWITCH TO REQUEST CREFFING. +CRFONP: 0 ;SET WHILE CREFFING. +CRFLFL: 0 ;LAST PAGNUM,,LINENUM OUTPUT. +CRFINU: JFCL\PUSHJ P,CRFUSE ;XCT THIS TO CREF NON-DEF OCCUR. +CRFLBL: JFCL\PUSHJ P,CRFLB1 ;XCT FOR DEF. OF NORMAL SYM. +CRFEQL: JFCL\PUSHJ P,CRFEQ1 ; FOR DEF. OF NORMAL SYM. OR INTSYM. +CRFMCD: JFCL\PUSHJ P,CRFMC1 ; FOR DEF. OF MACRO. +CRFDEF: JFCL\PUSHJ P,CRFDF1 ; FOR RANDOM DEF, CHECK FLAGS. +] +CRFILE: 0 ;SET => SHOULDN'T OUTPUT PAGNUM,,LINENUM'S +;USED BY .CRFILE INTSYM SO CAN'T BE IN CONDIT. +PBLK +IFN CREFSW,[ +CRFEQ1: MOVEI T,(B) + CAIN A,1 ;IF NOT PSEUDO OR NOT INTSYM, + CAIE T,INTSYM + JRST CRFLB1 ;IS NORMAL SYM. +CRFOD1: MOVSI T,600000 ;ELSE DEFINING INSN. + JRST CRFEQ2 + +CRFDF2: MOVEI T,(B) ;DECIDE WHETHER DEFINING MACRO OR PSEUDO. + CAIE T,MACCL + JRST CRFOD1 +CRFMC1: SKIPA T,[500000,,] ;DEFINING MACRO. +CRFLB1: MOVSI T,440000 ;DEFINING NORMAL SYM. +CRFEQ2: PUSH P,A + MOVE A,T + JRST CRFMA1 + +;COME HERE FOR NON-DEF; MUST DECIDE WHAT TYPE SYM. +CRFUSE: TLNE C,3NCRF ;SYM MAY HAVE CREFFING SUPPRESSED. + POPJ P, + PUSH P,A + CAIN A,1 + JRST CRFMAC ;PSEUDOS, MACROS. + MOVSI A,40000 ;FLAG FOR NORMAL SYM. + TRNN C,-1 + MOVSI A,200000 ;FLAG FOR INSNS. +CRFMA1: PUSH P,A + MOVE A,CLNN + HRL A,CPGN + AOBJN A,.+1 ;A HAS PAGNUM,,LINENUM . + SKIPGE CRFILE ;IF SHOULD OUTPUT IT, + JRST CRFUS1 + CAME A,CRFLFL ;AND HAS CHANGED, DO SO. + PUSHJ P,CRFOUT + MOVEM A,CRFLFL +CRFUS1: POP P,A + IOR A,SYM ;COMBINE SYM AND CREF FLAG. + PUSHJ P,CRFOUT + JRST POPAJ + +CRFMAC: MOVEI A,(B) + CAIN A,MACCL + SKIPA A,[100000,,] ;MACRO + MOVSI A,200000 ;PSEUDO-OP. + JRST CRFMA1 + +;DEFINING OCCURRENCE, MIGHT BE ANY TYPE SYM. +CRFDF1: CAIN A,1 ;TYPE 1 => MACRO OR PSEUDO. + JRST CRFDF2 + TRNE C,-1 ;ELSE INSN OR NORMAL SYM. + JRST CRFLB1 + JRST CRFOD1 + +DEFINE CRFM %A,B,C +IF1 [ [B] + [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+CRFM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-CRFM0] +TERMIN + + +A.CRFFF: AOS (P) ;.CRFOFF - STOP CREFFING. NO VAUE. +; LOCATION, NORMAL VALUE, VALUE WHILE CREFFING +CRFOFF: CRFM CRFONP,0,-1 + CRFM CRFLBL,JFCL,[PUSHJ P,CRFLB1] + CRFM CRFEQL,JFCL,[PUSHJ P,CRFEQ1] + CRFM CRFMCD,JFCL,[PUSHJ P,CRFMC1] + CRFM CRFINU,JFCL,[PUSHJ P,CRFUSE] + CRFM CRFDEF,JFCL,[PUSHJ P,CRFDF1] + POPJ P, +CRFM0==.-CRFOFF + +CRFON: BLOCK CRFM0-1 + POPJ P, + +A.CRFN: JUMPGE FF,MACCR + SKIPE CREFP ;.CRFON, IF HAVE CREF FILE, START CREFFING. + PUSHJ P,CRFON + JRST MACCR +] ;END IFN CREFSW, + +SUBTTL TS Routines for I/O & overall control + +IFN TS,.INSRT TSRTNS + +FEED1: SKIPA B,[40] +FEED: MOVEI B,5 + JRST TFEED + +VBLK + +IFG PURESW-DECSW,[ ;PURIFICATION ROUTINE + +PURIFG: -1 ;-1 IF NOT (YET) PURIFIED +] + VARIAB +VPAT: +VPATCH: BLOCK 20 +VPATCE=.-1 + +PBLK + +CONSTANTS + +PAT: +PATCH: BLOCK 100 +PATCHE: -1 + +IFG PURESW-DECSW,[LOC <.+1777>&-2000 ;SKIP TO NEXT PAGE + MAXPUR==._-10. ;FIRST PAGE ABOVE PURE PAGES +PRINTA Pure pages = ,\MAXPUR-MINPUR +] + +VBLK +PDL: BLOCK LPDL+1 + +IFN DECDBG, DECDBB: BLOCK 8000. ;SPACE FOR DEC DDT'S SYMS. + +.NSTGW +BBKCOD==. ;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION +IFG PURESW-DECSW,MINBNK==<.+1777>_-10. ;FIRST PAGE OF BLANK CODE +BNKBLK ;DUMP OUT ACCUMULATED BLANK CODING + + ;NOW MORE BLANK CODING + +BKBUF: BLOCK BSIZE+5 ;CURRENT BLOCK TO OUTPUT +GLOTB: BLOCK 20 ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING) +STRSTO: BLOCK STRL ;STRING STORAGE FOR GSYL AND FRIENDS +IFN FASLP,[ +FASB: BLOCK FASBL ;OUTPUT BUFFER FOR FASL MODE + ;FIRST WD 9 FOUR BIT CODE GROUPS, REST ASSOC STUFF +FASAT: BLOCK FASATL ;ATOM TABLE FOR FASL MODE + ;EACH ENTRY CONSISTS OF ATOM IN FORMAT DESIRED BY FASLOAD, + ;NAMELY: + ; HEADER WD. RH LENGTH IN WDS + ; 4.8-4.7 TYPE 0-PN 1 FIX 2 FLO 3 BIG (NOT IMPLEMENTED) + ; FOLLOWED BY PN OR VALUE + ;-EXCEPT- IF RH OF HEADER =0, THIS SLOT RESERVED FOR LIST + +] + +EBKCOD==. ;END BLANK CODING +.YSTGW + +PRINTA ST = ,\.-RL0 + +ST: ;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK. + BLOCK NRMWPS*SYMDSZ + +;LITERALS TABLES - CAN MOVE AND GROW. THESE TAGS & LENGTHS ARE JUST THE DEFAULTS +.SEE CONTBA ;ETC, WHICH CONTAIN THE ACTUAL ADDRESSES. SO DON'T USE THEM! +CONTAB: BLOCK LCONTB ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA +CONGLO: BLOCK LCNGLO ;CONSTANTS GLOBAL TABLE, EACH ENTRY TWO WORDS + ;FIRST WD GLOTB ENTRY. SECOND WD ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS +CONBIT: BLOCK LCONTB/12.+1 ;RELOCATION BITS AND ILNOPT BIT(SEE CPTMK) + ;3 BITS FOR EACH WORD OF CONTAB. + +;;INIT ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT) +IFN ITSSW\TNXSW,MINMAC==./2000 ;# OF 1ST PAGE HOLDING PART OF MACTAB. + +;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED +;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF +;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED. +;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO. + +;MAC PROC TABLES +MACTBA: 773767750000 ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S) +INIT1: MOVE CH1,MACTAD ;GET ADDR THIS CODE REALLY STARTS AT. + SUBI CH1,MACTBA ;GET OFFSET FROM WHERE ASSEMBLED. + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1](CH1) + BLT A,EBKCOD-1 ;CLEAR OUT BLANK CODING + PUSH P,[SP4](CH1) ;NOW INIT THE SYMTAB & FINISHED. + +;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN. +INITS: MOVE AA,SYMLEN ;SET UP THE OTHER VARS + IMUL AA,WPSTE ;DEALING WITH SYMTAB SIZE. + MOVEM AA,SYMSIZ + ADDI AA,ST ;ADDR OF START OF CONTAB. + MOVEM AA,CONTBA + MOVEM AA,PLIM + ADD AA,CONLEN ;ADD LENGTH OF CONTAB TO GET ADDR OF CONGLO TAB. + MOVEM AA,CONTBE ;WHICH IS ALSO THE END OF CONTAB. + MOVEM AA,CONGLA + MOVEM AA,CONGOL + MOVE A,CONLEN ;ADD IN LENGTH OF CONGLO (1/4 OF CONLEN) + LSH A,-2 + ADD AA,A + MOVEM AA,CONGLE ;TO GET END OF CONGLO, AND START OF CONBIT TABLE. + MOVEM AA,CONBIA + MOVE A,CONLEN + ADDI A,11. + IDIVI A,12. + ADD AA,A ;ADD LENGTH OF CONBIT (1/12 OF CONLEN) GETTING ADDR OF MACTAB. +IFN DECSW,[ + PUSH P,AA + ADDI AA,MACL-1 + IORI AA,1777 ;FIX ALLOCATION PROBLEMS ON KI-10 + CORE AA, + ETF [ASCIZ /No core for symbols/](CH1) + REST AA +] + MOVN A,SYMLEN + HRLZM A,SYMAOB ;AOBJN -> SYMTAB. + MOVE A,WPSTE + SUBI A,1 + MOVEM A,WPSTE1 + MOVN A,WPSTE + HRRM A,WPSTEB + CAMG AA,MACTAD ;MOVED MACTAB UP? + JRST INITS1(CH1) +IFN ITSSW\TNXSW,[ ;YES, GET CORE FOR INCREASE. + PUSH P,AA + MOVEI AA,MACL+1777(AA) + LSH AA,-10. ;1ST PAGE NOT NEEDED BY MACTAB. + MOVEI A,MACL+1777+MACTBA(CH1) + LSH A,-10. ;1ST PAGE MACTAB DOESN'T YET HAVE. + SUBM A,AA ;# PAGES NEEDED. + HRLZI AA,(AA) + HRRI AA,(A) ;-<# PAGES>,,<1ST NEEDED> + CAIGE AA, ; Don't call if don't need any pages. + CALL CORGET ; Get the pages + REST AA +] + SUBM AA,MACTAD ;MACTAD _ SHIFT IN START OF MACTAB. + EXCH AA,MACTAD ;MACTAD GETS NEW START, AA HAS SHIFT. + MOVSI A,PTAB-CCOMPB + ADDM AA,PTAB(A) ;RELOCATE BYTE-PTRS INTO MACTAB. + AOBJN A,.-1(CH1) + MOVNI B,INITS2(CH1) + HRROI A,@EISYMP(CH1) + ADDI B,1(A) ;GET # WDS IN SECOND HALF OF INIT CODE. + HRRM AA,.+1(CH1) ;COPY 2ND HALF UPWARD WITH POP-LOOP. + POP A,(A) ;THIS INSN IMPURE. + SOJG B,.-1(CH1) + ADDI CH1,(AA) ;CHANGE OFFSET TO PT. TO NEW LOCATIONN OF INIT CODE. + JRST INITS2(CH1) ;JUMP INTO 2ND HALF, WHERE IT'S BEEN COPIED TO. +INITS2: HRROI A,INITS2-1(CH1) ;THEN COPY 1ST HALF (WHICH ENNDS BEFORE INITS2) + SUBI A,(AA) ;GET WHERE NOW ENDS, NOT WHERE WILL END. + MOVEI B,INITS2-MACTBA ;UP UNDERNEATH THE 2ND HALF. + HRRM AA,.+1(CH1) ;(THIS TWO-STEP COPYING HANDLES ALL OVERLAPS) + POP A,(A) + SOJG B,.-1(CH1) +INITS1: MOVE AA,SYMSIZ + SETZM ST + MOVE A,[ST,,ST+1](CH1) + BLT A,ST-1(AA) ;CLEAR OUT SYMBOL TABLE + SETZM ESBK ;DEFINE THEM IN OUTER BLOCK. + MOVEI AA,ISYMTB(CH1) + MOVS F,ISMTBB(CH1) ;GET SWAPPED VALUE OF FIRST INSTRUCTION +SP3: CAIL AA,EISYM1(CH1) + JRST SP1(CH1) ;DONE WITH INSTRUCTIONS + MOVE SYM,(AA) + JUMPE SYM,SP2(CH1) + TLZ SYM,740000 + PUSHJ P,ES ;WON'T SKIP + CAIA + GOHALT ;INSTRUCTION PRESENT TWICE IN TABLE!!?!? + HRLZI T,SYMC + HRLZ B,F + MOVSI C,3KILL + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP2: ADDI F,1000 + AOJA AA,SP3(CH1) +;AFTER HACKING ALL THE INSTRUCTIONS, STORED AS JUST THE NAMES IN NUMERIC ORDER, +;HACK ALL THE OTHER PREDEFINED SYMS, STORED AS 2 WORDS (NAME ? VALUE). +EISYMP: ;MAY BE MUNGED IF MORE SYMBOLS ARE ADDED AFTER EISYMT. +SP1: CAIL AA,EISYMT(CH1) + POPJ P, + MOVE SYM,(AA) + LDB T,[400400,,SYM](CH1) + ROT T,-4 + TLZ SYM,740000 + PUSHJ P,ES + CAIA + JRST SP5(CH1) ;SYM ALREADY DEFINED? (MIGHT BE .UAI, IN ITS AND IN MIDAS). + MOVE B,1(AA) + MOVSI C,3KILL + CAME T,[GLOETY,,](CH1) ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING + CAMN T,[GLOEXT,,](CH1) + TLO C,3LLV + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP5: AOS AA + AOJA AA,SP1(CH1) + +CONSTANTS ; Constants for init code above + +;;ISYMS ;INITIAL SYMBOL TABLE - NOT HASHED + +IFNDEF JSYS,JSYS=104_33 ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE + +ISMTBB: JSYS ;FIRST OP. CODE IN ISYMTB + +ISYMTB: + +; 104-177 (JSYS - FDVRB) + +SQUOZE 10,JSYS ;BBN PAGER INSTRUCTION +SQUOZE 10,ADJSP ;KL10 INSTRUCTION + 0 + 0 + +SQUOZE 10,DFAD ;KI10 INSTRUCTION +SQUOZE 10,DFSB ;KI10 INSTRUCTION +SQUOZE 10,DFMP ;KI10 INSTRUCTION +SQUOZE 10,DFDV ;KI10 INSTRUCTION +SQUOZE 10,DADD ;KL10 INSTRUCTION +SQUOZE 10,DSUB ;KL10 INSTRUCTION +SQUOZE 10,DMUL ;KL10 INSTRUCTION +SQUOZE 10,DDIV ;KL10 INSTRUCTION +SQUOZE 10,DMOVE ;KI10 INSTRUCTION +SQUOZE 10,DMOVN ;KI10 INSTRUCTION + +SQUOZE 10,FIX ;KI10 INSTRUCTION +SQUOZE 10,EXTEND ;KL10 INSTRUCTION +SQUOZE 10,DMOVEM ;KI10 INSTRUCTION +SQUOZE 10,DMOVNM ;KI10 INSTRUCTION +SQUOZE 10,FIXR ;KI10 INSTRUCTION +SQUOZE 10,FLTR ;KI10 INSTRUCTION + +SQUOZE 10,UFA ;KA/KI10 INSTRUCTION +SQUOZE 10,DFN ;KA/KI10 INSTRUCTION +SQUOZE 10,FSC + +SQUOZE 10,IBP +SQUOZE 10,ILDB +SQUOZE 10,LDB +SQUOZE 10,IDPB +SQUOZE 10,DPB + +SQUOZE 10,FAD +SQUOZE 10,FADL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FADM +SQUOZE 10,FADB +SQUOZE 10,FADR +SQUOZE 10,FADRI ;PDP10 INSTRUCTION +SQUOZE 10,FADRM +SQUOZE 10,FADRB +SQUOZE 10,FSB +SQUOZE 10,FSBL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FSBM +SQUOZE 10,FSBB +SQUOZE 10,FSBR +SQUOZE 10,FSBRI ;PDP10 INSTRUCTION +SQUOZE 10,FSBRM +SQUOZE 10,FSBRB +SQUOZE 10,FMP +SQUOZE 10,FMPL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FMPM +SQUOZE 10,FMPB +SQUOZE 10,FMPR +SQUOZE 10,FMPRI ;PDP10 INSTRUCTION +SQUOZE 10,FMPRM +SQUOZE 10,FMPRB +SQUOZE 10,FDV +SQUOZE 10,FDVL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FDVM +SQUOZE 10,FDVB +SQUOZE 10,FDVR +SQUOZE 10,FDVRI ;PDP10 INSTRUCTION +SQUOZE 10,FDVRM +SQUOZE 10,FDVRB + +; 200-277 (MOVE - SUBB) + +SQUOZE 10,MOVE +SQUOZE 10,MOVEI +SQUOZE 10,MOVEM +SQUOZE 10,MOVES +SQUOZE 10,MOVS +SQUOZE 10,MOVSI +SQUOZE 10,MOVSM +SQUOZE 10,MOVSS +SQUOZE 10,MOVN +SQUOZE 10,MOVNI +SQUOZE 10,MOVNM +SQUOZE 10,MOVNS +SQUOZE 10,MOVM +SQUOZE 10,MOVMI +SQUOZE 10,MOVMM +SQUOZE 10,MOVMS + +SQUOZE 10,IMUL +SQUOZE 10,IMULI +SQUOZE 10,IMULM +SQUOZE 10,IMULB +SQUOZE 10,MUL +SQUOZE 10,MULI +SQUOZE 10,MULM +SQUOZE 10,MULB +SQUOZE 10,IDIV +SQUOZE 10,IDIVI +SQUOZE 10,IDIVM +SQUOZE 10,IDIVB +SQUOZE 10,DIV +SQUOZE 10,DIVI +SQUOZE 10,DIVM +SQUOZE 10,DIVB + +SQUOZE 10,ASH +SQUOZE 10,ROT +SQUOZE 10,LSH +SQUOZE 10,JFFO ;PDP10 INSTRUCTION +SQUOZE 10,ASHC +SQUOZE 10,ROTC +SQUOZE 10,LSHC +SQUOZE 10,CIRC ;AI PDP10 INST. CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY + +SQUOZE 10,EXCH +SQUOZE 10,BLT +SQUOZE 10,AOBJP +SQUOZE 10,AOBJN +SQUOZE 10,JRST +SQUOZE 10,JFCL +SQUOZE 10,XCT +SQUOZE 10,MAP ;KI10 INSTRUCTION + +SQUOZE 10,PUSHJ +SQUOZE 10,PUSH +SQUOZE 10,POP +SQUOZE 10,POPJ +SQUOZE 10,JSR +SQUOZE 10,JSP +SQUOZE 10,JSA +SQUOZE 10,JRA + +SQUOZE 10,ADD +SQUOZE 10,ADDI +SQUOZE 10,ADDM +SQUOZE 10,ADDB +SQUOZE 10,SUB +SQUOZE 10,SUBI +SQUOZE 10,SUBM +SQUOZE 10,SUBB + +; 300-377 (CAI - SOSG) + +SQUOZE 10,CAI +SQUOZE 10,CAIL +SQUOZE 10,CAIE +SQUOZE 10,CAILE +SQUOZE 10,CAIA +SQUOZE 10,CAIGE +SQUOZE 10,CAIN +SQUOZE 10,CAIG +SQUOZE 10,CAM +SQUOZE 10,CAML +SQUOZE 10,CAME +SQUOZE 10,CAMLE +SQUOZE 10,CAMA +SQUOZE 10,CAMGE +SQUOZE 10,CAMN +SQUOZE 10,CAMG + +SQUOZE 10,JUMP +SQUOZE 10,JUMPL +SQUOZE 10,JUMPE +SQUOZE 10,JUMPLE +SQUOZE 10,JUMPA +SQUOZE 10,JUMPGE +SQUOZE 10,JUMPN +SQUOZE 10,JUMPG +SQUOZE 10,SKIP +SQUOZE 10,SKIPL +SQUOZE 10,SKIPE +SQUOZE 10,SKIPLE +SQUOZE 10,SKIPA +SQUOZE 10,SKIPGE +SQUOZE 10,SKIPN +SQUOZE 10,SKIPG + +SQUOZE 10,AOJ +SQUOZE 10,AOJL +SQUOZE 10,AOJE +SQUOZE 10,AOJLE +SQUOZE 10,AOJA +SQUOZE 10,AOJGE +SQUOZE 10,AOJN +SQUOZE 10,AOJG +SQUOZE 10,AOS +SQUOZE 10,AOSL +SQUOZE 10,AOSE +SQUOZE 10,AOSLE +SQUOZE 10,AOSA +SQUOZE 10,AOSGE +SQUOZE 10,AOSN +SQUOZE 10,AOSG +SQUOZE 10,SOJ +SQUOZE 10,SOJL +SQUOZE 10,SOJE +SQUOZE 10,SOJLE +SQUOZE 10,SOJA +SQUOZE 10,SOJGE +SQUOZE 10,SOJN +SQUOZE 10,SOJG +SQUOZE 10,SOS +SQUOZE 10,SOSL +SQUOZE 10,SOSE +SQUOZE 10,SOSLE +SQUOZE 10,SOSA +SQUOZE 10,SOSGE +SQUOZE 10,SOSN +SQUOZE 10,SOSG + +; 400-477 (SETZ - SETOB) + +SQUOZE 10,SETZ +SQUOZE 10,SETZI +SQUOZE 10,SETZM +SQUOZE 10,SETZB +SQUOZE 10,AND +SQUOZE 10,ANDI +SQUOZE 10,ANDM +SQUOZE 10,ANDB +SQUOZE 10,ANDCA +SQUOZE 10,ANDCAI +SQUOZE 10,ANDCAM +SQUOZE 10,ANDCAB +SQUOZE 10,SETM +SQUOZE 10,SETMI +SQUOZE 10,SETMM +SQUOZE 10,SETMB +SQUOZE 10,ANDCM +SQUOZE 10,ANDCMI +SQUOZE 10,ANDCMM +SQUOZE 10,ANDCMB +SQUOZE 10,SETA +SQUOZE 10,SETAI +SQUOZE 10,SETAM +SQUOZE 10,SETAB +SQUOZE 10,XOR +SQUOZE 10,XORI +SQUOZE 10,XORM +SQUOZE 10,XORB +SQUOZE 10,IOR +SQUOZE 10,IORI +SQUOZE 10,IORM +SQUOZE 10,IORB +SQUOZE 10,ANDCB +SQUOZE 10,ANDCBI +SQUOZE 10,ANDCBM +SQUOZE 10,ANDCBB +SQUOZE 10,EQV +SQUOZE 10,EQVI +SQUOZE 10,EQVM +SQUOZE 10,EQVB +SQUOZE 10,SETCA +SQUOZE 10,SETCAI +SQUOZE 10,SETCAM +SQUOZE 10,SETCAB +SQUOZE 10,ORCA +SQUOZE 10,ORCAI +SQUOZE 10,ORCAM +SQUOZE 10,ORCAB +SQUOZE 10,SETCM +SQUOZE 10,SETCMI +SQUOZE 10,SETCMM +SQUOZE 10,SETCMB +SQUOZE 10,ORCM +SQUOZE 10,ORCMI +SQUOZE 10,ORCMM +SQUOZE 10,ORCMB +SQUOZE 10,ORCB +SQUOZE 10,ORCBI +SQUOZE 10,ORCBM +SQUOZE 10,ORCBB +SQUOZE 10,SETO +SQUOZE 10,SETOI +SQUOZE 10,SETOM +SQUOZE 10,SETOB + +; 500-577 (HLL - HLRES) + +SQUOZE 10,HLL +SQUOZE 10,HLLI +SQUOZE 10,HLLM +SQUOZE 10,HLLS +SQUOZE 10,HRL +SQUOZE 10,HRLI +SQUOZE 10,HRLM +SQUOZE 10,HRLS +SQUOZE 10,HLLZ +SQUOZE 10,HLLZI +SQUOZE 10,HLLZM +SQUOZE 10,HLLZS +SQUOZE 10,HRLZ +SQUOZE 10,HRLZI +SQUOZE 10,HRLZM +SQUOZE 10,HRLZS +SQUOZE 10,HLLO +SQUOZE 10,HLLOI +SQUOZE 10,HLLOM +SQUOZE 10,HLLOS +SQUOZE 10,HRLO +SQUOZE 10,HRLOI +SQUOZE 10,HRLOM +SQUOZE 10,HRLOS +SQUOZE 10,HLLE +SQUOZE 10,HLLEI +SQUOZE 10,HLLEM +SQUOZE 10,HLLES +SQUOZE 10,HRLE +SQUOZE 10,HRLEI +SQUOZE 10,HRLEM +SQUOZE 10,HRLES +SQUOZE 10,HRR +SQUOZE 10,HRRI +SQUOZE 10,HRRM +SQUOZE 10,HRRS +SQUOZE 10,HLR +SQUOZE 10,HLRI +SQUOZE 10,HLRM +SQUOZE 10,HLRS +SQUOZE 10,HRRZ +SQUOZE 10,HRRZI +SQUOZE 10,HRRZM +SQUOZE 10,HRRZS +SQUOZE 10,HLRZ +SQUOZE 10,HLRZI +SQUOZE 10,HLRZM +SQUOZE 10,HLRZS +SQUOZE 10,HRRO +SQUOZE 10,HRROI +SQUOZE 10,HRROM +SQUOZE 10,HRROS +SQUOZE 10,HLRO +SQUOZE 10,HLROI +SQUOZE 10,HLROM +SQUOZE 10,HLROS +SQUOZE 10,HRRE +SQUOZE 10,HRREI +SQUOZE 10,HRREM +SQUOZE 10,HRRES +SQUOZE 10,HLRE +SQUOZE 10,HLREI +SQUOZE 10,HLREM +SQUOZE 10,HLRES + +; 600-677 (TRN - TSON) + +SQUOZE 10,TRN +SQUOZE 10,TLN +SQUOZE 10,TRNE +SQUOZE 10,TLNE +SQUOZE 10,TRNA +SQUOZE 10,TLNA +SQUOZE 10,TRNN +SQUOZE 10,TLNN +SQUOZE 10,TDN +SQUOZE 10,TSN +SQUOZE 10,TDNE +SQUOZE 10,TSNE +SQUOZE 10,TDNA +SQUOZE 10,TSNA +SQUOZE 10,TDNN +SQUOZE 10,TSNN +SQUOZE 10,TRZ +SQUOZE 10,TLZ +SQUOZE 10,TRZE +SQUOZE 10,TLZE +SQUOZE 10,TRZA +SQUOZE 10,TLZA +SQUOZE 10,TRZN +SQUOZE 10,TLZN +SQUOZE 10,TDZ +SQUOZE 10,TSZ +SQUOZE 10,TDZE +SQUOZE 10,TSZE +SQUOZE 10,TDZA +SQUOZE 10,TSZA +SQUOZE 10,TDZN +SQUOZE 10,TSZN +SQUOZE 10,TRC +SQUOZE 10,TLC +SQUOZE 10,TRCE +SQUOZE 10,TLCE +SQUOZE 10,TRCA +SQUOZE 10,TLCA +SQUOZE 10,TRCN +SQUOZE 10,TLCN +SQUOZE 10,TDC +SQUOZE 10,TSC +SQUOZE 10,TDCE +SQUOZE 10,TSCE +SQUOZE 10,TDCA +SQUOZE 10,TSCA +SQUOZE 10,TDCN +SQUOZE 10,TSCN +SQUOZE 10,TRO +SQUOZE 10,TLO +SQUOZE 10,TROE +SQUOZE 10,TLOE +SQUOZE 10,TROA +SQUOZE 10,TLOA +SQUOZE 10,TRON +SQUOZE 10,TLON +SQUOZE 10,TDO +SQUOZE 10,TSO +SQUOZE 10,TDOE +SQUOZE 10,TSOE +SQUOZE 10,TDOA +SQUOZE 10,TSOA +SQUOZE 10,TDON +SQUOZE 10,TSON + +EISYM1: + +; I/O INSTRUCTIONS + +SQUOZE 4,BLKI +BLKI IOINST +SQUOZE 4,DATAI +DATAI IOINST +SQUOZE 4,BLKO +BLKO IOINST +SQUOZE 4,DATAO +DATAO IOINST +SQUOZE 4,CONO +CONO IOINST +SQUOZE 4,CONI +CONI IOINST +SQUOZE 4,CONSZ +CONSZ IOINST +SQUOZE 4,CONSO +CONSO IOINST + +;EXTEND MNEMONICS + +SQUOZE 10,CMPSL +001000,, +SQUOZE 10,CMPSE +002000,, +SQUOZE 10,CMPSLE +003000,, +SQUOZE 10,EDIT +004000,, +SQUOZE 10,CMPSGE +005000,, +SQUOZE 10,CMPSN +006000,, +SQUOZE 10,CMPSG +007000,, +SQUOZE 10,CVTDBO +010000,, +SQUOZE 10,CVTDBT +011000,, +SQUOZE 10,CVTBDO +012000,, +SQUOZE 10,CBTBDT +013000,, +SQUOZE 10,MOVSO +014000,, +SQUOZE 10,MOVST +015000,, +SQUOZE 10,MOVSLJ +016000,, +SQUOZE 10,MOVSRJ +017000,, +SQUOZE 10,XBLT +020000,, + +;OLD PROGRAMS USE THESE NAMES + +SQUOZE 10,CLEAR +SETZ +SQUOZE 10,CLEARI +SETZI +SQUOZE 10,CLEARM +SETZM +SQUOZE 10,CLEARB +SETZB + +;RANDOM ALIAS NAMES + +SQUOZE 10,ERJMP ; TOPS-20 JSYS-error dispatch (becomes JRST) +JUMP 16, +SQUOZE 10,ERCAL ; TOPS-20 JSYS-error call (becomes PUSHJ 17,) +JUMP 17, +SQUOZE 10,ADJBP ;KL10 FORM OF IBP WITH VARIABLE NUMBER TO INCREMENT +IBP +SQUOZE 10,JFOV ;PDP10 INSTRUCTION (PC CHANGE ON PDP6) +JFCL 1, +SQUOZE 10,JCRY1 +JFCL 2, +SQUOZE 10,JCRY0 +JFCL 4, +SQUOZE 10,JCRY +JFCL 6, +SQUOZE 10,JOV +JFCL 10, +SQUOZE 10,PORTAL ;KI10 INSTRUCTION +JRST 1, +SQUOZE 10,JRSTF +JRST 2, +SQUOZE 10,HALT +JRST 4, +SQUOZE 10,XJRSTF ;KL10 INSTRUCTION +JRST 5, +SQUOZE 10,XJEN ;KL10 INSTRUCTION +JRST 6, +SQUOZE 10,XPCW ;KL10 INSTRUCTION +JRST 7, +SQUOZE 10,JEN +JRST 12, +SQUOZE 10,SFM ;KL10 INSTRUCTION +JRST 14, +SQUOZE 10,XMOVEI ;KL10 INSTRUCTION +SETMI +SQUOZE 10,XHLLI ;KL10 INSTRUCTION +HLLI + +;PDP6 HAS LONG FORM ROUNDED INSTEAD OF IMMEDIATES + +IRPS INST,,FAD FSB FMP FDV + SQUOZE 10,INST!RL + INST!RI +TERMIN + +; MIDAS pseudo definitions + +SQUOZE 10,.OSMID ; Crock here - in TNX version, SITINI sets value at +OSMID: OSMIDAS ; runtime before syms spread. +SQUOZE 4,.SITE +A.SITE +SQUOZE 4,RIM10 +ARIM10,,SRIM +SQUOZE 4,SBLK +SBLKS,,SRIM +SQUOZE 4,RIM +ARIM,,SRIM +SQUOZE 4,SQUOZE +ASQOZ +SQUOZE 4,.RSQZ +-1,,ASQOZ +SQUOZE 4,XWD +AXWORD +SQUOZE 4,CONSTA +CNSTNT +SQUOZE 4,ASCIC +EOFCH,,AASCIZ +SQUOZE 4,RADIX +ARDIX + +SQUOZE 4,END +AEND +SQUOZE 4,TITLE +ATITLE +SQUOZE 4,.BEGIN +A.BEGIN +SQUOZE 4,.END +A.END +SQUOZE 4,VARIAB +AVARIAB +SQUOZE 4,SIXBIT +ASIXBIT +SQUOZE 4,ASCII +AASCII +SQUOZE 4,ASCIZ +AASCIZ +SQUOZE 4,.ASCII +A.ASCII +SQUOZE 4,.ASCVL +A.ASCV +SQUOZE 4,BLOCK +ABLOCK +SQUOZE 4,LOC +ALOC +SQUOZE 4,OFFSET +AOFFSET +SQUOZE 4,.SBLK +SIMBLK +SQUOZE 4,RELOCA +ARELOCA +SQUOZE 4,1PASS +A1PASS +SQUOZE 4,.DECSA +A.DECSA +SQUOZE 4,.DECRE +A.DECRE +SQUOZE 4,.DECTX +A.DCTX + +SQUOZE 4,.DECTW +A.DECTW +SQUOZE 4,NOSYMS +ANOSYMS +SQUOZE 4,EXPUNGE +AEXPUNGE +SQUOZE 4,EQUALS +AEQUALS +SQUOZE 4,NULL +ANULL +SQUOZE 4,SUBTTL +ANULL +SQUOZE 4,WORD +AWORD +SQUOZE 4,.SYMTAB +A.SYMTAB +SQUOZE 4,.SEE +A.SEE +SQUOZE 4,.AUXIL +MACCR +SQUOZE 4,.MRUNT +A.MRUNT +SQUOZE 4,.SYMCN +A.SYMC +SQUOZE 4,.TYPE +A.TYPE +SQUOZE 4,.FORMAT +A.FORMAT +SQUOZE 4,.OP +A.OP +SQUOZE 4,.AOP +A.AOP +SQUOZE 4,.RADIX +A.RADIX +SQUOZE 4,.FATAL +A.FATAL +SQUOZE 4,.BP +A.BP +SQUOZE 4,.BM +A.BM +SQUOZE 4,.LZ +A.LZ +SQUOZE 4,.TZ +A.TZ +SQUOZE 4,.DPB +A.DPB +SQUOZE 4,.LDB +A.LDB +SQUOZE 4,.IBP +A.IBP +SQUOZE 4,.1STWD +A.1STWD +SQUOZE 4,.NTHWD +A.NTHWD + +IRPS X,,[.BIND=0,.KILL=3KILL,.HKILL=3SKILL,.XCREF=3NCRF,.DOWN=3DOWN] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,A.KILL +TERMIN + +SQUOZE 4,.LSTON +A.LSTN +SQUOZE 4,.LSTOF +A.LSTF + +IRPS X,,[.MLLIT=CONSML,.PASS=A.PASS,.PPASS=A.PPASS,.SUCCESS=A.SUCCESS +.HKALL=HKALL,.STGSW=STGSW,.LITSW=LITSW,.AVAL1=AVAL1,.AVAL2=AVAL2,.ERRCNT=ERRCNT +.ASKIP=A.ASKIP,.CURLN=CLNN,.CURPG=CPGN,.QMTCH=QMTCH,.STPLN=A.STPLN,.STPPG=A.STPPG] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,INTSYM +TERMIN + +;CONDITIONALS (SEE ALSO IFSE, IFSN) + +SQUOZE 4,IFG +JUMPG A,COND +SQUOZE 4,IFGE +JUMPGE A,COND +SQUOZE 4,IFE +JUMPE A,COND +SQUOZE 4,IFLE +JUMPLE A,COND +SQUOZE 4,IFL +JUMPL A,COND +SQUOZE 4,IFN +JUMPN A,COND +SQUOZE 4,.ELSE +SKIPE A.ELSE +SQUOZE 4,.ALSO +SKIPN A.ELSE + +SQUOZE 4,IF1 +TRNE FF,COND1 +SQUOZE 4,IF2 +TRNN FF,COND1 +SQUOZE 4,IFDEF ;ASSEMBLE IF SYM DEFINED +JUMPG A,DEFCND +SQUOZE 4,IFNDEF ;ASSEMBLE IF SYM NOT DEFINED +JUMPE A,DEFCND +SQUOZE 4,IFB ;ASSEMBLE IF STRING BLANK (HAS NO SQUOZE CHARS) +JUMPLE C,SBCND +SQUOZE 4,IFNB ;ASSEMBLE IF STRING NOT BLANK +JUMPG C,SBCND +SQUOZE 4,IFSQ ;ASSEMBLE IF STRING ARG IS ALL SQUOZE +JUMPLE B,SBCND +SQUOZE 4,IFNSQ ;ASSEMBLE IF STRING ARG IS NOT ALL SQUOZE. +JUMPG B,SBCND + +SQUOZE 4,PRINTX +APRIN2,,APRINT +SQUOZE 4,PRINTC +APRIN3,,APRINT +SQUOZE 4,COMMEN +APRIN1,,APRINT +SQUOZE 4,.TYO +A.TYO +SQUOZE 4,.TYO6 +A.TYO6 +SQUOZE 4,.ERR +A.ERR + +SQUOZE 4,.RELP +A.RELP +SQUOZE 4,.ABSP +A.ABSP +SQUOZE 4,.RL1 +A.RL1 +SQUOZE 4,.LIBRA +LLIB,,A.LIB +SQUOZE 4,.LENGTH +A.LENGTH +SQUOZE 4,.LIFS +LTCP,,A.LIB +SQUOZE 4,.ELDC +A.ELDC +IRPS A,,E N G LE GE L +SQUOZE 4,.LIF!A +JUMP!A A.LDCV +TERMIN +SQUOZE 4,.SLDR +A.SLDR + +SQUOZE 4,. +GTVLP +SQUOZE 4,.LOP +A.LOP +SQUOZE 40,$. +0 +SQUOZE 44,$R. +0 +SQUOZE 40,$O. ;(OH) GLOBAL OFFSET +0 +SQUOZE 40,$L. ;REAL LOCATION (WITHOUT OFFSET) +0 +SQUOZE 40,.LVAL1 +0 +SQUOZE 40,.LVAL2 +0 +SQUOZE 4,.LNKOT +A.LNKOT +SQUOZE 4,.NSTGW +1,,STGWS +SQUOZE 4,.YSTGW +-1,,STGWS +SQUOZE 4,.LIBRQ +A.LIBRQ +SQUOZE 4,.GLOBAL +ILGLI,,A.GLOB +SQUOZE 4,.SCALAR +ILVAR,,A.GLOB +SQUOZE 4,.VECTOR +ILVAR\ILFLO,,A.GLOB + +SQUOZE 4,.BYTC +NBYTS,,INTSYM +SQUOZE 4,.BYTE +A.BYTE +SQUOZE 4,.WALGN +A.WALGN + +;CREF PSEUDO-OPS. +SQUOZE 4,.CRFON +A.CRFN ;START CREFFING. +SQUOZE 4,.CRFOFF +A.CRFFF ;STOP CREFFING. +SQUOZE 4,.CRFIL +CRFILE,,INTSYM + +IFE CREFSW,[ + A.CRFN==ASSEM1 ;THESE DO NOTHING IF CAN'T CREF. + A.CRFFF==ASSEM1 +] + +IFN MACSW,[ ;MACRO PROCESSOR PSEUDOS +;MACROS GET DEFINED AS +;SQUOZE 4, +;,, MACCL + +SQUOZE 4,REPEAT +AREPEAT +SQUOZE 4,DEFINE +ADEFINE +SQUOZE 4,IRP +NIRPO,,AIRP +SQUOZE 4,IRPC +NIRPC,,AIRP +SQUOZE 4,IRPS +NIRPS,,AIRP +SQUOZE 4,IRPW +NIRPW,,AIRP +SQUOZE 4,IRPNC +NIRPN,,AIRP +SQUOZE 4,TERMIN +ATERMIN +SQUOZE 4,.QUOTE +A.QOTE +SQUOZE 4,.STOP +(400000)A.STOP +SQUOZE 4,.ISTOP +A.STOP +SQUOZE 4,.RPCNT +CRPTCT,,INTSYM +SQUOZE 4,.GSSET +A.GSSET +SQUOZE 4,.GSCNT +GENSM,,INTSYM +SQUOZE 4,.GO +A.GO +SQUOZE 4,.TAG +A.TAG +SQUOZE 4,.IRPCNT +CIRPCT,,INTSYM +IFN RCHASW,[SQUOZE 4,.TTYMAC +A.TTYM +] +SQUOZE 4,IFSE +SKIPN SCOND +SQUOZE 4,IFSN +SKIPE SCOND +] + +IFN FASLP,[ +SQUOZE 4,.FASL +A.FASL +SQUOZE 4,.ARRAY ;3 INDEX TO AFDMY1 TBL +AFATOM(3) +SQUOZE 4,.ATOM +AFATOM(AFDMAI) ;2 INDEX TO AFDMY1 TBL +AFDMAI==2 ;INDEX OF ATOM IN AFDMY1 TBL +SQUOZE 4,.FUNCT +AFATOM(1) ;1 " " " " +SQUOZE 4,.SPECI +AFATOM(0) ;0 " " " " +SQUOZE 4,.SX +AFLIST(1) ;NORMAL LIST +SQUOZE 4,.SXEVA +AFLIST ;EVAL LIST AND THROW VALUE AWAY +SQUOZE 4,.SXE +AFLIST(2) ;EVAL LIST AND "RETURN" VALUE +SQUOZE 4,.ENTRY +AFENTY ;DECLARE LISP ENTRY POINT (SUBR ETC) +] + +IFN TS,[ +SQUOZE 4,.FNAM1 +RFNAM1,,INTSYM +SQUOZE 4,.FNAM2 +RFNAM2,,INTSYM +SQUOZE 4,.FVERS +RFVERS,,INTSYM +SQUOZE 4,.INSRT +A.INSRT +SQUOZE 4,.INEOF +A.INEO +IRPS X,,I O + IRPS Y,,1 2 + SQUOZE 4,.!X!FNM!Y + X!FNM!Y,,INTSYM +TERMIN TERMIN +SQUOZE 4,.IFVRS +IFVRS,,INTSYM +SQUOZE 4,.TTYFLG +A.TTYFLG,,INTSYM +] ;IFN TS + +IFN .I.FSW,[ +SQUOZE 4,.F +A.F +SQUOZE 4,.I +A.I +] + +; Finally insert system-dependent initial symbols and wrap everything up. + +IFN ITSSW,[ +IRPS X,,UAI UAO BAI BAO UII UIO BII BIO +SQUOZE 10,.!X +.IRPCN +TERMIN + +IRPS X,Y,START LFILE STP+SYM JCL PFILE STB CONV+XUNAME XJNAME LJB+ + SQUOZE 10,..R!X + .IRPCN+1 +IFSN Y,+,[ + SQUOZE 10,..S!X + 400000+.IRPCN+1 +] TERMIN + +] ;IFN ITSSW + + +; Now re-insert system-dependent symbol definition files so that they +; become part of the initial symtab that MIDAS knows about. This does +; not need to be done for ITS since those symbols are acquired from the +; system at run time (and thus are always current). + +ISYSYM: ; Remember start of system symbols + +; Redefine DEFSYM so as to make entry into initial symbol table. +; Note that this will lose if the code for MIDAS has re-defined any +; of the symbols inserted from these files at the beginning of MIDAS. +; Everything in these files should use =: or ==: to catch redefinitions! + +DEFINE DEFSYM X/ + IRPS Z,,[X] + SQUOZE 8.,Z + Z + .ISTOP + TERMIN +TERMIN + +IFN DECSW,[ ; Define UUOs for DEC version +IFE CVTSW,[ + .DECDF DEFSYM + IFN DECBSW,.INSRT DECBTS +];IFE CVTSW +IFN CVTSW, .INSRT DECDFU +] ;IFN DECSW + +IFN TNXSW,[ ; Define JSYSes for TENEX/TOPS-20 version +IFE CVTSW,[ + .TNXJS DEFSYM + .INSRT TWXBTS +];IFE CVTSW +IFN CVTSW, .INSRT TNXDFU +] ;IFN TNXSW + +; Simple check to help verify that all system symbol entries were 2 wds long. +IFN <.-ISYSYM>&1,.ERR System symbol def error + +EISYMT: PRINTA \.-MACTBA-1, words initialization coding. + VARIAB +IFN .-EISYMT,.ERR Non-empty variables area + +IFN DECSW,[ + IFGE .-MACTBA-MACL,[ +IFN MACL, PRINTA [MACL too small, set to ]\.-MACTBA + MACL==.-MACTBA +]] + +IFN ITSSW\TNXSW,[ +IFGE .+2400-MACTBA-MACL,.ERR MACL too small + LOC <.+1777>&-2000 +MXICLR==./2000 ;FIRST PAGE ABOVE INITIALIZING CODING + LOC &-2000 +MXIMAC==./2000 ;FIRST PAGE ABOVE INITIAL MACTBA +MAXMAC==/2000 + ;1ST PAGE MACRO TABLE CAN'T POSSIBLY USE. +IFLE MINPUR-MAXMAC,.ERR Pure too low. +PRINTA Wasted gap pages (MINPUR-MAXMAC) = ,\MINPUR-MAXMAC + +PBLK ; Must end assembly at end of pure, so that when doing .DECSAV type + ; assembly the msymtab for MIDAS itself will be in high core. +] + +IFN TS,END BEG +END + \ No newline at end of file diff --git a/src/midas/tsrtns.231 b/src/midas/tsrtns.231 new file mode 100755 index 00000000..f6624ba2 --- /dev/null +++ b/src/midas/tsrtns.231 @@ -0,0 +1,4586 @@ +;-*-MIDAS-*- + +SUBTTL TS Definitions, parameters + + ; For convenience in defining isolated variables/tables, + ; especially when have to know on pass1 where the + ; table is going to be (.VECTOR etc don't know until end of pass) +DEFINE LVAR -LINE +VBLK +LINE +PBLK +TERMIN + +DEFINE TMPLOC AT,STUFF +%%%TLC==. ? LOC AT + STUFF +LOC %%%TLC +TERMIN + + ; Nice macro for minimizing coding. Doesn't hack indirection tho. + ; Could conceivably optimize to do MOVE AC,[FROM,,TO] but that + ; would be overly hairy for something you can do just by writing + ; 2 instructions. +DEFINE BLTMAC AC,LEN,FROM,TO + MOVSI AC,FROM + HRRI AC,TO + BLT AC,TO+LEN-1 +TERMIN + + ; Also handy for standard zaps (and nice mnemonic) + ; won't work for indirection either. +DEFINE BLTZAC AC,LEN,FROM + SETZM FROM +IFG LEN-1,[ + MOVEI AC,FROM+1 + HRLI AC,-1(AC) + BLT AC,FROM+LEN-1 +] +TERMIN + + ; More convenient when A is clobberable... +DEFINE BLTM LEN,FROM,TO +BLTMAC A,LEN,FROM,TO +TERMIN + +DEFINE BLTZ LEN,FROM +BLTZAC A,LEN,FROM +TERMIN + + ; Following inserts a SYSCAL for JSYS's. Be warned that it + ; clobbers T when used!! +IFN TNXSW,.INSRT XJSYS + +IFNDEF PMAPSW,PMAPSW==TNXSW ; 1 to assemble PMAP input, 0 for SIN input. +IFNDEF ERRSW,ERRSW==1 ; 1 for error file output capability. + +IFNDEF TYPDLC,TYPDLC==7 ; Maximum total depth of .insrt (including tty) +IFNDEF MX.INS,MX.INS==5 ; Maximum depth .insrt files only +IFNDEF MAXIND,MAXIND==6 ; Maximum # @: table entries for .insrt + + ; Define sizes of various I/O buffers +IFN DECSW,[ +IFNDEF DECBFL,DECBFL==203 ; Standard DEC buffer size for DSK (200 wds data) +IFN SAILSW,IFNDEF NINBFS,NINBFS==19. ; For SAIL, hack full disk track of input. +IFNDEF NINBFS,NINBFS==2 ; # standard-size buffers to use for input. +IFNDEF UTIBFL,UTIBFL==*NINBFS ; Input buffs need 1 wd for EOB hacking +IFNDEF UTOBFL,UTOBFL==DECBFL ; All output chans have just 1 buffer. +IFNDEF CRFBSZ,CRFBSZ==DECBFL +IFNDEF LSTBSZ,LSTBSZ==DECBFL +IFNDEF ERRBSZ,ERRBSZ==DECBFL +] ;DECSW +IFNDEF CMBFL,CMBFL==50 ; Length of command buffer. +IFNDEF UTIBFL,UTIBFL==400 ; " Input buffer. +IFNDEF UTOBFL,UTOBFL==200 ; " BIN output buffer. +IFNDEF CRFBSZ,CRFBSZ==200 ; " CREF output buffer. +IFNDEF LSTBSZ,LSTBSZ==200 ; " LIST output buffer. +IFNDEF ERRBSZ,ERRBSZ==1 ; " ERR output buffer. Very small to avoid + ; losing much data if things crash. + + +ERRC==0 ; Err device input channel +TYIC==1 ; TTY input channel +TYOC==2 ; TTY output channel +CREFC==3 ; CREF output +UTYOC==4 ; BIN output +LPTC==5 ; LIST output (LPT) +ERRFC==6 ; ERR Assembly error output file. +UTYIC==7 ; 1st input channel, UTYIC+n used for nth .INSRT level in dec version. + +SUBTTL File Description Storage (FILBLK's) + +VBLK + ; Definitions for indices into a FILBLK. + + ; Scratch block FB is formed while defining indices... +FB: OFFSET -. + ; Lots of crocks depend on the exact order of these 4 items. +$F6DEV:: 0 ; SIXBIT Device name +$F6FNM:: $F6FN1:: 0 ; SIXBIT Filename (on ITS, FN1) +$F6TYP:: $F6FN2:: $F6EXT:: 0 ; SIXBIT Extension (on ITS, FN2) +$F6DIR:: 0 ; SIXBIT Directory (may be numerical PPN) + L$F6BLK==. +$FVERS:: $FGEN:: 0 ; File version (or generation). NUMBER, not string. +IFN TNXSW,[ ; Almost all entries here are BP's to ASCIZ strings. +$FDEV:: 0 ; Device name +$FDIR:: 0 ; Directory name +$FNAME:: 0 ; File name (i.e. main name) +$FTYPE:: $FEXT:: 0 ; File type (or extension) +$FTEMP:: 0 ; -1 => File is a temporary file. +$FACCT:: 0 ; Account string +$FPROT:: 0 ; Protection string +$FJFN:: 0 ; JFN for file (may be ,,) +] +IFN ITSSW\DECSW,[ +$FDEV==:$F6DEV ; These definitions made so some common code can do +$FDIR==:$F6DIR ; the right things. +$FNAME==:$F6FNM +$FTYPE==:$F6TYP +$FEXT==:$F6TYP +] + L$FBLK==. ; Length of a FILBLK. + OFFSET 0 ; End of index definitions. + + + ; FILBLK's for various files + +ISFB: BLOCK L$FBLK ; Input file specification as given in command line. +INFB: BLOCK L$FBLK ; Actual current input file. +OUTFB: BLOCK L$FBLK ; Output file + +IFN CREFSW, CRFFB: BLOCK L$FBLK ; CREF output file +IFN LISTSW, LSTFB: BLOCK L$FBLK ; Listing output file +IFN ERRSW, ERRFB: BLOCK L$FBLK ; Error output file + +INFCNT: 0 ; AOS'd each time an input file is opened. +INFCUR: 0 ; What INFCNT was when current file opened. +INFERR: 0 ; What INFCUR held at last err msg. + +INDDP: MAXIND,,TBLOFS ; Pointer into tables below +TBLOFS: BLOCK MAXIND*L$FBLK ; Actual filenames corresponding to those in TBLSFS, for opening. +TBLSFS: BLOCK MAXIND*L$FBLK ; Source-specified filenames for @: files + + +RFNAM1: 0 ; .FNAM1, .FNAM2, .FVERS +RFNAM2: 0 +RFVERS: 0 +IFNM1: 0 ; .IFNM1, .IFNM2, .IFVRS +IFNM2: 0 +IFVRS: 0 +INFFN1==:INFB+$F6FN1 ; Some crocks seem to reference this. +OFNM1==:OUTFB+$F6FN1 ; Pseudo .OFNM1 needs this. +OFNM2==:OUTFB+$F6FN2 ; ditto, .OFNM2 +RSYSNM: 0 ; Initial system name + +IFN TNXSW,[ +USRNUM: 0 ;User# of person running program +UNAMLN: 0 ;# of words in his username. +USRNAM: BLOCK 40./5 ;Max username is 39. characters +FNAMLN: 0 +FILNAM: BLOCK 200./5 ;Max filename is around 170. characters. +];TNXSW +PBLK + +SUBTTL I/O Buffers + +VBLK ; Input buffer and variables + +UTIBUF: BLOCK UTIBFL +UTIHDR: 0 ; Input buffer header (dec version) +UREDP: 440700,,UTIBUF ; Input byte pointer +UTICNT: 0 ; Input byte count (dec version) +IUREDP: 440700,,UTIBUF ; Initial UREDP, used for re-initializing. +UTIBED: UTIBUF ; EOF comparison with RH(UREDP), 4.9 => EOF on .IOT + +IFN DECSW,UTICHN: UTYIC + + ; BIN Output buffer + +UTOBUF: BLOCK UTOBFL ; Output buffer +UTOHDR: UTOBFL,,UTOBUF-1 +UTYOP: 444400,, ; Output (36. bit) byte pointer +UTYOCT: 0 ; # words left in utobuf +IFN ITSSW,OCLOSP: @1(C) ; Turned into bp to unused part of last bffer wd used. + + ; CREF output buffer +IFN CREFSW,[ +CRFBUF: BLOCK CRFBSZ +CRFHDR: CRFBSZ,,CRFBUF-1 ; Header, assembled value used only ifn itssw +CRFPTR: 444400,, ; Bp for filling buffer (full words) +CRFCNT: 0 ; Num. wds. empty in buffer +] + + ; LISTing output buffer +IFN LISTSW,[ +LSTBUF: BLOCK LSTBSZ +LSTHDR: 5*LSTBSZ,,LSTBUF-1 +LSTPTR: 440700,, +LSTCNT: 0 +] + + ; ERRor output buffer +IFN ERRSW,[ +ERRBUF: BLOCK ERRBSZ +ERRHDR: 5*ERRBSZ,,ERRBUF-1 +ERRPTR: 440700,, +ERRFCT: 0 ; Can't call this ERRCNT since that's used for # errors. +ERRFP: 0 ; Non-0 if want error output file. +ERRFOP: 0 ; Non-0 if error file open (ie try outputting to it) +] +PBLK + +SUBTTL Interrupt Handling + +; Note that only PDL OV is now enabled in general. +; TTY input interrupts are also handled when possible for +; ^H, ^W, and ^V. + +.SCALAR INTSVP ; Saves P on interrupt for debugging + +IFN ITSSW,[ + TMPLOC 42, JSR TSINT ; Interrupt vector for ITS +VBLK +.JBCNI: +TSINT: 0 ; 1st wd interrupts currently considered fatal errors. +.JBTPC: 0 ; Error processor re-enables interrupts + .SUSET [.RJPC,,INTJPC] + SKIPGE TSINT + JRST TTYINT ; Second-word ints. + JRST TSINT1 ; Jump into pure coding and process interrupt +INTJPC: 0 ; Saves .JPC at interrupt. +PBLK + ; Jrst here from TSINT for 2nd wd interrupts. +TTYINT: PUSH P,A + MOVEI A,TYIC ; The tty chnl is the only one enabled. + .ITYIC A, + JRST TTYINX ; No int. char. + CAIN A,^W + AOS TTYFLG ; ^W silences, + CAIN A,^V + SOS TTYFLG ; ^V unsilences, + CAIN A,^H + SETOM TTYBRF ; ^H says break next time thru ASSEM1 loop. +TTYINX: REST A + .DISMIS .JBTPC +] ; IFN ITSSW + +IFN DECSW, TMPLOC .JBAPR, TSINT1 ; Interrupt vector for DEC + +IFN ITSSW\DECSW,[ + ; Amazing but can use almost same basic rtn for both! + +TSINT1: MOVEM P,INTSVP ; Save P for possible debugging +IFN ITSSW,.SUSET [.SPICL,,[-1]] ; For ITS, re-enable ints. + MOVE A,.JBCNI ; Get interrupt request word + TRNE A,200000 ; PDL overflow? + JRST CONFLP + MOVE B,[TYPE "Unknown interrupt - Fatal"] ; anything else. + MOVEM B,40 + MOVE A,.JBTPC ; So error routine will print out properly + JSA A,ERROR +] + +IFN TNXSW,[ + ; TENEX Interrupt handler +; Note that NXP (non-ex page) is enabled, but no provision is +; currently made for handling it. This causes process termination and +; EXEC will print error message. If NXP wasn't enabled, a page would +; simply be created without fuss (page is always created, incidentally, +; whether or not interrupt happens) + +LVAR MEMDBG: 0 ; For nonce, this gets set when PURIFG does. + +LEVTAB: INTPC1 ; Where to store PC for level 1 interrupt. + 0 ? 0 ; Levels 2 and 3 unused. +CHNTAB: BLOCK 36. ; Where to go for indicated condition. Most zero. + +.IC.CV==1 ; Define user channel 1 for ^V interrupt +.IC.CW==2 ; " 2 for ^W +.IC.CH==3 ; " 3 for ^H +%%LSV==. +LOC CHNTAB+.ICPOV ? 1,,TSINT1 ; Put right word in CHNTAB for PDL OV dispatch. +LOC CHNTAB+.IC.CV ? 1,,INT.CV ; Ditto for ^V dispatch +LOC CHNTAB+.IC.CW ? 1,,INT.CW ; " ^W +LOC CHNTAB+.IC.CH ? 1,,INT.CH ; " ^H + ; The next 3 are to handle all reasonable interrupts resulting from + ; a failing JSYS. +LOC CHNTAB+.ICILI ? 1,,INT.IL ; Illegal instruction (normally a failing JSYS) +LOC CHNTAB+.ICEOF ? 1,,INT.IL ; EOF encountered +LOC CHNTAB+.ICDAE ? 1,,INT.IL ; Data error encountered +LOC %%LSV + +.SCALAR INTPC1 ; Level 1 interrupt PC stored here. + + ; Handle PDL OV interrupt +TSINT1: MOVEM P,INTSVP ; Save PDL ptr. + MOVEI A,CONFLP ; OK to clobber A in PDLOV. + MOVEM A,INTPC1 ; Dismiss to CONFLP. + DEBRK ; Off we go. + + ; Handle ^V interrupt +INT.CV: SOS TTYFLG ; Unsilence typeout + DEBRK + + ; Handle ^W +INT.CW: AOS TTYFLG ; Silence typeout + DEBRK + + ; Handle ^H +INT.CH: SETOM TTYBRF ; Set flag to check at main level ASSEM1 loop. + DEBRK + + ; Handle Illegal Instruction (normally a failing JSYS, bletch!) + ; 10X ERJMP-handling interrupt routine. +ERJMPA==: ; For use instead of ERJMP where JSYS normally skips. +IFNDEF ERJMP,ERJMP==: +IFNDEF ERCAL,ERCAL==: + +ERXJMP==: ; For easier code writing +ERXCAL==: +ERXJPA==: + +INT.IL: PUSH P,A + PUSH P,B + MOVE A,INTPC1 ; Get PC we got interrupted from + LDB B,[271500,,(A)] ; Get op-code and AC field of instr + CAIN B,ERXJPA + JRST ERJFAK + CAIE B,ERXJMP ; Is it a magic cookie? + CAIN B,ERXCAL + JRST ERJFAK + AOJ A, + LDB B,[271500,,(A)] ; Try next instr + CAIE B,ERXJMP ; Any better luck? + CAIN B,ERXCAL + JRST ERJFAK + ETF [ASCIZ "Fatal interrupt encountered"] + +ERJFAK: CAIN B,ERXCAL ; See which action to hack + JRST ERJFK2 ; Go handle ERCAL, messy. + MOVEI A,@(A) ; ERJMP, get the jump address desired + MOVEM A,INTPC1 ; Make it the new PC + POP P,B + POP P,A + DEBRK +ERJFK2: MOVEI B,@(A) ; Get jump address + MOVEM B,INTPC1 ; Make it the new PC + POP P,B + AOJ A, ; old PC needs to be bumped for return + EXCH A,(P) ; Restore old A, and save PC+1 on stack + DEBRK + +; (Actually, since ERCAL is not special except after a JSYS, it would +; still work if the ERCAL-simulation didn't bump the PC; control would +; just drop through to the next instruction on return. Might confuse +; people looking through the stack frames, though.) +] ;IFN TNXSW + +SUBTTL MIDAS BEGINS HERE - Program Startup + +VBLK +NVRRUN: -1 ; 0 => MIDAS was run; error to start or purify. +FATAL: 0 ; At end of assembly, not 0 iff fatal error occurred. +PBLK + +BEG: ; Start address! +IFN DECSW\TNXSW,[ + TDZA A,A + SETO A, + MOVEM A,CCLFLG ; Remember type of start-up +] + SETZ FF, ; Initialize flags + MOVE P,[-LPDL,,PDL-1] ; Initialize P + +IFN DECSW,[ + RESET + MOVEI A,600000 + APRENB A, +] + ; For TENEX, must determine right away which system we're on. +IFN TNXSW,[ + RESET +; TLZ FF,FL20X ; Assume 10X until proven otherwise. (done by SETZ above) + +IFN 0,[ ; One way of determining OS which doesn't work on some places. + MOVE A,[112,,11] ; Magic word that will win on 10X,T20 (and maybe T10) +GETTAB=<047000,,41> ; CALLI 41 + GETTAB A, ; Returns 10000 T10, 20000 ITS, 30000 10X, 40000 T20 + MOVEI A,30000 ; Shouldn't ever fail, but if it does, assume 10X. + LDB A,[140300,,A] ; Flush other fields too + CAIN A,4 ; = Tops-20? + TLO FF,FL20X ; Yes, set flag. +]; IFN 0 +IFN 0,[ ; This is a loser too, since there ARE KL Tenices! + SETZ A, ; In lieu of above, use hardware hack... + BLT A, ; test for KL-ness. + CAIE A, + TLO FF,FL20X ; KL will fail to skip, assume that means 20X OS. +];IFN 0 +IFN 1,[ ; Boy I hope DEC never defines LOADTB! -- MRC + SYSCAL SYSGT,[['LOADTB]][A ? D] + SKIPN D ; If LOADTB is not defined + TLO FF,FL20X ; it must be a Twenex +]; IFN 1 + + SYSCAL SCVEC,[[.FHSLF] ? [-1]] ; and flush compat package, + ; disabling UUO's 40-77; this is good for debugging. + + ; Set up stuff for interrupts + SYSCAL SIR,[[.FHSLF] + [LEVTAB,,CHNTAB]] ; Specify tables + SYSCAL EIR,[[.FHSLF]] ; Enable interrupts + SYSCAL AIC,[[.FHSLF] ; Activate PDL OV and ^V, ^W, ^H +[IRP BIT,,[.ICPOV,.IC.CV,.IC.CW,.IC.CH] +<1_<35.-BIT>>+!TERMIN ]] + SYSCAL ATI,[[.TICCV,,.IC.CV]] ; Make various mappings from + SYSCAL ATI,[[.TICCW,,.IC.CW]] ; terminal bits to int. channels. + SYSCAL ATI,[[.TICCH,,.IC.CH]] ; What a losing interrupt sys 10X has! + SKIPN MEMDBG ; Hacking memory ref debugging? + JRST BEG20 + ; Make sure that all low impure pages exist + ; whether or not they consist of all zeros. Problem is that EXEC SAVE + ; command ignores pages that are all zero, so they won't exist on + ; startup and we have to re-create them or risk getting a NXP int. + MOVSI A,-2*MINBNK + MOVE B,(A) ; Reference them all to create them if nec. + ADDI A,777 + AOBJN A,.-2 + MOVE B,-1 ; Ditto last TNX page of initial MACTAB + ; Now enable interrupts for Non-eXistent Pages. + SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] + +BEG20: SYSCAL GJINF,[][USRNUM] ;Get your user# into USRNUM + SYSCAL DIRST,[[-1,,USRNAM] ? USRNUM] ;And then make username string + JFCL + MOVEI A,1 ;# words in username string. + MOVE B,USRNAM-1(A) + TRNE B,376 ;check last position in this word + AOJA A,.-2 ; filled, so check next word. + MOVEM A,UNAMLN ;Save # words. + +] ;TNXSW + +IFN ITSSW,[ + MOVE A,[-5,,[ ; Set and read various vars in a chunk. + .SMASK,,[%PIPDL] ; 1st-wd Interrupt only on PDL ovfl. + .SMSK2,,[1_TYIC] ; 2nd-wd on TTY input channel. + .SPICL,,[-1] ; and enable interrupt system. + .RSNAM,,RSYSNM ; Get system name (default dir to use) + .RXJNAM,,B ]] ; and XJNAME for temp. hacking below. + .SUSET A + SYSCAL TTYSET,[1000,,TYIC ; Set TTYST wds - PI echo, no act/int + [232020,,202020] ; except ctls activate & interrupt + [232020,,220220]] ; CR, DEL activate but don't int; + ; DEL doesn't echo. +] + + AOSE NVRRUN ; Test for this job's already being run... + JRST [ TYPE "Can't restart MIDAS" + JRST TSRETN] + + ; Initialize impure memory for paged systems +IFN ITSSW\TNXSW,[ + MOVE AA,[MXICLR-MXIMAC,,MXICLR] + CALL CORGET ; Get MACTAB pages not loaded into. +IFN PURESW,[ + MOVE AA,[MINBNK-MINMAC,,MINBNK] + CALL CORGET ; Get pages for blank code & symtab. + SKIPN PURIFG + JRST .+3 ; If purified, skip cleanup + JSP F,FLSPGS ; If not purified => flush pages of + ,,MXIMAC ; MACTAB created by loading but not needed. +] ;PURESW +] ;IFN ITSSW\TNXSW + + MOVEI D,SYMDSZ ; Get default symtab size +IFN ITSSW,[ ; Remember that B set to XJNAME above. + CAME B,['MMIDAS] ; Set symtab size larger for MMIDAS + CAMN B,[SIXBIT/MM/] ; (random sort of hack now that .SYMTAB exists) + MOVEI D,SYMMSZ +] + SKIPGE ISYMF ; The first time through, + MOVEM D,SYMLEN ; Make that the size to use. + CALL SITINI ; Initialize stuff for .SITE. + CALL JCLINI ; Now try to fetch JCL; set CMPTR accordingly. +IFN ITSSW,[ + SKIPGE ISYMF ; Skip if syms spread; if not, + CALL TSYMGT ; get TS syms from system. +] + SKIPE CMPTR ; If have JCL, + JRST GO2AA ; skip announcing midas's name and version. + +IFG PURESW-DECSW,[ ; If meaningful, + SKIPGE PURIFG ; Check for purity + TYPE "NOTPUR " ; and type little warning if unpurified. + ] + TYPE "MIDAS." ; and announce self. + MOVE B,[MIDVRS] + PUSHJ P,SIXTYO + JRST GO2AA + +SUBTTL MIDAS Top-level control path + +GO2A: SETZM CMPTR ; Recycles here, so JCL only hacked once. +GO2AA: SETOM FATAL ; Assume fatal errors, unless cleared at GO8 when done. + SETZM TTYFLG ; Allow TTY typeout. + SETZM ERRCNT ; Initialize error counter (total errors) +IFN RUNTSW,[ PUSHJ P,RNTTMA ; Get initial run time. + MOVEM A,IRUNTM] + SETZM LSTTTY ; Tell TYOERR not to try output to LST file (none yet!) + PUSHJ P,CMD ; Get typed in command (or scan cmd line if CMPTR ne 0) + + SKIPGE SMSRTF ; What's this for, I wonder? + JRST GO21 + TYPECR "SYMTAB clobbered" + JRST GO2A + + ; Filenames and switches all specified, now see if files can be set up. +GO21: PUSHJ P,OPNRD ; Open input file + JRST GO2A ; Error, msg was typed, go try again with new cmd line. + PUSHJ P,WINIT ; Open output file, cref file. +IFN DECSW\TNXSW,[ + SKIPGE CCLFLG + TYPE "MIDAS: " +] +IFN A1PSW,[ + SETOM PRGC + SETOM OUTC +GO3: ] + MOVE A,WSWCNT + MOVEM A,TTYFLG ; Turn off typeout if there were (W) switches. + SETOM LSTTTY ; Allow TYOERR to output to both TTY and LST. + JSP A,$INIT ; Initialize for assembly + JSP A,PS1 ; Do pass 1 + TRNN FF,FRNPSS ; If 2 pass assembly, + JRST GO4 + PUSHJ P,OPNRD ; Then re-open input file + JRST GO2A ; Couldn't re-open???? Do something better here. +GO4: JSP A,PLOD ; Maybe punch out SBLK loader in some format + JSP A,PS2 ; Do pass 2 + JSP A,PSYMS ; Maybe punch out symbol table +IFN A1PSW,[ + TLZ FF,$FLOUT + AOS PRGC ; Indicate end statement encountered + SETOM OUTC ; " " " + TRNN FF,FRNPSS ; If 1 pass assembly, + SKIPGE CONTRL + CAIA + JRST GO3 ; Then try to assemble another program +] +IFN FASLP,[ + SKIPGE A,CONTRL + TRNN A,FASL + JRST GO8 + MOVE A,[SIXBIT /*FASL*/] ; "finish" FASL file + MOVEI B,17 + PUSHJ P,FASO ; Ignore end frob, but output FASL end code + MOVE A,[ASCIC//] ; pad with ^C's. + PUSHJ P,FASO1 ; Randomness + PUSHJ P,FASBE ; Write out last block +] + ; Jump directly here for certain main-input EOF conditions. +GO8: SETZM FATAL ; There was no fatal error: output files get renamed. + + ; Jump directly here if hit fatal error (incl .FATAL, illegal UUO, etc) +GO9: PUSHJ P,.FILE ; Close (and rename if FATAL = 0) output files. + SETZM LSTTTY +IFN RUNTSW, PUSHJ P,RNTTYO ; Type out run time used since GO2A + CALL ERRCLS ; File away error file - only thing not closed by .FILE + JRST TSRETN ; and die according to system's wishes. + +SUBTTL MIDAS Death (TSRETN) - system dependent exit routines + +IFN ITSSW,[ +TSRETN: +IFN PURESW,[ + SKIPGE PURIFG ; If not yet purified, assume being debugged. + .VALUE +] + .LOGOUT ; Come here to commit suicide. + .BREAK 16,160000 +] ;IFN ITSSW + +IFN DECSW,[ + +TSRETN: SKIPLE A,ERRCNT ; If had any errors, + ADDM A,.JBERR ; let loader know about them. (???) Well, + .SEE ERR1 ; for strange comment. + SKIPN CCLMOR ; Any more CCL commands? + EXIT ; Nope, all done. + JRST RERUN ; More CCL to hack, start up a new MIDAS. +] ; IFN DECSW + + +IFN TNXSW,[ +TSRETN: SKIPE CCLMOR ; Need to hack any more CCL? + JRST RERUN ; Yeah. +TSRET1: HALTF + HRROI 1,[ASCIZ/Can't continue/] + PSOUT ; Better than dying randomly + JRST TSRET1 +] ; IFN TNXSW + +SUBTTL MIDAS Murder - fatal internal error handling (GOHALT) + +VBLK +HALTER: 0 ; JSR'd here when fatal internal error seen. + JRST HALTEP ; Jump to pure-code handling +PBLK +HALTEP: +IFN ITSSW,[ + .VALUE [ASCIZ |: ===== Fatal MIDAS internal error! ===== +Please send a message to BUG-MIDAS describing circumstances. +Error was at location:  +HALTER/ +|] +] ;IFN ITSSW + +IFN TNXSW,[ +.SCALAR HALTR1,HALTR2,HALTR3 + MOVEM R1,HALTR1 ; Save R1 etc. for later examination + MOVEM R2,HALTR2 + MOVEM R3,HALTR3 + HRROI R1,[ASCIZ | ===== Fatal MIDAS internal error! ===== +Please send a message to BUG-MIDAS @ MIT-MC describing circumstances. +Error was at location: |] + PSOUT + MOVEI R1,.PRIOU + HRRZ B,HALTER + MOVEI C,8. + NOUT + ERJMP .+1 + HRROI R1,[ASCIZ / +/] + PSOUT + MOVE R1,HALTR1 ; Restore R1 etc. for later examination + MOVE R2,HALTR2 + MOVE R3,HALTR3 + HALTF +] ;IFN TNXSW + +IFN DECSW,[ + OUTSTR [ASCIZ | ===== Fatal MIDAS internal error! ===== +Please send a message to BUG-MIDAS @ MIT-MC describing circumstances. +Error location can be found in HALTER/ (please look at it with DDT to +find out where the error came from). +|] + EXIT +] ;IFN DECSW + + JRST .-1 ; Just in case + +SUBTTL MIDAS Purification - PURIFY startup, also DECDBM + +IFN ITSSW\TNXSW,[ +IFN PURESW,[ + +PURIFY: SKIPL NVRRUN +IFN ITSSW,[ .VALUE [ASCIZ /: Already run, can't purify  +/]] +IFN TNXSW,[ + JRST [ HRROI 1,[ASCIZ /? Already run, can't purify +/] + PSOUT + HALTF + JRST .+1] ; If continued, go ahead anyway. +] ;IFN TNXSW +PURIF1: MOVEI P,17 ; Start PDL at 20 + JSP F,FLSPGS ; First flush blank-code pages, + ,,MINBNK ; incl. symbol table area. + JSP F,FLSPGS ; Flush MACTAB pages created by load + ,,MXICLR ; but not needed. + JSP F,PURIFD ; Purify pure pages. + ,,MINPUR + SETZM PURIFG ; Set "purified" flag +IFN TNXSW,SETOM MEMDBG ; For TNX, ask for mem checking. + MOVE [1,,2] ; Now clear out remains of data of self + MOVEI 1,0 + BLT 40 +IFN ITSSW,[ + .VALUE [ASCIZ /: Purified, type CR to dump  +:PDUMP SYS;TS MIDAS/] +] ;IFN ITSSW + +IFN TNXSW,[ + HRROI 1,[ASCIZ / Purified, now SAVE +/] + PSOUT + HALTF +] ; IFN TNXSW + JRST BEG + + ; JSP F,FLSPGS + ; -<# pgs>,, + ; Flush pages specified by page AOBJN + +FLSPGS: MOVE A,(F) ; Get the page AOBJN +IFN ITSSW,[ + SYSCAL CORBLK,[MOVEI 0 ? MOVEI %JSELF ? A] + .LOSE 1000 +] +IFN TNXSW,[ + ASH A,1 ; Multiply # pages, page # by 2. + HLRE B,A + HRLI A,.FHSLF + MOVNS B + TLO B,(PM%CNT) ; Say hacking repeat count +FLSPG2: SYSCAL PMAP,[[-1] ? A ? B] ; Flush these pages. + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. + TRNE B,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + AOJA A,FLSPG2] ; Nope, bump page #. +] + JRST 1(F) + + ; JSP F,PURIFD - Just like FLSPGS, but purifies the pages instead. + +PURIFD: MOVE A,(F) ; Get page AOBJN +IFN ITSSW,[ + SYSCAL CORBLK,[MOVEI %CBNDR ; Read access only. + MOVEI %JSELF ? A] + .LOSE 1000 +] +IFN TNXSW,[ + ASH A,1 ; Double everything to get in terms of TNX pages. + HLRE B,A + MOVNS B ; Get # pages in B + MOVEI C,(A) + ADDI C,-1(B) ; Find # of last page to purify + LSH C,9. ; Get addr of 1st wd of last page + MOVES (C) ; Touch it so that it is guaranteed to exist! + ; This is necessary since last ITS page may only + ; include one TNX page instead of two. + HRLI A,.FHSLF +PURID1: SYSCAL SPACS,[A ? [PA%RD+PA%EX]] + ADDI A,1 + SOJG B,PURID1 +] + JRST 1(F) + +IFN TNXSW,[ + +; PURSAV - A startup routine like PURIFY, for possible use on TNX if +; the EXEC "SAVE" command does not preserve page access bits. +; Current T20 EXEC seems to do OK though. This is only useful +; when trying to catch illegal writes to "read-only" code. + +PURSV0: PUSHJ P,RDJERR +PURSAV: MOVEI P,20 + HRROI R1,[ASCIZ /Pure-Save to file: /] + PSOUT + MOVSI R1,(GJ%NEW+GJ%FOU+GJ%SHT+GJ%FNS) + MOVE R2,[.PRIIN,,.PRIOU] + GTJFN ; Get JFN from TTY + JRST PURSV0 + SETZM PURIFG ; Claim purified... + SETOM MEMDBG ; and keeping watch on memory. + HRLI R1,.FHSLF + MOVEI R2,[ + 2*<0-MINBNK>,,0+SS%RD+SS%WR+SS%EXE ; Variables/buffers + 2*,,2*MINMAC+SS%RD+SS%WR+SS%EXE ; MACTAB init + 2*,,2*MINPUR+SS%RD+SS%EXE ; Purify pure pages. + 0 ] ; End of SSAVE table + SETZ R3, + SSAVE ; Do it! + HRROI R1,[ASCIZ /Saved./] + PSOUT + HALTF +] ; IFN TNXSW + +] ; IFN PURESW +] ; IFN ITSSW\TNXSW + +IFN DECDBG,[ +DECDBM: 0 + HRLZ A,.JBSYM ;GET ADDR OF START OF DDT SYMS, + HRRI A,DECDBB+200 ;LEAVE 200 WD SPACE BEFORE THEM. + HRRM A,.JBSYM ;MOVE THEM INTO SPACE PROVIDED + HLRE B,.JBSYM + MOVMS B + BLT A,DECDBB+177(B) ;SO THEY WON'T GET IN MACTAB'S WAY. + JRST @DECDBM +] + +SUBTTL System-dependent Symbol Table stuff. + +IFN ITSSW,[ + +; TSYMGT - Gobble syms from system (ITS feature!) +; TABLE AREA IN SYSTEM: +; FIRST LOC SYSYMB +; LAST (AS OPPOSED TO LAST + 1) SYSYME + +TSYMGT: MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS + MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS + .GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP) + .LOSE %LSSYS + SKIPGE A + .LOSE ;.GETSYS DIDN'T UPDATE AOBJN POINTER + HRRM A,SP1 ;MARK END OF SYMS + ANDI A,-1 + CAIL A,MACTBA+MACL + .LOSE ;MACL TOO SMALL! INITS MIGHT LOSE. + MOVEI B,EISYMT + MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM +TSYMG2: DPB AA,[400400,,(B)] + ADDI B,2 + CAIE B,(A) + JRST TSYMG2 + POPJ P, +]; IFN ITSSW + +SUBTTL .SITE pseudo & initialization (SITINI) + +IFN ITSSW, LVSITE==1 ; ITS only uses 1 word of mach name. +IFN DECSW\TNXSW,LVSITE==5 ; whereas others need 5 words (25 chars max) + +LVAR V.SITE: BLOCK LVSITE ; .SITE string stored here. + + ; .SITE N, returns nth word of sixbit machine name. + +A.SITE: CALL AGETFD ; Get field as argument. + JUMPL A,CABPOP ; Ignore negative indices. + CAIL A,LVSITE ; Make sure index is within bounds of string. + JRST CABPOP + MOVE A,V.SITE(A) ; Win, get indexed word. + JRST CLBPOP + + +; SITINI - Initialization routine called only at MIDAS startup, for +; setting up .SITE and maybe other things. + +SITINI: BLTZ LVSITE,V.SITE ; Clear out string location + +IFN ITSSW,[ ; For ITS, use up just 1 word and need 1 call to set V.SITE + SYSCAL SSTATU,[REPEAT 5,[ ? MOVEM A] ? MOVEM V.SITE] + .LOSE %LSSYS + POPJ P, ] + +IFN SAILSW,[ ; SAIL needs special kludge, since it doesn't have the + MOVE A,[SIXBIT /SAIL/] ; right GETTAB used. + MOVEM A,V.SITE + POPJ P, ] + + ; This code sets TNX .OSMIDAS at runtime as appropriate. +IFN TNXSW,[ + MOVE A,[SIXBIT /TENEX/] ; Assume running on 10X + TLNE FF,FL20X ; unless proved otherwise + MOVE A,[SIXBIT /TWENEX/] + MOVEM A,OSMID ; Store directly as symtab value! +] + ; If TNX and on ARPA network, get Arpanet host name for .SITE +IFN TNXSW,[ + SYSCAL SYSGT,[['LHOSTN]][A ? B] ; Get local host # + JUMPL A,SITIN3 ; Tops-20 release 3 has a LHOSTN table + JUMPE B,SITIN3 ; Jump if none, not on net. + SYSCAL CVHST,[FNBWP ? A][A] ; Write string into FNBUF. + JRST SITIN3 ; No string for that host #?? + SETZ B, + IDPB B,A ; Make sure string is ASCIZ'd. + MOVE B,FNBWP ; Note that FNBWP isn't altered by the syscal! + MOVE C,[440600,,V.SITE] +SITIN2: ILDB A,B + JUMPE A,APOPJ ; return when string ended. + TRCE A,140 ; Convert char to sixbit. + TRCE A,140 + TRCE A,140 + IDPB A,C + JRST SITIN2 +] + + ; For non-network TENEX and DEC in general, very similar. +IFN DECSW\TNXSW,[ +IFN TNXSW,[ +SITIN3: SYSCAL SYSGT,[['SYSVER]][A ? D] ; Best to get table index dynamically, + JUMPE D,APOPJ ; If can't, lose. + ] +IFN DECSW,MOVEI D,11 ; 11 = .GTCNF But on T10 we can assume this. + + MOVE AA,[440600,,V.SITE] + MOVSI C,-5 ; Process 5 words of .GTCNF (max possible) +SITIN4: HRLZ B,C ; Get subindex we want, + HRRI B,(D) ; and produce ,,

+IFN DECSW, GETTAB B, ; Get 1 word of table, using appropriate call. +IFN TNXSW, SYSCAL GETAB,[B][B] + POPJ P, ; If call fails, exit. +SITIN5: SETZ A, + LSHC A,7 ; Extract an ascii char + CAIE A,", ; If it's a comma, + CAIG A,40 ; or ctl or space, + POPJ P, ; then let's stop. + TRCE A,140 ; Swap bit 40 with bit 100, thus turning + TRCE A,140 ; "A to 'A, "a to 'A, "1 to '1, etc, and ^@ to ' . + TRCE A,140 + IDPB A,AA ; Store the sixbit into V.SITE + JUMPN B,SITIN5 ; When nothing left of this word of .GTCNF, get next. + AOBJN C,SITIN4 + POPJ P, +] ;DECSW\TNXSW + +SUBTTL RunTime - .MRUNT and end-of-assembly typeout +IFN RUNTSW,[ + +.SCALAR IRUNTM ; Holds initial run time (set at start of assembly) + + ; .MRUNT - Returns runtime since start of assembly. + +A.MRUN: PUSHJ P,RNTTMA ; Get current run time + SUB A,IRUNTM ; Subtract initial run time +IFN ITSSW,[MULI A,4069. ; ITS - Convert to nanoseconds, + DIV A,[1.^6] ; then to milliseconds. +] + PJRST CLBPOP + + ; RNTTMA - internal routine to return in A the current runtime, + ; in whatever units the OS furnishes. +RNTTMA: +IFN ITSSW, .SUSET [.RRUNT,,A] ; Gets runtime in 4.096 usec units. +IFN DECSW, SETZ A, ? RUNTIM A, ; Runtime in msec +IFN TNXSW,[ + IFN A-1, EXCH R1,A + MOVEI R1,.FHSLF + RUNTM ; Runtime in msec for self. + IFN A-1, EXCH R1,A + ] + POPJ P, + +; RNTTYO - Called at end of assembly to type out runtime, +; # of errors, and # symbols used. + +RNTTYO: +IFN DECSW,[ ; Nobody wants this on ITS, but other people do...sigh... + SKIPE A,ERRCNT ; Any assembly errors? + JRST [ TYPE "? " ; Yes, error message for batch controllers + CALL DPNT + TYPECR " error(s) detected" + JRST .+1] + SKIPE CCLFLG ; Called via CCL? + RET +] + TYPE "Run time = " + CALL A.MRUN ; Get runtime in millisec. in A. + IDIVI A,10. + IDIVI A,100. ; Get secs and hundredths. + HRLM B,(P) ; Save remainder + PUSHJ P,HMSTYO ; Type out secs + MOVEI A,". + CALL TYO + HLRZ A,(P) + CALL HMSTY3 ; Type out hundredths + CALL CRR + CALL A.SYMC + CALL DPNT + TYPE " Symbols including initial ones (" + CALL A.SYMC + IMULI A,100. + IDIV A,SYMLEN ; Get % symtab used + CALL DPNT + TYPECR "% used)" + RET + +; HMSTYO - Type out H:MM:SS time in A +; Doesn't work for times .ge. 60. hours + +HMSTYO: IDIVI A,60. + JUMPE A,[MOVE A,B ? PJRST DPNT] + HRLM B,(P) + PUSHJ P,HMSTYO + MOVEI A,": + PUSHJ P,TYO ; Type delimiting char + HLRZ A,(P) +HMSTY3: IDIVI A,10. + PUSHJ P,ADGTYO ; Type out digit in A + MOVEI A,"0(B) + PJRST TYO + +] ; IFN RUNTSW + +SUBTTL COMMON Output Routine WINIT - Open all output files. + +; WINIT - Called from top-level control to open all necessary output files. +; + +WINIT: +IFN ERRSW,[ + SKIPN ERRFP ; If want error output file, + JRST WINIT2 + CALL OINIT ; Open it, first of all. + 0 ERRFC,ERRFB + SIXBIT/ERROUT/ + ERRHDR,,ERRBUF + SETOM ERRFOP ; Error file now open. +WINIT2: ] + PUSHJ P,OINIT ; Open main output file. + 13^9 UTYOC,OUTFB ; chnl,name-block. + SIXBIT/OUTPUT/ + UTOHDR,,UTOBUF +IFN ITSSW,[ + TLZ FF,FLPTPF ; Initially assume device not paper tape punch + .STATUS UTYOC,A ; Get status of output channel + ANDI A,77 ; Mask to device code + CAIN A,7 ; If paper tape punch, + TLO FF,FLPTPF ; Then set FLPTPF. +] +IFN LISTSW,[ + SKIPN LISTP + JRST WINIT1 + CALL OINIT ; Open listing file if desired. + 0 LPTC,LSTFB + SIXBIT/LSTOUT/ + LSTHDR,,LSTBUF +WINIT1: +] +IFN CREFSW,[ + SKIPN CREFP ; If cref requested, + RET + PUSHJ P,OINIT ; Open cref file, FN2 = CRFOUT + 13^9 CREFC,CRFFB + SIXBIT/CRFOUT/ + CRFHDR,,CRFBUF + MOVE A,[.BYTE 7 ? 177 ? "B ? ^W] + PUSHJ P,CRFOUT ; Output header to indicate image input. + PUSHJ P,CRFSSF ; Output set-source-file block. +] + RET + +SUBTTL COMMON Output Routines - Output Chars/Words to BIN, TTY, ERR, CREF, LIST + + ; PPB - Punch Binary word. + +PPB: JUMPGE FF,CPOPJ ; Don't punch if not punching pass. +PPBA: ; This entry pt "Always" punches. +TPPB: SOSGE UTYOCT ; If no more room in buffer, + JRST [ CALL TPPBF ; Output & re-init buffer. + JRST TPPB] + IDPB A,UTYOP + RET + +TPPBF: PUSH P,[0 UTYOC,UTOHDR] ; Drop thru to COBUFO. + + ; Common OBUFO. Takes ,
on stack, clobbers no ACs. + ; See rtns below for usual calling sequence. +COBUFO: EXCH C,(P) ; Get arg off stack, save C. + CALL OBUFO ; Output & re-init buffer. + REST C + RET + + ; TYO - Output char in A, outputting also to ERR file if possible. +TAB: MOVEI A,^I +TYO: SKIPG A.TTYF + CALL TYOX ; Actually output to TTY with OS-dependent routine. + ; Then fall through for ERR output. +ERRCHR: +IFE ERRSW,RET +IFN ERRSW,[ + SKIPN ERRFOP ; Output char in A to error file if one is open. + RET + SOSGE ERRFCT + JRST [ PUSH P,[ERRCHR] + PUSH P,[0 ERRFC,ERRHDR] + PJRST COBUFO] + IDPB A,ERRPTR + RET +] ;IFN ERRSW + + ; CRFOUT - Output word in A to CREF file. + +IFN CREFSW,[ +CRFOUT: SOSGE CRFCNT + JRST [ PUSH P,[CRFOUT] ; Buffer full, go output it. + PUSH P,[0 CREFC,CRFHDR] + PJRST COBUFO] + IDPB A,CRFPTR + POPJ P, + +CRFSSF: SKIPA A,[1] ; Output set-source-file block. +CRFPSH: MOVEI A,3 ; Output push-source-file block. +REPEAT L$F6BL,[ + CALL CRFOUT + MOVE A,INFB+$F6DEV+.RPCNT + ] + JRST CRFOUT +] ; IFN CREFSW + + + ; PILPT - Output character in A to listing file. + +IFN LISTSW,[ +PILPT: SOSGE LSTCNT + JRST [ PUSH P,[PILPT] ; When buffer full, output it. + PUSH P,[0 LPTC,LSTHDR] + PJRST COBUFO] + IDPB A,LSTPTR + RET + +LPTCLS=:CPOPJ ; Hmmm, random noop-ness ref'd by AEND. + +] ;END IFN LISTSW, + +SUBTTL COMMON Output Routine .FILE - Close all output files. + +; .FILE - Counterpart to WINIT. +; Close input, bin, cref and list files. + +.FILE: ; Closing input file is simple enough... +IFN DECSW, RELEAS UTYIC, +IFN ITSSW, .CLOSE UTYIC, +IFN TNXSW,[ +IFN PMAPSW, MOVE A,[NIBFPS,,1STBFP] ? CALL DELPGS ; flush buffer pages + MOVE R1,INFB+$FJFN + CLOSF + JFCL + SETZM INFB+$FJFN + SETZM JFNCHS+UTYIC +] + MOVNI A,1 + SKIPL B,CONTRL ; If relocatable, + PUSHJ P,TPPB ; Output a -1 so stink will see EOF + SETZ A, ; In dec fmt, output a 0 at end. + TRNE B,DECREL + CALL TPPB + SKIPE OUTFB+$FEXT ; Check general name. + JRST .FILE2 ; Output fnam2 was explicitly specified + + ; Output extension (fn2) wasn't specified, default depends + ; on system and output type. +IFN ITSSW, MOVSI A,'BIN ; Default to SBLK output format; note that +IFE ITSSW, MOVSI A,'SBK ; this will include RIM, RIM10. + SKIPL B,CONTRL ; Using STINK output format? +IFN ITSSW, MOVSI A,'REL ; Yes, use appropriate thing for site. +IFE ITSSW, MOVSI A,'STK + TRNE B,DECSAV ; Using DECSAV output format? + MOVSI A,'SAV +IFN TNXSW,[ + TRNE B,DECSAV ; If using DECSAV format and + TLNN FF,FL20X ; on a 20X, then + CAIA + MOVSI A,'EXE ; use this extension instead. +] + TRNE B,DECREL ; Using DECREL output format? + MOVSI A,'REL +IFN FASLP,[ + TRNE B,FASL ; Using FASL output format? +IFE DECSW, MOVE A,[SIXBIT /FASL/] ; yes, smash as appropriate. +IFN DECSW, MOVSI A,'FAS +] +IFE TNXSW, MOVEM A,OUTFB+$F6EXT ; For 6bit systems, store final selection. +IFN TNXSW, PUSHJ P,TNXODF ; If Tenex, call output default hackery, since + ; changing stuff is a bit hairier. + +.FILE2: JSP A,OCLOSE + 0 UTYOC,UTOHDR ; Write out buffer, rename and close output file. + OUTFB +IFN LISTSW,[ + SKIPN LISTP ; Listing file open => + JRST .FILE3 + CALL PNTCR ; End with cr and ff. + MOVEI A,^L + CALL PILPT + PUSH P,FATAL ; Rename listing file even if fatal error. + SETZM FATAL + JSP A,OCLOSE + 0 LPTC,LSTHDR ; Output buffer, rename & close it. + LSTFB + POP P,FATAL +.FILE3: +] ;IFN LISTSW +IFN CREFSW,[ + SKIPN CREFP ; If cref file open, + POPJ P, + MOVEI A,0 + PUSHJ P,CRFOUT ; Output eof block, + JSP A,OCLOSE ; Write buffer, close. + 0 CREFC,CRFHDR ; 0 chnl,header + CRFFB +] + RET + + ; File out error output file. This isn't done in .FILE so that + ; error file can include a few more goodies and be closed separately + ; later on. +ERRCLS: SETZM FATAL ; Err file renamed even after fatal error. +IFN ERRSW,[ + SKIPN ERRFOP + RET ; There is none. + MOVEI A,^M + CALL ERRCHR ; Put crlf at ennd. + MOVEI A,^J + CALL ERRCHR + JSP A,OCLOSE ; Rename and close. + 0 ERRFC,ERRHDR + ERRFB + SETZM ERRFOP +] + RET + +SUBTTL ITS - Output file Open, Output, Close/Rename. +IFN ITSSW,[ + +; PUSHJ P,OINIT ; Open output file +; Mode chnl,name-block-addr +; Sixbit/desired-temporary-fn2/ +; Header,,buffer space ;used only in dec version. +; The mode should be 13^9 for binary, 0 for ascii. + +OINIT: MOVE A,(P) + HLRZ B,2(A) ; Get addr of header, + SETOM 2(B) ; Set buffer byte count to -1 => not initted. + MOVE AA,1(A) ; Get 2nd arg, temp FN2 to use. + MOVE F,(A) ; Get 1st arg - , + SYSCAL TRANS,[5000,,.UAO ; For output mode, + REPEAT 4,[? .RPCNT(F) ] ; translate from given names + REPEAT 4,[? MOVEM .RPCNT+FB+$F6DEV ]] ; into actual names, in scratch blk. + JRST OINITL ; (too many translations) + + SYSCAL DELETE,[FB+$F6DEV ; Delete old temp name file. + TMPFN1 ? AA ? FB+$F6DIR] + JFCL ; If none, it's ok. + LDB A,[270400,,F] ; Get channel num. + HRLI A,.BAO ; Open mode (default ascii) + TLNE F,777000 ; But maybe want image mode. + HRLI A,.BIO ; Yep, use that instead, to get ,, + SYSCAL OPEN,[A ? FB+$F6DEV ; Open file, + TMPFN1 ? AA ; using these temp filenames. + FB+$F6DIR] + JRST OINITL + BLTM L$F6BL,FB+$F6DEV,$F6DEV(F) ; Copy translated names into + ; name-block for file, for eventual rename. + +POPJ3: AOS (P) ; Skip over 3 args. +POPJ2: AOS (P) + JRST POPJ1 + +TMPFN1: SIXBIT /_MIDAS/ ; FN1 to use for temp filenames. + + + +; OINITL - jumped to from OINIT if some lossage +; encountered when opening output files. + + +OINITL: HLLZ A,@(P) ; Get chnl num, + TLZ A,777037 ; Mask to just ac field (chnl num) + IOR A,[.STATUS A] + XCT A ; Read its status, + PUSHJ P,OPNER ; Type out reason for open failure, and ask + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Get typein, one line. + MOVE F,@(P) ; Get + PUSHJ P,RFD ; Get new file description into filblk spec'd by F + JRST OINIT ; and jump back to try again. + +VBLK +ERRDNM: .UAI,,'ERR ? 3 +ERRCOD: 0 +IFSTS: 0 ; .STATUS word stored by OPNRD1 when .OPEN loses +PBLK + + ; Openloss documentation routine + +IOPNER: MOVE A,IFSTS ; Input +OPNER: MOVEM A,ERRCOD ; Save .status word + PUSHJ P,TYPFB ; Type out file description + PUSHJ P,CRRERR ; Now crlf to ensure room for following + .OPEN ERRC,ERRDNM ; Now get the system to say what's wrong + .LOSE %LSSYS ; Can't open err device? +IOPNR2: .IOT ERRC,A ; Get character from system + CAIGE A,40 ; Ends with ^L or ^C or other cruft. + PJRST CRRERR ; Return, typing out CRLF. + PUSHJ P,TYOERR ; Type out character + JRST IOPNR2 ; Loop back for next + + +; JSP A,OCLOSE +; 0 chnl,header +; Nameblockaddr +; Write out last buffer, rename to names in nameblock and close. + +OCLOSE: MOVE C,(A) ; 1st wd of args is what OBUFO wants. + LDB B,[360600,,1(C)] ; Just in case this is ascii file, + DPB B,[300600,,OCLOSP] ; Get bp to unused part of last wd of buffer, + MOVE B,[ASCIC//] + DPB B,OCLOSP ; And pad with ^c's. + SOS 2(C) ; Obufo assumes byte count was sos'd. + CALL OBUFO ; Write out last partial buffer + MOVE F,1(A) ; Get + LDB C,[270400,,(A)] ; Get chnl num. + SKIPE FATAL + JRST OCLOS1 ; After fatal error, don't rename outputfiles. + SYSCAL RENMWO,[C ; Rename (F has nameblock addr) + $F6FN1(F) ? $F6FN2(F)] + .LOSE %LSSYS +OCLOS1: SYSCAL CLOSE,[C] ; Close channel. + .LOSE %LSSYS + JRST 2(A) ; Skip over args on return. + + +; OBUFO - Write out and reinitialize buffer for file. +; Assumes byte count (header 3rd wd) was sos'd. +; C has <0 chnl,header> +; In ITS version, header 1st wd has ,,-1 + +OBUFO: PUSH P,A + PUSH P,AA + AOSGE 2(C) ; Was count sos'd from -1? + JRST OBUFO1 ; Yes, buffer hadn't been initted, don't write it. + MOVN A,1(C) + ADD A,(C) ; RH(A) has -<# wds used in buffer>. + MOVSI A,(A) + HRR A,(C) + AOS A ; A has aobjn -> used part of buffer. + HLLZ AA,C + IOR AA,[.IOT A] + CAIGE A, + XCT AA ; Write it in file. +OBUFO1: MOVE A,1(C) + HRR A,(C) ; Position the b.p. before start of buffer, + TLZ A,770000 ; After last byte in wd (idpb will use 1st buffer wd) + MOVEM A,1(C) + HLRE A,(C) + MOVEM A,2(C) ; Set up byte count. + REST AA + JRST POPAJ + +TFEED: TLNN FF,FLPTPF ; If output device not PTP, + POPJ P, ; Then do nothing + PUSHJ P,TPPBF ; Otherwise output the buffer, +TFEED1: .FEED UTYOC, ; Feed a line, + TLZA FF,FLPTPF ; If this is executed, utyoc doesn't have ptp after all + SOJG B,TFEED1 ; Feed the specified number of lines, + POPJ P, ; And return + +] ; IFN ITSSW + +SUBTTL DEC - Output file Open, Output, Close/Rename + +IFN DECSW,[ + +OINIT: MOVE AA,(P) + MOVE F,(AA) ; Get , + HLLZ TT,F + TLZ TT,#(0 17,) ; Mask off AC field in TT + HRRZ D,2(AA) ; Get buffer space addr. + HLLZ C,2(AA) ; Get header addr. + HLRZ A,C + SETZM (A) ; Clear out its-version contents of 1st header wd. + LDB A,[331100,,F] ; Get mode to open in (will be ascii or image binary) + IOR TT,[OPEN A] ; Cons up OPEN instruction for chan, + MOVE B,$F6DEV(F) ; and bring in last arg. + XCT TT ; Open channel,a + JRST OINITL ; Lost? + + PUSH P,.JBFF ; Now to fake out DEC system into consing up buffer + MOVEM D,.JBFF ; at this location. T10 uses .JBFF as pointer. + XOR TT,[#] ; Request buffer setup (one of) + XCT TT + REST .JBFF + MOVE A,[SIXBIT /000MD /] + PJOB B, ; Get job number, to make sixbit /md/ + IDIVI B,10. + DPB C,[220400,,A] + IDIVI B,10. + DPB C,[300400,,A] ; Put the digits of the job number into the sixbit word. + DPB B,[360400,,A] + MOVE AA,(P) + LDB B,[360600,,1(AA)] ; Get 1st char of 'output, 'lstout, 'crfout, 'errout. + IOR A,B ; Use it as last char of temp file name. + MOVSI B,'TMP ; Set up ext (fn2), + SETZ C, ; zap prot/date/time etc to default, + MOVE D,$F6DIR(F) ; and PPN. + XOR TT,[#] + XCT TT ; Do ENTER UTYOC,A + JRST OINITL +POPJ3: AOS (P) +POPJ2: AOS (P) + JRST POPJ1 + +; OINITL - jumped to from OINIT if some lossage +; encountered when opening output files. Jumps back to OINIT +; directly. + +OINITL: PUSHJ P,OPNER ; Type out reason for open failure, and ask: + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Get typein, one line. + PUSHJ P,RFD ; Get new file description into filblk spec'd by F + JRST OINIT ; and jump back to try again. + + ; Openloss documentation routine - not much to say. + +IOPNER: ; Input +OPNER: PUSHJ P,TYPFB ; Type out file description + PUSHJ P,CRRERR ; Now crlf to ensure room for following + TYPE "OPEN failed" + PJRST CRRERR ; Return, typing out another CRLF. + +;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS. + +OCLOSE: PUSH P,A ; Save return addr + MOVE F,1(A) ; Get + SKIPGE FATAL ; If fatal error happened, + JRST OCLOS2 ; don't rename, just close. + MOVE C,$F6DEV(F) ; Delete any file with names + SETZB B,D ; we want to rename to. + OPEN ERRC,B ; Use ERRC as temporary channel. + JRST OCLOS1 + MOVE A,$F6FN1(F) + HLLZ B,$F6EXT(F) + SETZ C, + MOVE D,$F6DIR(F) + LOOKUP ERRC,A + JRST OCLOS1 ; There is none, just rename. + SETZ A, ; Say to delete this file + MOVE D,$F6DIR(F) ; From right UFD + RENAME ERRC,A + JFCL + RELEAS ERRC, +OCLOS1: MOVE A,$F6FN1(F) ; Desired fn1. + HLLZ B,$F6EXT(F) ; Desired fn2. + SETZ C, ; Bottoms-10 DATE75 lossage must never be forgotten! + MOVE D,$F6DIR(F) ; Sname (that is, ppn) + HLLZ AA,@(P) ; Get just chnl num. + IOR AA,[CLOSE] ; Close it & finalize, + XCT AA + XOR AA,[CLOSE#] + XCT AA ; Then rename to desired names. + JFCL ; at this point, ignore any lossage, sigh. +OCLOS2: HLLZ B,@(P) ; Get chnl in ac field. + IOR B,[RELEAS] + XCT B ; Finally, release channel. + JRST POPJ2 ; and skip over args on return. + + ; Write out buffer of output file, C has <0 chnl,header> +OBUFO: AND C,[0 17,] ; Get just chnl num. (sys remembers where header is for ch) + TLO C,(OUT) ; Output current buffer. + XCT C + RET ; Normal return! + PUSH P,A ; Error return from out uuo. + XOR C,[OUT#] + XCT C ; Read file status. + TRZ A,74^4 ; Clear error bits. + ETR [ASCIZ /Output data error/] + XOR C,[#] + XCT C + JRST POPAJ + + ; Paper tape stuff, do nothing. +TFEED: RET + +] ;END IFN DECSW, + +SUBTTL TNX - Output file Open, Output, Close/Rename + +IFN TNXSW,[ + +TFEED: RET ; Again, null out paper-tape hack. + +; OINIT - Open Output file. +; P points to first word of args which follow the call: +; 1: , ; is 0 for ascii, 13^9 for bin. +; 2: sixbit // +; 3:
,, +; +; Clobbers A,B,C + +; For Tenex, it is necessary to fudge the fileblock consistency slightly; +; $FJFN has in RH the actual JFN used to write to the temporary-name +; file, and in LH the JFN for the final desired filename. Note that if +; the $FEXT is null for main output file, it will be defaulted by TNXODF +; at close time, (to SAV, EXE, or REL) and the +; "final desired" JFN won't actually be used. +; Both JFNS are "active" rather than just a file spec. + +OINIT: MOVE C,(P) ; Get addr of arg block + HLRZ A,2(C) ; Get
, + SETOM 2(A) ; and set buffer byte cnt to -1 to mark for init. + MOVE F,(C) ; Get , + PUSHJ P,GETJFO ; Get output JFN for filblk. + JRST OINIT5 ; Lost? +OINIT2: HRLZS $FJFN(F) ; Won, move JFN over into LH. + + ; Aha, successfully grabbed a JFN for desired output filename. + ; Now must get another one for the temporary filename... + MOVSI A,(GJ%FOU+GJ%NEW) + PUSHJ P,TFMAP ; Must set up block again, may have changed due to RDJFNO. + MOVE A,1(C) ; Get sixbit/tmpfn2/ + PUSHJ P,CV6STR ; Convert to ASCIZ and return BP to string. + MOVEM A,GTJBLK+.GJEXT ; Store in long-form call blk. + SYSCAL GTJFN,[[GTJBLK] ? [0]][A] ; Repeat the GTJFN call. + JRST [ MOVEM A,ERRCOD ; Ugh???? + JRST OINIT5] + HRRM A,$FJFN(F) ; Good, got it... + + ; Now have both JFN's packed away, can finally open the + ; temporary filename. + HRRZ B,A ; Need JFN in RH with LH clear... + LDB A,[331100,,F] ; Get + CAIN A, + MOVSI A,070000 ; If 0, use ASCII (7-bit bytes) + TRNE A,-1 + MOVSI A,440000 ; If not 0, use WORD (36-bit bytes) + TRO A,OF%WR ; Get write access. + SYSCAL OPENF,[B ? A][A] ; Open up the temp file (JFN in RH) + JRST [ MOVEM A,ERRCOD ? JRST OINIT6] ; damn + + ; Won, successfully opened output file stuff etc, now wrap up. + HRRZ A,$FJFN(F) ; Get JFN used, + LDB C,[270400,,F] ; and channel number argument, + MOVEM A,JFNCHS(C) ; and store JFN away in channel slot. + PUSHJ P,CVFSIX ; Now put right things in $F6 entries. + MOVEI A,3 + ADDM A,(P) + POPJ P, + +.SCALAR ERRCOD + + ; Come here when GTJFN fails trying to get a JFN for GTJBLK long + ; form argument block. Must print out bad filename. + ; OINIT5 should really use names in GTJBLK, and + ; OINIT6 should really hack GJFNS call to get names, but for now... + +OINIT5: SKIPA A,[[ASCIZ /GTJFN failed for /]] +OINIT6: MOVEI A,[ASCIZ /OPENF failed for /] + PUSHJ P,CRRERR + TYPR (A) + PUSHJ P,OPNER1 ; Type out filename and error message. + PUSHJ P,RDJFNO ; Read new JFN + JRST OINIT2 ; try to open it. + +IOPNER: PUSH P,[CRRERR] ; Do following and add CRLF. +OPNER1: PUSHJ P,TYPFB + TYPE " +Error - " ; Drop thru to TERSTR. + + +TERSTR: MOVE A,ERRCOD + HRLI A,.FHSLF + SYSCAL ERSTR,[[-1,,ERSTRB] ? A ? [-LERSTR,,]][A ? A ? B] + JRST TERST7 ; undefined err #? + GOHALT ; destination bad? + TYPR ERSTRB + POPJ P, +TERST7: TYPE "Unknown error" + POPJ P, + + LERSTR==80. +.VECTOR ERSTRB(/5) + +; RDJFNO - Hack to get a new JFN by reading from TTY, using recognition. +; RDJFNI - Same but for input. Uses current FB for defaults. +; Stashes JFN away in RH of $FJFN(F). + +RDJFNO: SKIPA A,[GJ%FOU+GJ%NEW+GJ%CFM] ; For output +RDJFNI: MOVSI A,(GJ%OLD+GJ%CFM) ; for input + PUSHJ P,TFMAP + MOVE A,[.PRIIN,,.PRIOU] ; Use primary JFNs (TTY) for I/O + MOVEM A,GTJBLK+.GJSRC + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 + SYSCAL DTI,[[.TICCV]] ; Disable ^V as an interrupt character + CAIA +RDJFN2: PUSHJ P,RDJERI ; Come here when get error in GTJFN. + MOVEI R1,.PRIIN ; Make sure that + CFIBF ; TTY input is reset. + HRROI R1,[ASCIZ / +Use what filename instead? /] + PSOUT + MOVEI R1, + MOVEI R1,GTJBLK + SETZ R2, + GTJFN + JRST RDJFN2 ; Error, report it. + SYSCAL ATI,[[.TICCV,,.IC.CV]] ; Turn back on ^V + POP P,R3 + POP P,R2 + HRRM R1,$FJFN(F) + POP P,R1 + PJRST JFNSTB ; Smash FB with names of the JFN we got, and return. + +; RDJERR - Report last error message directly to TTY (primary output). +; Useful when doing quick direct user interaction. + +RDJERR: TROA R2,-1 ; Here to get last error, whatever it was. +RDJERI: MOVE R2,R1 ; Here to use err code in R1. + HRLI R2,.FHSLF + HRROI R1,ERSTRB + MOVSI R3,-LERSTR + ERSTR ; Get error string + JRST RDJER6 + GOHALT + SKIPA R1,[-1,,ERSTRB] +RDJER6: HRROI R1,[ASCIZ /Unknown error/] + ESOUT ; Output to TTY amid other hackery. + POPJ P, + + +; TNXODF - Hack to get yet another "desired" JFN so that when no +; extension was specified for binary output file, one appropriate to +; the type can be selected. +; Basically do a GTJFN again for binary output filenames, furnishing +; the default extension selected, and use that to replace the one +; already in LH of $FJFN. + +TNXODF: PUSHJ P,CV6STR ; Convert sixbit word in A to string, get BP in A + MOVEI F,OUTFB ; Point at right filblk, + MOVEM A,$FEXT(F) ; Store, and now + PUSH P,$FJFN(F) ; Save current set of JFNs before + PUSHJ P,GETJFO ; getting another one + JRST POPAJ ; If lossage, stick to old JFN. + POP P,A + HRLZS $FJFN(F) ; GETJFO puts JFN into RH, we want it in LH. + HRRM A,$FJFN(F) ; now restore previous RH. + HLRZS A ; and get old "desired" JFN in position for + SYSCAL RLJFN,[A] ; releasing. + JFCL + POPJ P, + +; OCLOSE - Close output file, writing out remainder of buffer and renaming +; from temporary to desired filename. +; JSP A,OCLOSE +; 1: 0 ,,
+; 2: +; Clobbers F,C (and obviously A) + +; 10x must do CLOSF, not releasing the JFN, and then a RNAMF from temp +; JFN to desired JFN, after which both can be released. The desired and +; used JFNs are in LH and RH respectively of $FJFN in . +; is ignored except to wipe out its JFNCHS entry. + +OCLOSE: PUSH P,A + MOVE C,(A) ; Get ,,
+ SOS 2(C) ; OBUFO assumes count was SOS'd before each call + PUSHJ P,OBUFO ; Write out anything remaining in buffer. + LDB C,[270400,,(A)] ; Get channel number + MOVE F,1(A) ; Get + HRRZ A,$FJFN(F) ; Find JFN being used... + CAME A,JFNCHS(C) ; Should be same as JFN for channel. + GOHALT ; Synch error or something. + TLO A,(CO%NRJ) ; Say don't release JFN + SYSCAL CLOSF,[A] ; Close file... + GOHALT ; ?!?! + HRRZS A ; Get back 0,,jfn + SETZM JFNCHS(C) ; Indicate "channel" closed... + SKIPE FATAL ; If fatal error happened in assembly, + JRST OCLOS5 ; don't rename from temp filenames. + HLRZ C,$FJFN(F) ; Now see what if anything to rename it to. + JUMPE C,OCLOS5 ; If no renaming needed, skip hair. + SYSCAL RNAMF,[A ? C] ; Rename file from JFN in A to JFN in C. + GOHALT ; WTF? + SYSCAL RLJFN,[C] + GOHALT + JRST OCLOS6 ; JFN in A released by RNAMF. + +OCLOS5: SYSCAL RLJFN,[A] + GOHALT +OCLOS6: SETZM $FJFN(F) + POP P,A + JRST 2(A) + +; OBUFO - Output Buffer and reinitialize. +; C/ 0 ,
+; Clobbers no ACs. + +; 10X is pretty much like ITS, JFN is kept in JFNCHS table indexed by . + +OBUFO: PUSH P,A + PUSH P,B + MOVE A,1(C) ; Get write BP, + HRR A,(C) ; and reset it... + TLZ A,770000 ; to point at start of buffer, + MOVEM A,1(C) ; and store it back, which is OK since we have byte cnt + AOSGE 2(C) ; Was buffer marked for initialization (cnt -1)? + JRST OBUFO1 ; Yes, don't write anything, just go init rest of it. + HLRZ A,(C) ; Get buffer size in wds, + MOVNI A,(A) ; make negative, + ADD A,2(C) ; and add count of bytes left to get -<# bytes used>. + LDB B,[270400,,C] ; Get channel # as index to JFN + PUSH P,T + SYSCAL SOUT,[JFNCHS(B) ? 1(C) ? A] + POP P,T +OBUFO1: HLRZ A,(C) ; Get buffer size again, + MOVEM A,2(C) ; and reset count with it. + POP P,B + POP P,A + POPJ P, + +] ;END IFN TNXSW + +SUBTTL COMMON Input Routines - Main File Open, EOF handling + +; Open main input file for reading (filespec in ISFB) + +OPNRD: +IFN ITSSW, .IOPDL ; Re-initialize IO pdl +IFN DECSW\TNXSW, CALL IOPDLC ; Non-ITS systems must simulate. + INSIRP SETZM,INFCNT INFCUR INFERR + MOVE A,[-TYPDLS-1,,TTYPDL] + MOVEM A,ITTYP ; Initialize "tty pdl" + PUSHJ P,MACIN1 ; Clobber macro expansion status + MOVE A,[ISFB,,INFB] ; Copy ISFB specs to INFB (which will hold + BLT A,INFB+L$FBLK-1 ; actual names of current input file) + MOVE A,ISFB+$FDEV ; Get device name + CAMN A,FSTTY ; TTY? + JRST [ MOVE A,[ISFB+$F6FN1,,IFNM1] ; TTY specified, treat special + BLT A,IFNM2 ; Clobber .IFNM1, .IFNM2 to specified + MOVE A,ISFB+$FVERS + MOVEM A,IFVRS + TYPECR "Reading from TTY:" + MOVEI A,3 ; => input from tty, don't quit on cr + JRST OPNRT2] + MOVEI F,INFB ; Point things at INFB. + PUSHJ P,OPNRD1 ; Try opening file + JRST [ PUSHJ P,IOPNER ; Open lost, type out message + POPJ P,] ; Read new command (this may screw on pass2?) + MOVEM A,INFERR ; Err msg in main file shouldn't type names. + MOVEI A,0 ; => input from file +IFN TNXSW,[ + MOVE T,INFB+$FJFN ; Copy actual jfn to avoid re-GTJFN + MOVEM T,ISFB+$FJFN +] +OPNRT2: MOVE T,[IFNM1,,RFNAM1] + BLT T,RFVERS ; Set up .FNAM1, .FNAM2 + SETOM NEDCRL + AOS (P) ; Won, skip on return. + JRST RCHSET ; Set up to read from file or tty. (arg in A) + + + ; Common stuff for OPNRD1 in all (DEC/ITS/TENEX) versions. +OPNRD3: HRRZM A,UTIBED ; Say buffer empty, + MOVSI A,EOFCH_13 + MOVEM A,@UTIBED ; Cause immediate reload. +OPNRD4: BLTM 2,$F6FN1(F),IFNM1 ; Set up .IFNM1, .IFNM2 from filblk F points at + MOVE A,$FVERS(F) + MOVEM A,IFVRS + AOS A,INFCNT ; Assign this file a number. + MOVEM A,INFCUR ; OPNRD expects this left in A. + JRST POPJ1 + + ; EOF while trying to read character + +RPAEOF: PUSH P,B ; Save B +RPAEO1: MOVE B,ITTYP ; Get pdl pointer + PUSHJ P,BPOPJ ; Call pop routine (maybe NED's out) + JRST RCHTRB ; Return to get character + + ; EOF from main file + +NEDCHK: TRNE FF,FRCMND ; ^C read in command, :KILL self. + JRST TSRETN + SKIPN RCHMOD + AOSE NEDCRL + JRST NEDCH1 + + ; Invent one crlf after end of main file. + MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? EOFCH]] + MOVEM B,UREDP + HRRZM B,UTIBED +IFN PMAPSW,[ + HRLI B,170700 ; Make BP pointing at last (3rd) char + MOVEM B,UTIBPE ; Set EOF BP properly. +] + RET +NEDCH1: +IFN A1PSW,[ + PUSHJ P,OUTCHK + MOVSI A,-LNEDT + XCT NEDT(A) ; Skips if NED condition to be complained about + AOBJN A,.-1 + JUMPGE A,GO8 +] + ETF [ASCIZ /No END statement/] + +.SCALAR NEDCRL ; -1 => haven't yet supplied a CRLF at EOF of main file. + +IFN A1PSW,[ ; Holler "NED" if any of the following: +NEDT: SKIPL PRGC ; No end statements have been encountered + SKIPGE OUTC ; Output has occured not matched by an end statement + SKIPGE OUTN1 ; Output has occured other than in 1pass mode + TRNN FF,FRPSS2 ; Currently in pass 2 +LNEDT==.-NEDT ; Length of table +] + +SUBTTL ITS - Input file Open, buffer input +IFN ITSSW,[ + + ; Try .OPENing input file pointed to by F. Skips if successful. + ; Sets filenames to actual names. + +OPNRD1: SYSCAL OPEN,[[.BAI,,UTYIC] + $F6DEV(F) ? $F6FN1(F) ? $F6EXT(F) ? $F6DIR(F)] + JRST [ .STATUS UTYIC,IFSTS ; Lost, save status now before possible + POPJ P,] ; .IOPOP, and make failure return. + SYSCAL RFNAME,[%CLIMM,,UTYIC ; Now find true filenames. + MOVEM A + MOVEM C ; But need to check FN1, FN2 so + MOVEM D ; put them in ACs instead. + MOVEM $F6DIR(F)] + .LOSE %LSFIL + CAMN A,[SIXBIT/DSK/] + MOVE A,V.SITE ; Use machine name instead of DSK. + MOVEM A,$F6DEV(F) + CAIE C, ; If FN1 meaningless for device, skip to use + MOVEM C,$F6FN1(F) ; spec'd FN1 anyway, but else store actual FN1. + CAIE D, + MOVEM D,$F6FN2(F) ; Ditto for FN2. + MOVE D,[440600,,$F6FN2(F)] + SETZ A, +OPNRD7: TLNN D,770000 + JRST OPNRD6 + ILDB C,D ; Calculate version number as number from fn2. + CAIL C,'0 ; Ignore non-digits. + CAILE C,'9 + JRST OPNRD7 + IMULI A,10. + ADDI A,-'0(C) + JRST OPNRD7 + +OPNRD6: SKIPN A ; No digits in FN2 => use -1 as version. + SETO A, + MOVEM A,$FVERS(F) + MOVE A,IUREDP ; Set up reading ptr, + MOVEM A,UREDP + JRST OPNRD3 ; Set up ^C after buffer, infcur, etc. + + + ; EOFCH encountered on read, reload and jump back for next char + +INCHR3: HRRZ CH1,UREDP ; Get byte pointer + CAME CH1,UTIBED ; End of block? + RET ; No, ^C in file. + MOVE A,IUREDP + MOVEM A,UREDP + MOVE A,[-UTIBFL,,UTIBUF] + .IOT UTYIC,A ; Read in block + ANDI A,-1 + CAIN A,UTIBUF ; If the iot didn't give us anything, we are at EOF. + JRST RPAEOF + HRRZM A,UTIBED ; Store RH (updated pointer) for EOF check at INCHR3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ; Store a ^C after the data we read, so at EOB we come to INCHR3. + JRST RCHTRA ; Now try next char +] ;END IFN ITSSW + +SUBTTL DEC - Input file Open, buffer input + +IFN DECSW,[ + +OPNRD1: MOVEI C,UTIHDR ; Open the input file w/ names in dnam ... snam. + SETZ A, ; Mode ascii. + MOVEI D,UTIBUF + MOVE TT,UTICHN ; Get channel num. to use. + LSH TT,27 ; Put in ac field. + IOR TT,[OPEN A] + MOVE B,$F6DEV(F) + XCT TT ; Open channel,a + RET + CALL BUFINI ; Initialize the input buffers and header. + MOVE D,$F6DIR(F) + MOVE A,$F6FNM(F) + HLLZ B,$F6EXT(F) + TLC TT,(OPEN#LOOKUP) + XCT TT ; Lookup channel,a + RET ; Failed. +IFE SAILSW,[ + MOVE A,$F6DEV(F) + DEVNAM A, ; Get real name of device. + CAIA + MOVEM A,$F6DEV(F) +] + MOVE D,[440600,,$F6FN2(F)] + SETZ A, +OPNRD7: TLNN D,770000 + JRST OPNRD6 + ILDB C,D ; Calculate version number as number from fn2. + CAIL C,'0 ; Ignore non-digits. + CAILE C,'9 + JRST OPNRD7 + IMULI A,10. + ADDI A,-'0(C) + JRST OPNRD7 + +OPNRD6: SKIPN A ; No digits in FN2 => use -1 as version. + SETO A, + MOVEM A,$FVERS(F) + MOVE A,UREDP + JRST OPNRD3 + + + ; Reload buffer, DEC style. +INCHR3: HRRZ CH1,UREDP ; Is this ^C at end of buffer? + CAME CH1,UTIBED + RET ; No, ^C in file. + PUSH P,B + MOVE A,UTICHN + LSH A,27 ; Channel num. in ac fld. + TLO A,(IN) + XCT A ; Get next bufferfull. + CAIA ; Succeed. + JRST INCHR4 ; Error. +INCHR5: MOVE A,UTICNT + ADDI A,9 + IDIVI A,5 + ADD A,UREDP ; -> 1st wd not read into. + HRRZM A,UTIBED + HRRZ A,UREDP + AOS A + MOVEI B,1 ; Scan the file and replace all line numbers with nulls. +INCHR6: CAMN A,UTIBED + JRST INCHR7 + TDNE B,(A) + MOVEM B,(A) + AOJA A,INCHR6 + +INCHR7: MOVSI B,EOFCH_13 + MOVEM B,(A) ; Put EOF char after buffer, in extra word. + JRST RCHTRB ; Retry RCH. + +INCHR4: XOR A,[#IN] + XCT A + TRZE B,74^4 + ETR [ASCIZ /Input data error/] + XOR A,[#] + XCT A ; Clear error bits in status. + TRNN B,2^4 + JRST INCHR5 + JRST RPAEO1 ; EOF. + +; BUFINI - Create DEC-style buffer ring, with 1 extra word following +; each buffer... +; A/ +; B/ +; C/
+; D/ +; Note that this extra-word crock is necessary just so it can be filled +; with ^C's to stop read loop and switch to next buffer. + +BUFINI: MOVEI AA,A +IFE SAILSW,DEVSIZ AA, + SKIPA AA,[DECBFL+1] ; Default buffer size is that for dsk. + AOJLE AA,.-1 ; Get size including extra wd. + MOVEI T,1(D) ; Addr of wd 2 of 1st buffer. + HRLI AA,T ; @AA is addr of 2nd wd of next buffer. + SUBI D,(AA) ; Facilitate test for end of buffer space. + HRLI T,400000 + MOVEM T,(C) ; Header -> a buffer, sign set. + HRRM T,1(C) ; Make rh of bp -> buffer 1st wd. + MOVSI T,440000 ; Set up p-field of b.p. + IORM T,1(C) + HRRZ T,1(C) + AOS 1(C) + HRLI T,-3(AA) ; Data-area-size +1,,addr-of-2nd-wd +BUFIN1: CAIGE D,-UTIBFL(T) ; Room for another after this buffer? + JRST BUFIN2 ; No, wrap up. + MOVEM T,@AA ; Yes, make next buffer -> this one, + HRRI T,@AA ; Point to next one. + JRST BUFIN1 + +BUFIN2: ADDI D,1(AA) ; -> 2nd wd of 1st buffer. + MOVEM T,(D) ; 1st buffer -> last, making ring. + RET + +] ;END IFN DECSW, + +SUBTTL TNX - Input file Open, buffer input + +IFN TNXSW,[ + +; OPNRD1 - Open File for Reading. Old stuff assumed fnm in DNAM +; using UTYIC channel, but new should furnish arguments: +; F/ to open + +; Essentially just GTJFN and OPENF like OINIT does, with same +; sort of error handling, except that when reading from cmd line +; as opposed to .INSRT, just go back to get completely new command. +; (perhaps if typein is just CRLF, go to special TNX style cmd input?) + +OPNRD1: CAIN F,INFB ; Horrible kludge necessary because MIDAS main + ; level doesn't bother to explicitly close main + ; input file when pass 1 is done, and TNX barfs if + ; you try to re-open a JFN... sigh. + JRST [ SKIPN $FJFN(F) ; Main file. Already opened it? + JRST .+1 ; nope, get JFN & open normally. + IFE PMAPSW,[ ; Already open. If not mapping, reset read ptr. + SYSCAL SFPTR,[$FJFN(F) ? [0]][ERRCOD] + POPJ P,] + JRST OPNRD2] ; and avoid attempt to re-open the JFN. + SKIPN $FJFN(F) + JRST [ PUSHJ P,GETJFI ; No JFN, get one for input. + POPJ P, ; Could fail. + JRST .+1] + PUSH P,T ; Read access, full word input. + SYSCAL OPENF,[$FJFN(F) ? [440000,,OF%RD]][ERRCOD] + JRST [POP P,T ? POPJ P,] ; Failure + POP P,T +OPNRD2: HRRZ A,$FJFN(F) + MOVEM A,JFNCHS+UTYIC ; Indicate "channel" open with this JFN. + PUSHJ P,JFNSTB ; Get actual names/version #. + PUSHJ P,CVFSIX ; Put right stuff in $F6 entries. + MOVE A,IUREDP ; Opened, set up buffer. + MOVEM A,UREDP ; Initialize BP into buffer. +IFE PMAPSW, JRST OPNRD3 +IFN PMAPSW, JRST OPNR50 ; for PMAP hacking, lots of stuff to do. + + ; Get a JFN for current FILBLK (in F) and stick it into $FJFN(F). + ; A should hold flags in LH to use in 1st wd of block. + ; GETJFI - sets usual flags for input + ; GETJFO - sets " " output + ; GETJFN - takes whatever A holds. + +GETJFO: SKIPA A,[GJ%FOU+GJ%NEW] ; If hacking output, ask for new version. +GETJFI: MOVSI A,(GJ%OLD) ; If hacking input, file must exist. +GETJFN: PUSHJ P,TFMAP ; Stick filblk stuff into GTJFN scratch block. + PUSH P,R1 + PUSH P,R2 + MOVEI R1,GTJBLK + SETZ R2, + GTJFN + JRST [ MOVEM R1,ERRCOD ; failure, save error code. + JRST GETJF5] + HRRM R1,$FJFN(F) ; Win, save JFN. + AOS -2(P) +GETJF5: POP P,R2 ; Can't return in ACs cuz don't know what R1 etc are, + POP P,R1 ; and might clobber them here. + POPJ P, + +; TFMAP - Map Tenex filenames from filblk pointed to by F into +; standard scratch block for long-form GTJFN. +; A/ ,,0 ; flags will go into LH of .GJGEN. +; Clobbers only A. + +TFMAP: HRR A,$FVERS(F) ; Put version # in RH + SKIPE $FTEMP(F) ; If asking for temp file, + TLO A,(GJ%TMP) ; set appropriate flag. + MOVEM A,GTJBLK+.GJGEN +IRP FROM,,[$FDEV,$FDIR,$FNAME,$FTYPE,$FPROT,$FACCT,$FJFN]TO,,[.GJDEV,.GJDIR,.GJNAM,.GJEXT,.GJPRO,.GJACT,.GJJFN] + MOVE A,FROM(F) + MOVEM A,GTJBLK+TO +TERMIN + MOVE A,[.NULIO,,.NULIO] + MOVEM A,GTJBLK+.GJSRC ; Don't hack I/O in gtjfn. + POPJ P, + +.VECTOR GTJBLK(10.) ; Need exactly this many wds for non-extended long call + +IFE PMAPSW,[ + ; EOFCH seen in input, check it here. + +INCHR3: HRRZ CH1,UREDP ; Get byte pointer + CAME CH1,UTIBED ; End of block? + RET ; No, ^C in file. + MOVE A,IUREDP + MOVEM A,UREDP + PUSH P,T + SYSCAL SIN,[JFNCHS+UTYIC ? [444400,,UTIBUF] ? [-UTIBFL]][A ? A ? A] + POP P,T + ADDI A,UTIBUF+UTIBFL ; Get UTIBUF + <# bytes stored> + CAIG A,UTIBUF ; If the sin didn't give us anything, we are at eof. + JRST RPAEOF + HRRZM A,UTIBED ; Store rh (updated pointer) for eof check at inchr3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ; Store a ^c after the data we read + JRST RCHTRA ; Now try next character + +] ; IFE PMAPSW + +IFN PMAPSW,[ ; New stuff for PMAP'ing input etc. + +VBLK +IFNDEF NIBFPS,NIBFPS==10 ; # of pages per buffer +PGBFL==NIBFPS*1000 ; Length of a buffer in wds. +IFNDEF 1STBFP,1STBFP==500 ; # of first page to start buffers at. + +INBFPG: 1STBFP ; # of 1st buffer page (in our address space) +INFPAG: 0 ; # of page in file corresponding to 1st page in buffer. +INPGCT: 0 ; -# times to refill buffer with new pages. +INLPGS: 0 ; # pages to slurp on last refill (instead of NIBFPS) +UTIBPE: 0 ; BP to last byte of data in buffer (holding ^C) +UTIBPL: 0 ; BP to last byte position in buffer area (constant) +UTIBPX: 0 ; BP to last byte of data when last pages have been mapped. +INLCHR: 0 ; Place to save char that ^C replaces. If -1, no char. +;SOSSW: 0 ; non-Z if hacking SOS line-number type file. +FBBYV: 0 ; GTFDB dumps cruft in these two locs. +FBSIZ: 0 ; e.g. this gets size of file in bytes. +PBLK + + ; Wrap up open of an input file, by initializing all the cruft + ; above. +OPNR50: SYSCAL GTFDB,[$FJFN(F) ? [2,,.FBBYV] ? MOVEI FBBYV] + LDB C,[300600,,FBBYV] ; Get byte size of file + CAIN C, + MOVEI C,36. ; If 0 use 36-bit bytes (full wds) + MOVEI A,36. + IDIVI A,(C) ; Get bytes per wd, ignore remainder. + MOVE B,FBSIZ ; Now, with # bytes in file, + EXCH A,B + IDIVI A,(B) ; find <# in fil>/<# per wd> = # wds in file + CAIE B, ; Also hack + ADDI A,1 ; rounding up (gasp, wheeze, finally done.) + IDIVI A,PGBFL ; Now get # times buffer will need slurping... + ADDI A,1 ; And another for the final slurp (even if it will be empty) + MOVNM A,INPGCT ; Store -# slurps. + MOVEI A,777(B) + LSH A,-9. ; Find # pages last slurp really needs. + MOVEM A,INLPGS ; and store away. + HRLI B,010700 + MOVEM B,UTIBPX ; Store relative BP to last ch (when last pages mapped) + HRRI B,PGBFL ; And relative BP to last char in whole buffer + MOVEM B,UTIBPL ; Note UTIBPX and UTIBPL actually point to next wd + ; but this is fixed when abs addr is added in. + + MOVE A,INBFPG ; Find page # buffer starts at in core, + LSH A,9. ; Get address, and + SUBI A,1 ; Subtract one, to fix UTIBPX, UTIBPL, and IUREDP. + ADDM A,UTIBPX ; add into the BP's to make them absolute. + ADDM A,UTIBPL + HRLI A,010700 ; And use for initial read pointer - + ; MUST be "canonical form", so that SEMIC hackery + MOVEM A,IUREDP ; will work with weird way INCHR3 returns here. + MOVNI A,NIBFPS ; Use this as initial file page #, so the ADDB in + MOVEM A,INFPAG ; INCHR3 will do right thing to it. + MOVE A,[440700,,[EOFCH_35]] + MOVEM A,UREDP ; set up things so first RCH will instantly cause reload. + ILDB B,A + MOVEM A,UTIBPE + SETOM INLCHR ; Mustn't forget that we don't have a stored char yet. + JRST OPNRD4 ; Finally done with PMAP init stuff. + + ; Come here when hit ^C +INCHR3: MOVE CH1,UREDP ; Get current read ptr + CAME CH1,UTIBPE ; At end of buffer? + POPJ P, ; Nope, ^C in file, actual input. + AOSLE CH1,INPGCT ; Aha, end of buffer. Bump times refilled... + JRST INCH56 ; and if no more refills, go handle EOF. + MOVE A,IUREDP + MOVEM A,UREDP +IFN A-1,PUSH P,R1 +IFN A-2,PUSH P,R2 +IFN A-3,PUSH P,R3 + MOVEI R1,NIBFPS ; Get # of input buffer pages + ADDB R1,INFPAG ; and find current page in file to get + HRL R1,$FJFN+INFB ; current input file's JFN + MOVE R2,INBFPG ; and usual pointer to destination buffer page + HRLI R2,.FHSLF ; Why the fuck doesn't 10X default this?!?! + MOVEI R3,NIBFPS ; Set # pages to slurp up + JUMPN CH1,INCH51 ; But if this is last slurp, + SKIPG R3,INLPGS ; Use pre-calculated # to avoid non-ex pages. + JRST INCH55 ; No pages in last slurp! Avoid new PMAP. + +INCH51: TLO R3,(PM%CNT+PM%RD+PM%CPY) ; Read access, copy-on-write. +INCH52: PMAP ; Gobble gobble + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI R3,-1(R3) ; Else, on 10X, must iterate manually. + TRNE R3,400000 ; See if became "negative". + JRST INCH53 ; Yep, done with manual iteration. + ADDI R2,1 ; Nope, bump page #'s. + AOJA R1,INCH52] +INCH53: +IFN A-3,POP P,R3 +IFN A-2,POP P,R2 +IFN A-1,POP P,R1 + CAIE CH1, ; Was this the last slurp? + SKIPA CH1,UTIBPL ; no, use BP to Last char at end of buffer. + MOVE CH1,UTIBPX ; yes, need BP to last char in last page. +IFN 0,[ SKIPE SOSSW ; If hacking line number lossage, + JRST [ MOVE A,(CH1) ; must beware of getting wiped, so have to + TRNE A,1 ; check here, and if depositing EOFCH in #, + HRLI CH1,350700 ; then move the EOFCH to beg of word! + JRST .+1] +] + LDB A,CH1 ; Replace last char of buffer's data + MOVEI CH2,EOFCH + DPB CH2,CH1 ; with the EOF char. + MOVEM CH1,UTIBPE ; Remember ptr to end of data, + EXCH A,INLCHR ; and save char for then, returning whatever + JUMPL A,RCHTRA ; was the last char of last bufferfull. + ; (may be -1, in which case RCHTRA tries again) + + ; Jump here to return a new char in A, something like + ; RCHTRA without all the fuss. +INCHR7: POP P,CH1 ; Get return addr + ANDI CH1,-1 + CAIE CH1,RREOF+1 + JRST -2(CH1) ; Note -2 not -3 as in RCHTRA! + JRST (CH1) ; Special hack since -2 loses for RREOF. + ; Perhaps someday it will win. + +INCH55: ; Here when doing last slurp and no pages to slurp. +IFN A-3,POP P,R3 +IFN A-2,POP P,R2 +IFN A-1,POP P,R1 +INCH56: SKIPGE A,INLCHR ; No more refills, see if last char left + JRST RPAEOF ; No? All done, true EOF. + SETOM INLCHR ; Almost, one last char. + MOVE CH1,UREDP ; Must bump ptr back one char, so next read + ADD CH1,[070000,,] ; will also stop. + CAIG CH1, + SUB CH1,[430000,,1] + MOVEM CH1,UREDP + JRST INCHR7 ; Return very last char in A. + +] ; IFN PMAPSW + +] ;END IFN TNXSW + +ifn 0,[ ; turn off but keep around for a while. +SUBTTL old .INSRT Processing + +; .INSRT ; Insert file here +; TTY: => ok, reads line at a time, rubout allowed within line +; Pushes macro expansion, other .INSRT's +; In filedescription, ^R => reset file name counter [?!? - KLH] +; If device is "@:", always ask for translation. + +A.INSR: NOVAL + MOVE A,[ISFB,,FB] ; Default names are those of spec'd input file + BLT A,FB+L$FBLK-1 ; Zap them into scratch filblk. + MOVEI F,FB ; And point at it. + MOVE A,FSDSK + MOVE B,FSTTY ; Compare "TTY" with + CAMN B,$FDEV(F) ; device name, and if identical, + MOVEM A,$FDEV(F) ; default to DSK. +IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" +IFN ITSSW,MOVE A,FSGRTN + MOVEM A,$FEXT(F) + + TLO FF,FLUNRD +A.IN1: PUSHJ P,RFD ; Read file description + MOVE A,$FDEV(F) ; Get specified device name + CAME A,FSATSN ; Atsign? + PUSHJ P,A.ITRY ; No, try opening file + + ; If return, open failed. + MOVE A,$F6DEV(F) + AOJE A,A.INT1 ; Already trying to set up table entry + SKIPA F,[MAXIND,,TBLOFS] ; Atsign, or fnf, search table + +A.IN2: SUBI F,-L$FBLK ; Loop point searching table, increment to next entry, count down LH + CAMN F,INDDP ; Compare with pointer to top of table + JRST A.IN3 ; Agree => this file not in table + +; MOVEI A,-TBLOFS(F) ; Get index relative to table base. +; MIDAS complains "illegal use of relocation" when try to use above addr, so must use next 2 instructions instead - barf barf + MOVEI A,(F) + SUBI A,TBLOFS + + MOVSI B,-L$FBLK ; And index into FB. + MOVE T,TBLSFS(A) ; Get specification name this entry +A.IN25: CAMN T,FB(B) ; Compare with that just specified + AOBJN B,[AOJA A,.-2] ; Check all names this entry +IFE TNXSW, JUMPL B,A.IN2 +IFN TNXSW,[JUMPL B,[ MOVEI C,(B) + CAIN C,$FJFN ; One item of entry didn7t match, was it JFN? + JRST A.IN25 ; Yes, ignore it and continue. + JRST A.IN2] ; Sigh, was something else, entry doesn't match. + ] + + ; File is in table + MOVSI A,(F) ; Move description from TBLOFS to FB. + HRRI A,FB + BLT A,FB+L$FBLK-1 +IFN TNXSW, SETZM FB+$FJFN ; Since re-opening, must zap previous JFN. + PUSHJ P,A.ITRY ; Try opening file + + ; If return, open failed. + MOVSI A,TBLSFS-TBLOFS(F) ; Set up LH(BLT pointer), + HRRI A,FB + BLT A,FB+L$FBLK-1 ; Unmap to original names(TBLSFS to FB) + PUSHJ P,TYPFB ; Type out specified names + TYPE " -> " ; Type out pointer + MOVSI A,(F) ; Copy translation (TBLOFS entry) back to FB. + HRRI A,FB + BLT A,FB+L$FBLK-1 + SETOM $F6DEV(F) ; "half-kill" entry in TBLOFS + +A.INT1: PUSH P,F + MOVEI F,FB + PUSHJ P,IOPNER ; Open lost, type out cruft + POP P,F + TYPE "Use what filename instead? " +A.INT2: PUSHJ P,GTYIP ; Prepare to read one line from tty + JRST A.IN1 ; Try again with what he types in + + ; File not in table, try to add a translation for it. + +A.IN3: TLNN F,-1 ; More room for another entry in table? + ETF [ASCIZ /Too many @: files/] + MOVEI A,TBLSFS-TBLOFS(F) ; Copy FB into TBLSFS (specified name) + HRLI A,FB + BLT A,TBLSFS-TBLOFS+L$FBLK-1(F) + SETOM $F6DEV(F) ; Document fact that entry has only key, not translation + MOVNI A,-L$FBLK + ADDM A,INDDP ; Update pointer into table + MOVE A,FB+$FDEV ; Get specified device name + CAME A,FSATSN ; Atsign? + JRST A.INT1 ; No, type out garbage and try again, reading from tty + MOVE A,ISFB+$FDEV ; Yes, clobber from input device name + MOVEM A,FB+$FDEV + JRST A.INT2 + +;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL + +A.ITRY: MOVE A,FB+$FDEV ; Get specified device name + CAMN A,FSTTY ; TTY? + JRST A.ITRT ; Yes, treat special + TLO FF,FLUNRD + PUSHJ P,IPUSH ; Save current status + PUSH P,F ; save what F points at + MOVEI F,FB + PUSHJ P,OPNRD1 + JRST [POP P,F ? JRST IPOPL] ; Lose, pop and return + POP P,F + MOVE B,[FB,,INFB] ; Kludge for time being - if win, + BLT B,INFB+L$FBLK-1 ; Copy all stuff into INFB. +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + MOVEI A,-2-TYPDEL(B) ; + HRLI A,IFNM1 + BLT A,-TYPDEL(B) ; Introduce hysteresis so .INSRT'ing file can reference .IFNM1, .IFNM2 +IFN CREFSW,[ + SKIPE CRFONP ; If creffing, output push-file block. + PUSHJ P,CRFPSH ; (pop-file block output at ipop) +] +A.ITR2: + MOVE A,$F6DEV(F) ; Push successful, now check to see if table entry should be finished + AOJN A,ASSEM1 + MOVEI A,(F) ; Move FB into TBLOFS as translation entry. + HRLI A,FB + BLT A,L$FBLK-1(F) + JRST ASSEM1 ; Now assemble from file (ASSEM1 clobbers pdl) + + ; .INSRT TTY: + +A.ITRT: PUSHJ P,GTYIPA ; Read from tty, don't quit until .INEOF + JRST A.ITR2 ; Fall back in (doesn't touch .IFNM1, .IFNM2) +] ; end IFN 0 + +SUBTTL .INSRT Processing + +; .INSRT ; Insert file here +; TTY: => ok, reads line at a time, rubout allowed within line +; Pushes macro expansion, other .INSRT's +; If device is "@:", always ask for translation. + +A.INSR: NOVAL + + ; First set up defaults for parsing filename. + BLTM L$FBLK,ISFB,FB ; Default names are those of spec'd input file, + MOVEI F,FB ; stuffed into scratch FB. + MOVE A,FSDSK + MOVE B,FSTTY ; Compare "TTY" with + CAMN B,$FDEV(F) ; device name, and if identical, + MOVEM A,$FDEV(F) ; default to DSK. +IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" +IFN ITSSW,MOVE A,FSGRTN + MOVEM A,$FEXT(F) + + TLO FF,FLUNRD + PUSHJ P,RFD ; Read file description from current input. + MOVE A,$FDEV(F) ; Get specified device name + CAMN A,FSATSN ; Atsign? + JRST A.IN50 ; If so, check out translation right away. + +A.IN2: CAMN A,FSTTY ; TTY? Must handle specially. + JRST [ PUSHJ P,GTYIPA ; Set up to read until .INEOF or EOF char. + JRST ASSEM1] ; And don't do anything to .IFNM1/2, etc. + PUSHJ P,IPUSH ; File, push the world. + PUSHJ P,OPNRD1 ; Try opening file. + JRST [ PUSHJ P,IPOPL ; Sigh, failed, pop world back and go + JRST A.IN50] ; try translation entries or TTY input. + ; Always jumps back to A.IN2. + + ; Come here when input file successfully opened. Clean up etc. + BLTM L$FBLK,(F),INFB ; Move current filespec to INFB, +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + BLTM 3,IFNM1,-2-TYPDEL(B) ; Copy new .IFNM1, .IFNM2 onto stack, + ; to clobber .IFNM1/2 for previous file, so + ; that .IFNM1/2 etc refers to last file .INSRT'd by + ; current file (or current file if none .INSRT'd yet) +IFN CREFSW,[ + SKIPE CRFONP ; If creffing, output a push-file block. + PUSHJ P,CRFPSH ; (pop-file block is output at IPOP) + ] + + JRST ASSEM1 ; and jump off to smash things to toplevel. + + ; Come here when open attempt fails or @: device specified. +A.IN50: CAIE F,FB ; Tried translations yet? + JRST A.IN60 ; Yes, skip table hacking and go get fnm from TTY. + + ; First open attempt, so OK to search translation table. + SKIPA D,[MAXIND,,TBLOFS] ; Load up aobjn-style index to transl table +A.IN52: SUBI D,-L$FBLK ; Loop point for searching table - increment to next entry, count down LH + CAMN D,INDDP ; Compare with pointer to top of table + JRST A.IN60 ; Agree => this file not in table, get from TTY. + + MOVEI A,(D) ; Get scratch index into tables, + HRLI A,-L$FBLK ; making AOBJN of it, + MOVEI B,(F) ; and get index into current FB. +A.IN54: MOVE C,TBLSFS-TBLOFS(A) ; Get a specification name for this entry +IFN TNXSW,CAIE B,$FJFN(F) ; (ignoring the JFN item, for TENEX) + CAMN C,(B) ; Compare name with that of failed filblk. + AOBJN A,[AOJA B,A.IN54] ; Check all names this entry + JUMPL A,A.IN52 ; If not found, try next entry. + + ; File is in table, try opening it using TBLOFS description. + MOVE F,D ; Replace old F by ptr to winning TBLOFS entry. +IFN TNXSW, SETZM $FJFN(F) ; Since re-opening, must zap any previous JFN. + JRST A.IN2 ; Jump off to try opening. + + ; Come here when open failed and no matching transl entry. + ; Must set up to gobble down a translation from TTY... +A.IN60: TYPE "Error in .INSRT; " + CAIE F,FB ; Were we trying to open a translated entry? + JRST [ PUSHJ P,TYPFB ; Yes, so print out appropriate info + TYPE " -> " ; to show translated stuff. + JRST A.IN70] + + ; First time, no translation entry exists, make one. + MOVE A,INDDP ; Get current pointer to top of tables + TLNN A,-1 ; Room for more? + JRST A.IN70 ; Nope, can't remember transl, but get right fnm anyway. + MOVE F,A ; Yep, use it as pointer to table entry to use. + SUBI A,-L$FBLK ; and get new table-top pointer with clever + MOVEM A,INDDP ; SOS of LH and ADDI to RH. + BLTM L$FBLK,FB,(F) ; Move FB contents to both TBLOFS, + BLTM L$FBLK,FB,TBLSFS-TBLOFS(F) ; and TBLSFS. + +A.IN70: ; Print out filename F points to, & err msg. +IFN TNXSW,[ + PUSHJ P,OPNER1 + PUSHJ P,RDJFNI ; On 10X, get new filename this way. + ] +IFN ITSSW\DECSW,[ ; Elsewhere do it painful way. + PUSHJ P,IOPNER + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Setup to read 1 line from TTY, + PUSHJ P,RFD ; and do it, parsing filename. +] + JRST A.IN2 ; now go try opening it. + +SUBTTL Misc. .INSRT-related things + + ; .INEOF - EOF pseudo + +A.IEF2: PUSHJ P,PMACP ; Loop point, pop entry off macro pdl +A.INEO: TLNE FF,FLMAC ; Inputting from macro? + JRST A.IEF2 ; Yes, pop it off + PUSH P,CMACCR ; Back to inputting from file or tty, cause return to maccr + MOVE B,ITTYP ; Get pdl pointer + POPJ B, ; Return to pop routine + + + ; Call from ERRH; type input file's names if changed since last err msg. +ERRTFL: MOVE C,INFCUR + EXCH C,INFERR ; Say last error msg in this file. + CAMN C,INFERR ; If prev. msg was in other file, + POPJ P, + PUSH P,F + MOVEI F,INFB ; Point to current input file, + PUSHJ P,TYPFB ; and type out its filename. + POP P,F + PJRST CRRERR + +SUBTTL COMMON IO PDL routines for input. (.INSRT support) + +;IO PDL ROUTINES FOR INPUT FILE +; Push the input file + +IPUSH: AOSN CMEOF ; Want to pop out of tty? (^C typed in) + CALL POPTT ; Yes, do now before forget. + +IFE PMAPSW,[ + MOVE D,UREDP ; Get input byte pointer +IFN ITSSW\TNXSW,[ +IFN ITSSW, .IOPUS UTYIC, +IFN TNXSW, MOVEI A,UTYIC ? PUSHJ P,$IOPUSH + TLNN D,760000 ; At end of word? + ADD D,[430000,,1] ; Yes, make it point to beginning of next word + MOVEM D,UREDP + MOVNI A,-2(D) + ADD A,UTIBED ; Get # wds we'll need in MACTAB. + HLR D,UTIBED ; Remember whether EOF on last .IOT. + HRRZS UTIBED ; Now clear out left half for following +] +IFN DECSW,[ + AOS A,UTICHN ; Do ".IOPUSH" - use next channel. + LSH A,27 + ADD A,[WAIT-<0 1,>] ; Construct a WAIT uuo for the current input channel. + MOVE C,RCHMOD ; We mustn't copy the buffers while I/O is going on. + CAMN A,[WAIT UTYIC,] ; But: if we are currently in the top-level input file + CAIE C,3 ; And it is device TTY:, this channel was never opened. + XCT A ; Don't move buffers while io going on! + MOVEI A,UTIBFL+2 ; Assume must save all buffer space. +] + PUSH P,A + ADD A,FREPTB + ANDI A,-1 + PUSH P,A + CAML A,MACTND ; No room in MACTAB => gc it. + CALL GCA1 + REST A + CAML A,MACTND ; Did the GC win? + PUSHJ P,GCCORQ ; NO!! Try to win somehow + MOVEI A,370 + CALL PUTREL ; Indicate start of saved buffer. + REST A + AOS B,FREPTB + SUBI A,1 + MOVE C,ITTYP ; Get addr of tty pdl wd that'll point to saved buffer. + ADDI C,1 + HRRZM C,(B) ; Store in rh of 1st wd, + MOVEI C,(B) ; Remember addr of saved buffer to push on ttypdl. + HRLM A,(B) ; Put length in lh. + AOS B +IFN ITSSW\TNXSW,HRL B,UREDP ; LH <- addr of 1st wd to save. +IFN DECSW,HRLI B,UTIBUF + ADDI A,-2(B) ; Addr of last wd to blt into. + BLT B,(A) + HRLI A,041000 + MOVEM A,FREPTB ; Make free bp -> last byte just used. + SUB A,MACTAD + ANDI A,-1 + LSH A,2 + ADDI A,4 ; Get char addr of next free byte. + MOVEM A,FREEPT +] +IFN PMAPSW, CALL IOBPUS + + MOVE B,ITTYP ; Get local version of iopdl +IPSHP: +IFE PMAPSW, PUSH B,C ; Push -> saved buffer (GC will relocate) +IFN DECSW,PUSH B,UTIBED ? PUSH B,UTIHDR +REPEAT L$FBLK, PUSH B,INFB+.RPCNT ; Save names of input file. + PUSH B,INFCUR ; Save number of input file. +IFE PMAPSW, PUSH B,D ; Lh=lh(old uredp), rh=lh(old utibed) (or just UREDP) +IFN PMAPSW, INSIRP PUSH B,[INFPAG INPGCT INLPGS UTIBPE UTIBPL UTIBPX INLCHR UREDP IUREDP ] + + ; Following three must be last pushed + INSIRP PUSH B,[IFNM1 IFNM2 IFVRS] ; Clobbered on pdl if .open successful +INPDEL==.-IPSHP ; Length of each entry on pdl + + MOVE A,FREEPT ; W must use same gc convention as putrel; + CAML A,MACHI ; Namely, gc after using up the last byte. + CALL GCA1 + MOVEI A,0 ; => input from file + MOVEM B,ITTYP ; Store back updated pointer + JSP B,PUSHTT ; Save stuff, address modify and return + + + ; Pop into the input file +IPOP: +IFN CREFSW,[ MOVEI A,2 ; If creffing, output pop-file block. + SKIPE CRFONP + PUSHJ P,CRFOUT] +IPOPL: PUSHJ P,POPTT ; Come here if .INSRT's open failed. + PUSH P,C + MOVE B,ITTYP ; Get pointer + INSIRP POP B,[IFVRS IFNM2 IFNM1] ; Pop stuff +IFE PMAPSW, POP B,A ; Pop off UREDP (or halves thereof) +IFN PMAPSW, INSIRP POP B,[ IUREDP UREDP INLCHR UTIBPX UTIBPL UTIBPE INLPGS INPGCT INFPAG] + POP B,INFCUR +REPEAT L$FBLK,POP B,INFB+L$FBLK-1-.RPCNT +IFN DECSW,[ + POP B,C + PUSH P,C ; Old UTIHDR + POP B,UTIBED +] +IFE PMAPSW, POP B,C + MOVEM B,ITTYP ; Save updated pdl pointer. +IFE PMAPSW,[ + HLRZ B,(C) ; Get length of saved buffer, +IFN ITSSW\TNXSW,[ + PUSH P,A +IFN ITSSW, CALL SETWH2 ? .IOPOP UTYIC, +IFN TNXSW, MOVEI A,UTYIC ? CALL $IOPOP + REST A + MOVEI AA,UTIBUF-1(B) ; Get addr of 1st wd won't blt into in utibuf, + HRLI AA,(A) ; Get saved lh of utibed, + MOVEM AA,UTIBED + HRRI A,UTIBUF ; Make A -> 1st wd in buffer, +] +IFN DECSW,[ + MOVE AA,UTICHN + LSH AA,27 + IOR AA,[RELEAS] + XCT AA ; This code equivalent to .IOPOP. + SOS UTICHN + REST UTIHDR +] + MOVEM A,UREDP + MOVSI A,EOFCH_13 + MOVEM A,@UTIBED ; Put EOF char after buffer. + MOVSI A,1(C) ; Get addr of 1st data wd of saved buffer, + HRRI A,UTIBUF + CAIE B,1 + BLT A,UTIBUF-2(B) + HLLZS (C) ; Tell GC to reclaim saved buffer. +] ;IFE PMAPSW + +IFN PMAPSW, CALL IOBPOP + +POPCJ: REST C + RET + +;SAVE INTERNAL POINTERS CONCERNING INPUT MODE + +TYPDEL==2 ; Number of words in relevant pdl entry + +PUSHTT: PUSH P,A + PUSH P,F + AOSN CMEOF ; If supposed to pop out of tty soon, + CALL POPTT ; Do it now before cmeof clobbered. + MOVE F,ITTYP ; Get relevant pdl pointer + MOVEI A,0 + EXCH A,CLNN ; Set up new line number + HRL A,CPGN ; Save current page number + SETZM CPGN ; Now re-initialize + SKIPGE CRFILE ; Save cref-all-on-one-line flag. + TLO A,400000 + PUSH F,A ; Save cpgn,,clnn + MOVE A,-1(P) ; Retrieve new mode + PUSHJ P,PSHLMB ; Save limbo1 and set up instructions for new mode +IFN ITSSW,[ + CALL SETWH2 + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ; Store back updated pointer + JRST POPFAJ + + ; Restore internal pointers concerning input mode + +POPTT: PUSH P,A + PUSH P,F + MOVE F,ITTYP ; Get pdl pointer + PUSHJ P,POPLMB ; Pop into limbo1, set up new mode + POP F,A ; Get cpgn,,clnn + SETZM CRFILE ; Restore all-on-one-line flag. + TLZE A,400000 + SETOM CRFILE + HLRZM A,CPGN + HRRZM A,CLNN +IFN ITSSW,[ + CALL SETWH2 + ADD A,CPGN + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ; Store back updated pointer + JRST POPFAJ + +IFN ITSSW,[ +SETWH2: MOVE A,RCHMOD + CAIL A,2 + SKIPA A,[SIXBIT /TTY:/] + MOVE A,INFB+$F6FN1 + .SUSET [.SWHO2,,A] + MOVE A,A.PASS + LSH A,30 + ADD A,[SIXBIT /P0/+1] + RET +] + +SUBTTL Storage for IO PDL stuff + + ; IO PDL storage stuff + +VBLK +TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS + ; "tty pdl", stores information about current input mode + ; (similar to macro pdl but not garbage collected) + +ITTYP: -TYPDLS-1,,TTYPDL ; Pdl pointer (typdel=length of each entry) +TTYPDL: NEDCHK ; Actual pdl: initial entry to overpop routine + BLOCK TYPDLS ; Pdl proper +PBLK + +SUBTTL TNX - IO PDL Routines (IOPDLC, $IOPUSH, $IOPOP) + +IFN TNXSW,[ + +IFN PMAPSW,[ + ; Push IO buffer & channel... +IOBPUS: PUSH P,A + MOVEI A,UTYIC + CALL $IOPUSH + MOVEI A,NIBFPS ; Point at next set of buffer pages. + ADDM A,INBFPG + POP P,A + POPJ P, + + ; Pop IO buffer & channel... +IOBPOP: PUSH P,A + MOVE A,INBFPG + HRLI A,NIBFPS + CALL DELPGS ; flush buffer pages. + MOVNI A,NIBFPS + ADDM A,INBFPG ; point down at previous set of buffer pages... + MOVEI A,UTYIC + CALL $IOPOP + POP P,A + POPJ P, + +; DELPGS - Take arg in A as <# pgs>,, and flush these pages. + +DELPGS: PUSH P,A + PUSH P,B + HLRZ B,A + HRLI A,.FHSLF ; ,, + TLO B,(PM%CNT) + PUSH P,T +DELPG2: SYSCAL PMAP,[[-1] ? A ? B][A ? A ? B] ; Free up buffer pages. + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. + TRNE B,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + AOJA A,DELPG2] ; Nope, bump page #'s. + POP P,T + POP P,B + POP P,A + POPJ P, +] ;IFN PMAPSW + +; IOPDLC - Clear IOPDL stack, close all channels on it. +; Clobbers no ACs + +; for 10x, need to CLOSF and release each JFN on IOPDL stack. + +IOPDLC: PUSH P,R1 +IFE R1-A,.ERR IOPDLC WONT WORK WITH A=1 +IFN PMAPSW,[ + MOVEI R1,1STBFP ; Reset to point at 1st page of buffer space. + MOVEM R1,INBFPG +] + EXCH A,IOPDLP + JRST IOPDC3 +IOPDC2: MOVE R1,(A) + CAME R1,ISFB+$FJFN ; Dont close main input file + CLOSF + JFCL + SUB A,[1,,1] +IOPDC3: CAMLE A,[-LIOPDL,,$IOPDL-1] + JRST IOPDC2 + EXCH A,IOPDLP + POP P,R1 + POPJ P, + +; $IOPUSH - Push I/O channel in A onto $IOPDL stack. +; Clobbers no ACs +; for 10X this means storing JFN on stack and clearing JFNCHS table entry. + +$IOPUSH:EXCH B,IOPDLP ; Get stack pointer + PUSH B,JFNCHS(A) ; save JFN for channel + EXCH B,IOPDLP + SETZM JFNCHS(A) ; Zap entry in channel table to make it look gone + POPJ P, + +; $IOPOP - Pops channel off $IOPDL into channel # in A. +; Clobbers no ACs + +; for 10X just pop $IOPDL into JFNCHS, must close and release old JFN tho. + +$IOPOP: PUSH P,T + SYSCAL CLOSF,[JFNCHS(A)] + JFCL + POP P,T + EXCH B,IOPDLP ; Get stack ptr + POP B,JFNCHS(A) + EXCH B,IOPDLP + POPJ P, + +VBLK +JFNCHS: BLOCK 20 ; Channel table index, JFNCHS(ch) gets JFN for chan. + ; (zero if none) +LIOPDL==8. ; Length of IO PDL +IOPDLP: -LIOPDL,,$IOPDL-1 +$IOPDL: BLOCK LIOPDL +PBLK +] ; IFN TNXSW + +SUBTTL DEC - IO PDL Routines (IOPDLC) + +IFN DECSW,[ + +; IOPDLC - Simulate ITS .IOPDL call. Flushes all channels from +; UTICHN downwards to UTYIC. Actually not a simulation but something +; that works in the particular situation for which MIDAS uses .IOPDL. + +IOPDLC: MOVEI A,UTYIC + EXCH A,UTICHN ; Set input chnl num. to lowest. + LSH A,27 + IOR A,[RELEAS] ; Set up to releas the highest in use first. +IOPDL1: XCT A ; Releas one input channel, + CAMN A,[RELEAS UTYIC,] + RET ; All done. + SUB A,[0 1,] + JRST IOPDL1 ; Releas the next one down. +] ;IFN DECSW + +SUBTTL COMMON TTY input routines & variables + +VBLK +CMBUF: BLOCK CMBFL ; Typein buffer (also used as JCL buffer) +CMPTR: 0 ; Byte pointer to CMBUF. +CMEOF: 0 ; -1 => POPTT instead of reloading after this bufferfull. +TTYOPF: 0 ; -1 => the TTY is already open. +LINEL: 0 ; Width of TTY (may be 1,, meaning assume infinite). +A.TTYFLG: ; Value of .TTYFLG pseudo - another label for TTYFLG. +TTYFLG: 0 ; TTY typeout permitted iff >= 0. +WSWCNT: 0 ; The number of W-switches in the last cmd string. +TTYBRF: 0 ; -1 => ^H break has been requested but not yet done. +PBLK + ; Cause input from tty (main routines) + +GTYIPA: SETZM A.TTYF ; Push to tty, don't stop at cr. + +IFN ITSSW, TYPECR "TTY: .INSRTed, end input with ^C" +IFN DECSW\TNXSW,[ + IFE SAILSW,TYPECR "TTY: .INSRTed, end input with ^Z" + IFN SAILSW,TYPECR "TTY: .INSRTed, end input with CTL-META-LF" + ] + +GTYIP1: SKIPA A,[3] +GTYIP: MOVEI A,2 ; Input from tty, stop after 1 line. + SETZM CMPTR ; Force reload on 1st read. + JSP B,PUSHTT ; Set up variables and return +GTYIPR: SETZM CMPTR ; Return on .ineof or cr + JRST POPTT + + ; Call here from ASSEM1 loop when a ^H interrupt is detected. +TTYBRK: SETZM A.TTYF + ETR [ASCIZ/^H - break /] ; Type filename, page and line #. + SKIPE ASMOUT + TYPECR "within a <>, () or []" + JRST GTYIPA + + ; RCHSET routines for reading from TTY + ; RCHMOD=3 => don't quit on CR + ; 2 => quit on CR. +RCHTRC: +RCHARC: TLO FF,FLTTY ; Set flag + JSP A,CPOPJ +RCHAC1: REPEAT 2,[ ; RCH2, RR1 + ILDB A,CMPTR ; Get char + CAIN A,0 ; End of string marked with 0 + PUSHJ P,TYRLDR ; Reload, jump back for next char +] + GOHALT ; RRL1 +IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES. + ILDB A,CMPTR ; SEMIC + CAIN A,15 + JRST SEMICR + JUMPN A,SEMIC + PUSHJ P,TYRLD + JRST SEMIC + +TYRLD: MOVEI A,3 ; Return after the call, not before. + ADDM A,(P) + + ; TYRLDR - Read in string. + ; Reload buffer if ran out in call to RCH. + +TYRLDR: AOSN CMEOF ; EOF detected after last reload => + JRST RPAEOF ; Pop out of tty. + PUSH P,A + PUSH P,B + MOVE B,RCHMOD + PUSH P,F + PUSH P,A.TTYF ; If chars rubbed out they should be printed. + SETZM A.TTYF +IFN TNXSW,SYSCAL DTI,[[.TICCV]] ; Disable ^V as an interrupt character + MOVE F,[10700,,CMBUF-1] ; Initial byte pointer to buffer + MOVEM F,CMPTR ; Store as byte pointer for read +TYRLD2: PUSHJ P,TYI ; Get character +IFN TNXSW,[ + CAMN F,CMPTR ; at beg of line? + CAIE A,^J ; and char is LF? + CAIA + JRST TYRLD2 ; If so then ignore it completely. +] + CAIN A,177 ; Rubout? + JRST TYRLD3 ; Yes + CAIE A,^C + CAIN A,^Z + JRST TYRLD7 ; ^C, ^Z => EOF. Ought to be EOFCH for consistency? + CAIN A,^U + JRST TYRLD5 ; Rub out all + CAIE B,2 ; For .TTYMAC handling, convert lower case to upper. + JRST TYRLD6 + CAIL A,"A+40 + CAILE A,"Z+40 + CAIA + SUBI A,40 +TYRLD6: CAME F,[010700,,CMBUF+CMBFL-2] + IDPB A,F ; Store character in buffer unless buffer nearly full. + CAIE A,^M ; CR? + JRST TYRLD2 ; No, go back for next + CAIN B,2 ; .TTYMAC (mode 2) => CR ends input, so fake EOF. + SETOM CMEOF + MOVEI A,^J ; Follow the CR with a LF. + IDPB A,F + PUSH P,F ; Output the entire line to the error file + MOVE F,[10700,,CMBUF-1] +TYRLD8: CAMN F,(P) + JRST TYRLD9 + ILDB A,F + CAIN A,^M ; If line was ended by a ^C or ^Z, put that in error + SKIPL CMEOF ; file, which needs hair since that char is not + JRST TYRLD0 ; In the string we stored. + MOVEI A,"^ + CALL ERRCHR +IFN ITSSW,MOVEI A,"C +IFN DECSW\TNXSW,MOVEI A,"Z + CALL ERRCHR + LDB A,F +TYRLD0: CALL ERRCHR + JRST TYRLD8 + +TYRLD9: REST F + MOVEI A,0 + IDPB A,F ; Mark end of string + IDPB A,F +IFN TNXSW,SYSCAL ATI,[[.TICCV,,.IC.CV]] ; Turn back on ^V + REST A.TTYF + REST F + REST B + REST A + JRST RCHTRA + +TYRLD7: SETOM CMEOF ; ^C, ^Z force EOF, + CALL TYRLCR ; After turning into ^M. + MOVEI A,^M + JRST TYRLD6 + +TYRLCR: MOVEI A,^M + CALL TYOX + MOVEI A,^J + JRST TYOX + +TYRLD3: CAMN F,[10700,,CMBUF-1] ; Rubout, beginning of buffer? + JRST TYRLD4 ; Yes + LDB A,F ; Get last character in buffer + CALL TYOX ; Type it out, don't write in error file. + ADD F,[70000,,] ; Decrement pointer + JUMPGE F,TYRLD2 ; Jump if valid + SUB F,[430000,,1] ; Was 440700,,something, back it up + JRST TYRLD2 + +TYRLD5: MOVE F,[10700,,CMBUF-1] ; ^U, back to beginning of line +TYRLD4: PUSHJ P,TYRLCR ; Rubout when at beginning of buffer, type CR + JRST TYRLD2 + +SUBTTL ITS - TTY routines (TYOX, TYI, TTYINI) and JCLINI. + +IFN ITSSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOPF + CALL TTYINI + .IOT TYOC,A + POPJ P, + + ; TYI - Get (just typed in) char in A +TYI: SKIPN TTYOPF + CALL TTYINI ; Open the tty if not already done. + .IOT TYIC,A + ANDI A,-1 ; Non-tty devices can return -1,,3. + JUMPE A,TYI + CAIN A,^L ; This must be assuming that ^L clears screen? + JRST TYI + POPJ P, + + ; Initialize tty +TTYINI: PUSH P,A + .OPEN TYIC,[.UAI,,'TTY] ; Input + .LOSE + .OPEN TYOC,[%TJDIS+.UAO,,'TTY] ; Display mode output + .LOSE + SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A] + MOVSI A,1 ; TTY: is translated to something else => assume infinite linel + MOVEM A,LINEL ; Else linel gets width of tty. + SETOM TTYOPF ; Say the tty is now open. + JRST POPAJ + +JCLINI: SETZM CMPTR + .SUSET [.ROPTIO,,A] + TLNN A,%OPCMD ; Has our superior said it has a cmd? + RET ; No. + BLTZ CMBFL-1,CMBUF ; Zero all but last word, + SETOM CMBUF+CMBFL-1 ; and ensure last word non-zero. + .BREAK 12,[5,,CMBUF] ; Try to read command string. + MOVE A,[440700,,CMBUF] + SKIPE CMBUF ; If read a cmd-string, + MOVEM A,CMPTR ; Tell TYRLD, GO2A it's there. + POPJ P, + +]; END IFN ITSSW + +SUBTTL TNX - TTY routines (TYOX, TYI, TTYINI) and JCLINI + +IFN TNXSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOPF + CALL TTYINI +IFN A-1,EXCH A,R1 + PBOUT +IFN A-1,EXCH A,R1 + POPJ P, + + ; TYI - Get (just typed in) char in A + ; There is a screw for 20X in that it's not really possible + ; to know if the system is going to feed you a CR-LF + ; or just a CR; TYRLD2 checks for that, by flushing LF's, but + ; this would be the place to check if it were easy to do. +TYI: SKIPN TTYOPF + CALL TTYINI ; Open the tty if not already done. +IFN A-1,EXCH R1,A + PBIN ; Get char into AC 1 + JUMPE R1,.-1 ; Ignore nulls. + TLNE FF,FL20X ; Cretinous differences between 10X/20X + JRST TYI2 ; 20X, skip EOL check. + CAIN R1,^_ ; On 10X, CR turned into ^_ (EOL); change it back. + MOVEI R1,^M +TYI2: +IFN A-1,EXCH R1,A ; Restore everything to right place if necessary. + POPJ P, + + ; TTYINI - Initialize tty + +TTYINI: PUSH P,A + PUSH P,T + SYSCAL RFMOD,[[.PRIIN]][A ? A] + POP P,T + HLRZS A + ANDI A,177 ; Terminal width + CAIGE A,30. ; If too low, + ADDI A,128. ; Assume twenex crockishness + MOVEM A,LINEL ; Linel gets width of tty. + SETOM TTYOPF ; Say the tty is now open. + POP P,A + POPJ P, + + ; Read "JCL" - RSCAN buffer or nnnMID.TMP file (from CCL) + +JCLINI: SETZM CMPTR + SKIPE CCLFLG ; Started at CCL location? + JRST JCLIN5 ; Yep, go snarf stuff specially. + TLNN FF,FL20X ; Is this Tenex? + JRST [ MOVEI R1,.PRIIN + BKJFN ; see what previous character was + POPJ P,; *Gasp* + PBIN + CAIE R1,^_ ; Tenex newline? + SETOM CMPTR ; No, set flag saying "TTY but no prompt" + POPJ P,]; and skip the Twenex hackery below + SETZ R1, ; If not, check RSCAN. + RSCAN ; See if have anything in RSCAN buffer. + POPJ P, ; Huh? Shouldn't happen, but ignore it. + JUMPLE R1,APOPJ ; Also return if char cnt says nothing there. + MOVNI R3,(R1) ; Aha, set up cnt for SIN + HRROI R2,CMBUF + MOVEI R1,.CTTRM ; Now ready for business... + SIN + LDB R1,R2 ; Now examine wages thereof + CAIE R1,^M ; Last char CR? + JRST [ MOVEI R1,^M + IDPB R1,R2 ; If not, make it so. + JRST .+1] + SETZ R1, + IDPB R1,R2 ; Must also ensure ASCIZ. + + MOVE B,[440700,,CMBUF] ; Flush any spaces in front + ILDB A,B + CAIN A,40 + JRST .-2 + + ; If the rescan line starts with "RUN", skip that. + MOVE C,B ; Save backup pos +IRPC X,,[RUN] + CAIE A,"X+40 ; Allow lowercase + CAIN A,"X + CAIA + JRST JCLIN2 ; Jump as soon as no match + ILDB A,B ; Matched, get next char. +TERMIN + +JCLIN2: CAIE A,40 ; Is next char a space? + JRST [ MOVE B,C ; When non-space seen, back up to saved pos + LDB A,B + JRST JCLIN4] + ILDB A,B ; Saw space so we won. Get next char + MOVE C,B ; Say backup should start here + JRST JCLIN2 ; and flush all spaces. + + ILDB A,B +JCLIN4: CAILE A,40 ; Now skip the filename used to invoke MIDAS. + JRST .-2 ; Flush until random ctl seen (space, ^M) + CAIE A,40 ; If it wasn't a space, + POPJ P, ; then forget about the whole thing. +JCLIN3: MOVE C,B ; Now flush spaces. Save last ptr for chars. + ILDB A,B + CAIN A,40 + JRST JCLIN3 + CAIN A,^M ; And is first non-space something besides CR? + POPJ P, ; Bah, there wasn't anything in the JCL!! + MOVEM C,CMPTR ; Else save ptr to start of real goods. + POPJ P, + + ; TNX snarf of CCL file. No such thing as tmpcor, so just + ; look for real file with appropriate name. +JCLIN5: SETZM CCLFLG ; Want 0 in case abort out, will reset if win. + GJINF ; Get job # in R3 + HRROI R1,CMBUF ; Use CMBUF to form filename string. + MOVEI R2,(R3) + MOVE R3,[NO%LFL+NO%ZRO+<3_18.>+10.] + NOUT ; ship out job num in 3 digits, radix 10. + GOHALT + HRROI R2,[ASCIZ /MID.TMP/] + SETZ R3, + SOUT ; Flesh out rest of filename string. + SETZ R2, ; Make sure it's ASCIZ. + BOUT + MOVE R1,[GJ%OLD+GJ%SHT] ; Use short-form GTJFN + HRROI R2,CMBUF ; and gobble name from CMBUF. + GTJFN + POPJ P, ; If failed, forget it. + MOVE R2,[070000,,OF%RD] ; Read 7-bit bytes + OPENF + POPJ P, ; Bah + HRROI R2,CMBUF ; Gobble stuff up. + MOVEI R3,CMBFL*5 ; Read until buffer full, + MOVEI R4,^J ; or LF seen. + SIN + JUMPLE R3,APOPJ ; Forget it if too big for buffer!! + + MOVE R2,[440700,,CMBUF] ; Aha, we've got something, so set + MOVEM R2,CMPTR ; pointer to slurped stuff. + SETOM CCLFLG + HRROI R2,UTIBUF ; Slurp rest into larger buffer, + MOVNI R3,UTIBFL*5 ; using count only. + SIN + JUMPGE R3,APOPJ ; Refuse to hack grossly large file. + ADDI R3,UTIBFL*5 + JUMPLE R3,APOPJ ; if nothing read, need write nothing out. + HRLI R1,(CO%NRJ) ; Don't release JFN, + CLOSF ; but stop reading from file. + POPJ P, + MOVE R2,[070000,,OF%WR] ; Now try to hack write access. + OPENF + POPJ P, + MOVE R2,R1 ; Source becomes destination... + HRROI R1,UTIBUF ; and UTIBUF becomes source, + MOVNS R3 ; for just as many bytes as were read. + SOUT + MOVEI R1,(R2) ; done, now just close file. + CLOSF ; (this time, release JFN). + POPJ P, + SETOM CCLMOR ; say that more CCL remains. + POPJ P, +] ; END IFN TNXSW + +SUBTTL DEC - TTY routines (TYOX, TYI, TTYINI) + +IFN DECSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOPF + CALL TTYINI + OUTCHR A + POPJ P, + + ; TYI - Get a typed-in char in A + +TYI: SKIPN TTYOPF ; Open the tty, if not already done. + CALL TTYINI + INCHWL A +IFN SAILSW,[ + CAIN A,612 ; On SAIL, EOF is 612, + MOVEI A,^Z ; so turn into normal EOF if found. +] + CAIE A,^M ; Throw away the LF after a CR. + RET + INCHWL A + MOVEI A,^M ; Note that TYRLDR will put it back in. + RET + +TTYINI: INSIRP PUSH P,AA A B +IFE SAILSW,[ + PJOB A, + TRMNO. A, + JRST TTYIN1 + MOVEI AA,1012 ; .TOWID + MOVE B,[2,,AA] + TRMOP. B, ; Read width of tty line into B. +] +TTYIN1: MOVEI B,80. ; TRMOP. failed or not tried => assume width is 80. + MOVEM B,LINEL + INSIRP POP P,B A AA + SETOM TTYOPF + RET + + TMPLOC .JBREN, TTYREN +TTYREN: SETOM TTYBRF ; "REENTER" command comes here +R: G: JRST @.JBOPC ; To request a ^H-break. Note crufty labels pointing here. + +];IFN DECSW + +SUBTTL DEC Hackery for JCLINI - Read CCL commands. + +IFN DECSW\TNXSW,[ +VBLK +CCLFLG: 0 ; Flag to indicate CCL entry from COMPIL, SNAIL, CCL, or EXEC +CCLMOR: 0 ; -1 => There are more lines of CCL commands, + ; so do a RUN SYS:MIDAS when finished. +PBLK +] + +IFN DECSW,[ ; DEC only hacks CCL as "JCL". + +.SCALAR CCLFIL ; Saves FN1 for tmp file hacking. + +; Read MID temp core file, if that loses, try nnnMID.TMP file. +; Clobbers A,B,C,D. + +JCLINI: SETZM CMPTR + SKIPN CCLFLG ; Was midas called from CCL level? + RET ; No, do not snarf tempcore + SETZM CCLFIL ; No CCL file yet + SETZM CCLFLG ; If tmpcor loses want this 0 (will re-setom below) + BLTZ CMBFL,CMBUF ; Zero cmd buffer. + MOVE A,[2,,['MID,, ? -,,CMBUF-1]] ; read (leave last wd 0) + TMPCOR A, ; Read compil-generated command + JRST [ OPEN [17 ? 'DSK,, ? 0] ; No tempcore, maybe try dump mode. + RET ; Argh but let something else die + PJOB A, ; Get job # + IDIVI A,100. ; Want decimal job number in sixbit + ADDI A,'0 + LSH A,6 + IDIVI B,10. + ADDI A,'0(B) + LSH A,6 + ADDI A,'0(C) + LSH A,18. + HRRI A,'MID ; Form file name as nnnMID.TMP + MOVEM A,CCLFIL ; Save for writing below + MOVSI B,'TMP + SETZB C,D ; No protect or ppn trash + LOOKUP A ; Try to get file + RET ; Give up + MOVE A,[-,,CMBUF-1] + SETZ B, + INPUT A ; Try to read command + SETZB A,B + RENAME A ; Try to delete it now + JFCL ; Ignore failure + CLOSE ; Happy sail + JRST .+1] + SKIPN CMBUF ; One last check for it to be there + RET ; Alas, there is none + MOVE A,[440700,,CMBUF] ; Load a byte pointer to the command + SETOM CCLFLG + MOVEM A,CMPTR ; There is, set command pointer +JCLIN1: ILDB B,A + CAIE B,^J ; See if our command file has anything after 1st line. + JRST JCLIN1 + ILDB B,A + JUMPE B,JCLIN3 + SETOM CCLMOR ; It does; set flag so after handling 1st line we'll + MOVE C,[440700,,UTIBUF+2] +JCLIN2: IDPB B,C + ILDB B,A + JUMPN B,JCLIN2 + SUBI C,UTIBUF+1 ; Get # words written in utibuf. operand is relocatable! + HRLOI C,-1(C) ; These 2 insns turn size into -size,,utibuf+1 + EQVI C,UTIBUF+1 + MOVEM C,UTIBUF+1 + SKIPE A,CCLFIL ; Was this called with a temp file? + JRST [ MOVSI B,'TMP + SETZB C,D + ENTER A ; Try to re-write file + RET ; Sigh + MOVE A,UTIBUF+1 + SETZ B, + OUTPUT A + RELEASE + RET] + MOVSI C,'MID + MOVEM C,UTIBUF + MOVE C,[3,,UTIBUF] + TMPCOR C, + JFCL ; [KLH - there used to be some random cruft here.] +JCLIN3: RET + +] ;END IFN DECSW + +SUBTTL Old Command Line Reader (CMD) +ifn 0,[ + ; Read command & filenames & hack defaulting. + +CMD: SKIPE CMPTR ; Unless have DDT or RSCAN cmd string, + JRST CMD06 ; (we don't) + CALL CRR ; type a CRLF, prompt etc. +CMD05: SETZM CMPTR + TYPE "*" +CMD06: MOVEI A,3 ; Read from TTY (or string <- cmptr) + CALL RCHSET + MOVEI F,FB ; Point to scratch filblk. + BLTZ L$FBLK,FB ; and clear the whole thing. + TRO FF,FRCMND ; Tell RFD it's scanning a command line. + CALL RFD ; Now see if command null, and whether has _. +IFN DECSW\TNXSW,[ + CAIN A,"! ; If terminator was "!", go run program. + JRST RFDRUN +] + TRNN FF,FRNNUL ; If no filespec was seen, + CAIE A,^M ; and terminator is EOL, + CAIA + JRST CMD05 ; then prompt again and get another string. + TRZ FF,FRARRO ; Got something, clear saw-"_" flag. +CMD07: CAIN A,"_ + TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. + CAIN A,^M + JRST CMD1 ; Read thru the whole command. + CALL RFD + JRST CMD07 + + ; Now re-read the string, for real this time. Previous scan was + ; mainly just to see if "_" existed. If not, then first filename + ; must be input file, and output filenames are all defaulted. +CMD1: MOVE T,[440700,,CMBUF] ; Restore original ptr to + MOVEM T,CMPTR ; beginning of string. +IFN CREFSW,SETZM CREFP ; Clear all switches before decoding them. +INSIRP SETZM 0,ERRFP TTYINS WSWCNT +IFN LISTSW,[ + SETZM LISTP + SETOM LISTP1 ; Will be AOSed by each (L) switch. +] + + MOVE T,FSDSK + MOVEM T,$FDEV(F) +IFE TNXSW,[MOVE T,RSYSNM ? MOVEM T,$FDIR(F)] +IFN TNXSW, SETZM $FDIR(F) + SETZM $FNAME(F) + SETZM $FEXT(F) + + TRZ FF,FRNNUL + TRNE FF,FRARRO ; Don't gobble input spec as output! + CALL RFD ; Read bin file spec. + MOVE TT,FF ; Remember whether null + BLTMAC T,L$FBLK,(F),OUTFB ; Copy from scratch to OUTFB. + + MOVE T,$FDEV(F) + CAMN T,FSNUL + MOVE T,FSDSK + MOVEM T,$FDEV(F) +IFE ITSSW, MOVE T,FSCRF +IFN ITSSW, MOVE T,FSCREF + MOVEM T,$FEXT(F) + + TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, + MOVEI A,"_ ; then only filespec is for input, kludge to get it. + CAIN A,"_ ; If "_" exists in cmd line, did we hit it? + JRST CMD2 ; Ran out of output specs => just use defaults. + CALL RFD ; Read cref file spec. +IFN CREFSW,[ + TRNN FF,FRNNUL ; If spec not null or ended by _, + CAIN A,"_ + SETOM CREFP ; We must want to cref. +CMD2: BLTMAC T,L$FBLK,(F),CRFFB ; Copy specs from FB to CREF FB. +] +IFE CREFSW,CMD2: + MOVE T,FSERR + MOVEM T,$FEXT(F) + CAIN A,"_ + JRST CMD6 ; No more output specs. + CALL RFD ; Read error file sppec. +IFN ERRSW,[ + TRNN FF,FRNNUL ; Nonnull spec or last spec => + CAIN A,"_ + SETOM ERRFP ; Must want an error file. +CMD6: BLTMAC T,L$FBLK,(F),ERRFB ; Copy specs from FB to ERR filblk. +] +IFE ERRSW,CMD6: +IFN LISTSW,[ +IFE ITSSW, MOVE T,FSLST +IFN ITSSW, MOVE T,FSLIST + MOVEM T,$FEXT(F) + CAIN A,"_ ; Any output spec remaining? + JRST CMD3 + CALL RFD ; Yes, read one. + SETOM LISTP ; List spec given implies want listing. +CMD3: BLTMAC T,L$FBLK,(F),LSTFB ; Copy specs from FB to LST filblk. +] + +CMD5: CAIN A,"_ + JRST CMD4 + CALL RFD ; Ignore any output specs not needed. + JRST CMD5 + +CMD4: MOVE T,FSDSK ; Default the input names. + MOVE A,$FDEV(F) + CAME A,FSPTP ; Don't leave dev name set to common out-only devs. + CAMN A,FSNUL + MOVEM T,$FDEV(F) +IFE ITSSW, MOVE T,FSMID +IFN ITSSW, MOVE T,FSGRTN ; > on ITS. + MOVEM T,$FEXT(F) + MOVE T,FSPROG + SKIPN $FNAME(F) ; The fn1 alone is sticky across the _. + MOVEM T,$FNAME(F) + + TRZ FF,FRARRO ; If only 1 name it should be FNAM1. + CALL RFD ; Read input spec. + BLTMAC T,L$FBLK,(F),ISFB ; Copy into specified-input filblk. + MOVE T,$FNAME(F) ; Default output FN1's to input. + SKIPN OUTFB+$FNAME + MOVEM T,OUTFB+$FNAME +IFN CREFSW,[ + SKIPN CRFFB+$FNAME + MOVEM T,CRFFB+$FNAME +] +IFN LISTSW,[ + SKIPN LSTFB+$FNAME + MOVEM T,LSTFB+$FNAME +] +IFN ERRSW,[ + SKIPN ERRFB+$FNAME + MOVEM T,ERRFB+$FNAME +] + MOVE A,FSNUL ; The output dev defaults to NUL: + MOVE T,$FDEV(F) ; If the input is from TTY: + CAMN T,FSTTY + TRNE FF,FRNNUL ; And the bin spec was null. + CAIA + MOVEM A,OUTFB+$FDEV + TRZ FF,FRARRO ; Don't louse up .INSRT's reading. + RET +] ;ifn 0 + +SUBTTL Command Line Reader (CMD) + + ; CMD - Read command & filenames & hack defaulting. + +.SCALAR CMDPSV ; Saves read ptr into CMBUF, for re-scanning. + +CMD: MOVE T,CMPTR ; Check JCL. + CAMN T,[-1] ; If Tenex-type "JCL", + JRST CMD06X ; normal TTY input 'cept no prompt. + JUMPL T,CMD06 ; For DDT/RSCAN/CCL strings, type nothing out. + CALL CRR ; Else must type a CRLF, prompt etc. +CMD05: TYPE "*" +CMD06X: SETZB T,CMPTR +CMD06: MOVEM T,CMDPSV ; Save pointer for later restoration + MOVEI A,3 ; Read from TTY (or string <- cmptr) + CALL RCHSET + + MOVEI F,ISFB ; Point to input-spec filblk. + BLTZ L$FBLK,(F) ; Zap it through and through. + TRO FF,FRCMND ; Tell RFD it's scanning a command line. + CALL RFD ; Now see if command null, and whether has _. +IFN DECSW\TNXSW,[ + CAIN A,"! ; If terminator was "!", go run program. + JRST RFDRUN +] + TRNN FF,FRNNUL ; If no filespec was seen, + CAIE A,^M ; and terminator is EOL, + CAIA + JRST CMD05 ; then prompt again and get another string. + TRZA FF,FRARRO ; Got something, clear saw-"_" flag. +CMD07: CALL RFD + CAIN A,"_ + JRST [ TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. + CALL RFD ; Gobble next filename, input filespec. + JRST CMD1] + CAIE A,^M + JRST CMD07 ; Read thru the whole command until read input filespec + + + ; Now re-read the string, for real this time. Previous scan was + ; mainly to latch onto input filespec and see if "_" existed. + +CMD1: SKIPN T,CMDPSV ; Restore original ptr if there's one, + MOVE T,[440700,,CMBUF] ; else point at beg of buffer. + MOVEM T,CMPTR + SETZM TTYINS ? SETZM WSWCNT ; Clear all switches. +IFN CREFSW,SETZM CREFP +IFN ERRSW, SETZM ERRFP +IFN LISTSW,SETZM LISTP ? SETOM LISTP1 ; Will be AOSed by each (L) switch. + SETZ A, + TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, + MOVEI A,"_ ; then only filespec is for input, kludge to get it. + + MOVEI F,OUTFB + BLTZAC T,L$FBLK,(F) ; Clear output filblk. + MOVE T,FSDSK ; Default dev to DSK. + MOVEM T,$FDEV(F) + SKIPN T,$FNAME+ISFB ; Now default FN1 from input filespec + MOVE T,FSPROG ; (use "PROG" if none) + MOVEM T,$FNAME(F) +IFE TNXSW,[MOVE T,RSYSNM ; Now default directory if need to + MOVEM T,$FDIR(F)] + + TRZ FF,FRNNUL + CAIE A,"_ ; If it exists, + CALL RFD ; Read bin file spec. + TRNN FF,FRNNUL ; If spec was null, + JRST [ MOVE T,FSTTY ; and input spec was TTY:, + CAME T,$FDEV+ISFB + JRST .+1 + MOVE T,FSNUL ; then set device to NUL:. + MOVEM T,$FDEV(F) + JRST .+1] + +DEFINE CFMAC SWIT,PTR,INSTR,DEXT +IFN SWIT,[ + MOVE T,DEXT + MOVE TT,[[INSTR],,PTR] +] .ELSE SETZB T,TT + PUSHJ P,CMDFGT +TERMIN + + CFMAC CREFSW,CRFFB,[SETOM CREFP][IFN ITSSW,[FSCREF] .ELSE FSCRF] + + CFMAC ERRSW, ERRFB,[SETOM ERRFP] FSERR + + CFMAC LISTSW,LSTFB,[SETOM LISTP][IFN ITSSW,[FSLIST] .ELSE FSLST] + +CMD50: CAIE A,"_ + JRST [ SETZB T,TT ; Point to scratch FB etc. + CALL CMDFGT ; Ignore any output specs not needed. + JRST CMD50] ; Must do this way to retain default stuffs. + + ; Finally read input file. + BLTMAC T,L$FBLK,(F),ISFB ; Copy last stuff to input spec + MOVEI F,ISFB ; and point at it. + PUSHJ P,CMDDVX ; Hack device-name default. +IFE ITSSW, MOVE T,FSMID +IFN ITSSW, MOVE T,FSGRTN ; > on ITS. + MOVEM T,$FEXT(F) + CALL RFD ; Read input spec. + RET ; Yep, that's really all! + + ; TT has ,, + ; T has default $FEXT. + ; Takes defaults from current F, sets F to new filblk. +CMDFGT: JUMPE TT,[SETZ T, ; If 0, do usual but into oblivion (scratch FB) + MOVE TT,[[JFCL],,FB] + JRST .+1] + BLTMAC B,L$FBLK,(F),(TT) ; Copy from current filblk to new. + MOVE F,TT ; set new F. + MOVEM T,$FEXT(F) ; Set default $FEXT + PUSHJ P,CMDDVX ; Set up device, defaulting to DSK. + CAIN A,"_ ; If last delimiter was start of input spec, + POPJ P, ; don't read anything - just use defaults. + PUSHJ P,RFD + TRNN FF,FRNNUL ; If spec non-null or + CAIN A,"_ ; ended by _, then + CAIA ; hack specified instr. + POPJ P, + HLRZ T,F + XCT (T) + POPJ P, + +CMDDVX: SKIPN T,$FDEV(F) + MOVE T,FSDSK + CAME T,FSPTP + CAMN T,FSNUL + MOVE T,FSDSK + MOVEM T,$FDEV(F) + POPJ P, + +SUBTTL ITS/DEC Filename Reader/printer (RFD, TYPFB) + +IFN DECSW\ITSSW,[ ; Begin moby conditional for sixbit reader. + +; RFD - Reads a single file description from .INSRT or command line, +; using RCH, into specified FILBLK. +; F points at FILBLK to store description in. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) +; If FRCMND set, recognize -, comma, / and ( as special characters, +; and hack switches. +; Sets FRNNUL if spec was nonnull. +; Clobbers A,B,C only. + +RFD: TRZ FF,FRNNUL +RFD01: SETZM RFDCNT ; Zero cnt of "normal" filenames. Jump here if see ^R. + +RFD10: PUSHJ P,GPASST ; Flush out spaces/tabs + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semi-colon, + JRST RFD22 ; just handle normally. +RFD15: PUSHJ P,RCH ; Semi-colon and not command line!! Flush rest + CAIE A,^M ; of line, assuming it's a comment! + JRST RFD15 + POPJ P, + +RFD2: PUSHJ P,RCH ; Get character in A +RFD20: CAIE A,40 ; Space (Come here to scan already-read char.) + CAIN A,^I ; or tab? + JRST RFD10 ; Ach, go into flush-whitespace loop. +RFD22: CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST RFD01 ; Sigh, pretend just starting to read filename. + TRNN FF,FRCMND ; Reading command line? + JRST RFD40 ; Nope, skip over cmnd-line frobs. + + ; Reading cmd line, test special chars. +IFN ITSSW\SAILSW, CAIN A," ; SAIL underscore, ITS backarrow like _. + .ELSE CAIN A,"= ; Either gets munged, + MOVEI A,"_ ; into canonical "_". + CAIE A,"_ ; Backarrow is output_input marker. + CAIN A,", ; Comma is also a terminator... + POPJ P, +IFN DECSW\TNXSW,[ ; I'm not sure if this belongs here, but + CAIN A,"! .SEE RFDRUN + POPJ P, +] + PUSHJ P,CMDSW ; Check for switches... + JRST RFD20 ; Got some, scan next char (returned by CMDSW) + ; Got none, drop thru. + + + ; No special delimiters, + ; Check for chars which signal what following word is. +RFD40: +IFN DECSW,[ + CAIN A,"[ ;] Left bracket signals start of PPN. + JRST [ PUSHJ P,RFDPPN ; Slurp it up, + MOVEM C,$F6DIR(F) ; store it, + TRO FF,FRNNUL ; saying spec not null. + JRST RFD20] ; and go process leftover delimiter. + + CAIN A,". ; Period signals start of extension. + JRST [ PUSHJ P,RCH ; Get the next character + PUSHJ P,RFDW ; Read in a word. + MOVEM C,$F6EXT(F) ; Store it... + TRO FF,FRNNUL ; and say spec non-null (even if C/ 0) + JRST RFD20] ; and process delimiting char. +] + + ; Here, char doesn't signal the start of anything, so we'll assume + ; it's the start of a name. + PUSHJ P,RFDW ; Gobble up a word. + JUMPE C,RFD2 ; If nothing was read, must ignore char; get another. + + ; Aha, name was read, now examine delimiter to see if it specifies + ; anything we know about. + TRO FF,FRNNUL ; Set flag saying spec non-null. + CAIN A,": ; If colon... + JRST [ MOVEM C,$F6DEV(F) ; Then store name as device. + JRST RFD2] ; and flush delimiter. +IFN ITSSW,[ + CAIN A,"; ; If semicolon... + JRST [ MOVEM C,$F6DIR(F) ; Then store name as directory (sname) + JRST RFD2] ; and flush delimiter. +] + ; Whatever it is, at this point delimiter doesn't signify anything + ; special in terms of what the name is. So we just store it, using + ; the usual FN1 FN2 DEV DIR sequence, and hand delimiter off to + ; the prefix scanning stuff. + MOVE B,RFDCNT ; Get current count for random names. + XCT RFDTAB(B) ; Either MOVEM C, to right place, or ignore + AOS RFDCNT ; by skipping over this instr. + JRST RFD20 ; and go examine delimiter. + + +.SCALAR RFDCNT ; Count to index RFDTAB by. + +RFDTAB: MOVEM C,$F6FNM(F) ; 1st name. + MOVEM C,$F6EXT(F) ; 2nd name. + MOVEM C,$F6DEV(F) ; 3rd name is dev. + MOVEM C,$F6DIR(F) ; 4th is sname. + CAIA ; 5th and on ignored, don't incr. cnt. + +; RFDW - Reads a "word" - any string of contiguous SIXBIT chars, +; barring certain delimiters, and leaves SIXBIT result in C. +; Begins reading with char currently in A. Returns with delimiter +; char in A (it's possible this can be the same char!) +; Clobbers B. + +RFDW: SETZ C, ; First things first, zap result. + SKIPA B,[440600,,C] +RFDW2: PUSHJ P,RCH + CAIN A,^Q ; Is char the quoter char? + JRST [ PUSHJ P,RCH ; Yup, gobble next... + CAIN A,^M ; and accept anything but CR + POPJ P, ; since that terminates the whole line. + JRST RFDW7] ; OK, go stuff the char into C. + CAIE A,40 ; Space + CAIN A,^I ; or tab + POPJ P, ; is always a break. + CAIN A,^M ; As is CR. + POPJ P, + TRNN FF,FRCMND ; And certain chars are bummers when reading cmd. + JRST RFDW4 + CAIE A,"/ + CAIN A,"( + POPJ P, +IFN DECSW\TNXSW, CAIE A,"= + CAIN A,"_ + POPJ P, +IFN ITSSW\SAILSW, CAIE A," + CAIN A,", + POPJ P, +IFN DECSW\TNXSW,[ + CAIN A,"! + POPJ P, +] + ; Not reading cmd line, or no cmd-line type chars seen. +RFDW4: +IFN ITSSW,[ + CAIE A,": ; For ITS filenames, these chars are special. + CAIN A,"; + POPJ P, +] +IFN DECSW,[ + CAIL A,140 ; For DEC, allow only alphanumeric. + SUBI A,40 ; cvt to uppercase, then + CAIL A,"A ; see if alpha. + CAILE A,"Z + JRST [CAIL A,"0 ; Nope, see if numeric. + CAILE A,"9 + POPJ P, ; Not alphanumeric, assume delimiter. + JRST .+1] +] +RFDW7: TLNN B,770000 ; Enough room in C for another char? + JRST RFDW2 ; Nope, ignore it and get next. + CAIL A,140 ; Enuf room, cvt lower to uppercase + SUBI A,40 + SUBI A,40 ; and cvt to sixbit, + IDPB A,B ; and deposit. + JRST RFDW2 ; Get another. + +] ; END IFN DECSW\ITSSW + +IFN DECSW,[ ; PPN Reader + +RFDPPN: PUSHJ P,RFDOCT ; Read project num, +IFN CMUSW, JUMPE C,RCMUPP ; At CMU watch for our funny ppns + HRLM C,(P) + PUSHJ P,RFDOCT ; Read programmer num. + HLL C,(P) + POPJ P, + +IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8 ; Read octal numbers. +IFN SAILSW,RFDOCL==40 ? RFDOCH==140 ; Read sixbit (right-justified). + +RFDOCT: SETZ C, ; Read octal num, return in C. +RFDOC1: PUSHJ P,RCH + CAIL A,140 + SUBI A,40 +IFN SAILSW,[ ;[ ; Even if reading sixbit names (for SAIL), + CAIE A,", ; Comma and closebracket are still special. + CAIN A,"] + POPJ P, +] + CAIL A,RFDOCL + CAIL A,RFDOCH + POPJ P, ; Not octal or not 6bit, return. + IMULI C,RFDOCH-RFDOCL + ADDI C,-RFDOCL(A) + JRST RFDOC1 + +IFN CMUSW,[ ; [ +RCMUPP: CAIN A,"] ; Watch out for [] + POPJ P, +REPEAT 4, SETZM PPNBUF+.RPCNT + MOVE C,[440700,,PPNBUF] +RCMUPL: CAIE A,^M ; Don't look too far + SKIPE PPNBUF+3 + JRST RCMUPD + IDPB A,C + PUSHJ P,RCH ; [ + CAIE A,"] + JRST RCMUPL +RCMUPD: MOVE A,[C,,PPNBUF] + CMUDEC A, + SETZ C, + POPJ P, + +.VECTOR PPNBUF(4) ; Storage to buffer up a string for CMUDEC uuo to scan. + +] ;IFN CMUSW +] ;IFN DECSW + +IFN DECSW\ITSSW,[ + +; TYPFB - Type out current filblk (what F points at) as file specification +; Clobbers A,B,C + +TYPFB: MOVSI C,-3-ITSSW + HRR C,F +TYPF1: MOVE B,$F6DEV(C) ; Get next name + PUSHJ P,SIXTYO ; Type out name + HLRZ A,C + MOVE A,FILSPC+3+ITSSW(A) ; Now get delimiting character + PUSHJ P,TYOERR ; Type out + AOBJN C,TYPF1 ; Loop for all names +IFN ITSSW, POPJ P, +IFN DECSW,[ + SKIPN B,$F6DEV(C) ; On DEC system PPN is a special case + POPJ P, + MOVEI A,"[ ;] + CALL TYOERR +IFN CMUSW,[ + MOVE A,[B,,PPNBUF] + DECCMU A, + JRST OCTPPN + TYPR PPNBUF + JRST PPNRB + ] +IFE SAILSW,[ +OCTPPN: HLRZ B,$F6DEV(C) ; LH is proj, + CALL OCTPNT + ] +.ELSE [ HLLZ B,$F6DEV(C) + CALL SIXTYO +] + MOVEI A,", + CALL TYOERR +IFE SAILSW,[ + HRRZ B,$F6DEV(C) + CALL OCTPNT ; RH is prog. +] +.ELSE [ HRLZ B,$F6DEV(C) + CALL SIXTYO + ] +PPNRB: ; [ + MOVEI A,"] + JRST TYOERR +];IFN DECSW + +FILSPC: ": +IFN ITSSW, 40 ? 40 ? "; +IFN DECSW, ". ? 0 + +] ; END IFN DECSW\ITSSW + +SUBTTL Command switches + +; CMDSW - Hacks either a single switch or switch list; A should +; contain "/ for the former, "( for the latter. +; Returns in A next char after switch hackery done. This may be ^M. +; Skip returns if neither "/ nor "( was furnished to it. + +CMDSW: CAIN A,"/ ; Single switch? + JRST [ PUSHJ P,RCH ; Get next char + CAIN A,^M + POPJ P, + PUSHJ P,CMDSW1 + PJRST RCH] + CAIE A,"( ; Switch list? + JRST POPJ1 ; Neither slash nor paren, make skip return. +CMDSWL: PUSHJ P,RCH + CAIN A,^M + POPJ P, + CAIN A,") + PJRST RCH + PUSHJ P,CMDSW1 + JRST CMDSWL + + ; Command switch processing. CMDSW1 processes the switch char + ; in A. +CMDSW1: CAIL A,140 ; Lower case to upper. + SUBI A,40 + CAIN A,"T + SOS TTYINS ; Count # T-switches. + + CAIN A,"W ; W - prevent tty messages, and +IFE ERRSW,AOS WSWCNT ; request error output file if possible. +.ELSE [ + AOSA WSWCNT + CAIN A,"E ; E - request error log file. + SETOM ERRFP + ] + +IFN CREFSW,[ + CAIN A,"C ; C - request CREF output. + SETOM CREFP + ] + +IFN LISTSW,[ + CAIE A,"L ; L - request listing + POPJ P, + SETOM LISTP ; Say want listing. + AOS LISTP1 ; (starts as -1, will be positive after 2nd (L)) + ] + + POPJ P, + +SUBTTL TENEX Filename Reader/printer (RFD, TYPFB) + +IFN TNXSW,[ ; Moby conditional for Tenex reader. + +; TNXRFD - TENEX-style Filename Reader. +; Takes input from RCH, +; Deposits name strings into filblk F points to. +; Clobbers A,B,C,D, (and AA,T,TT due to FNCHK) +; Uses FRFEXT flag to see if already read extension (type) or not. +; Refuses to accept existing defaults for version, ;T, account, +; protection, or JFN. It will also zap an existing directory +; default if a device is specified, and vice versa. This is so that +; logical names will win a little better. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) + +IFNDEF FRFDEV,FRFDEV==2 ; Set if read device. +IFNDEF FRFDIR,FRFDIR==1 ; Set if read directory. +IFNDEF FRFEXT,FRFEXT==FRFN1 ; Borrow this bit. Set if read extension. + +RFD: TRZ FF,FRNNUL + SETZM $FJFN(F) ; Zap JFN since the filename we'll read won't match it. + SETZM $FACCT(F) ; Also zap other things that we don't want defaulted. + SETZM $FPROT(F) + SETZM $FTEMP(F) + SETZM $FVERS(F) +TRFD01: TRZ FF,FRFEXT+FRFDEV+FRFDIR ; Jump here if ^R seen. +TRFD10: PUSHJ P,GPASST ; remove tabs, spaces and get first non-tab/space + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semicolon, + JRST TRFD21 ; just handle normally. +TRFD15: PUSHJ P,RCH ; Semi-colon and not command line, it's a comment! + CAIE A,^M ; So flush rest, up to EOL. + JRST TRFD15 + POPJ P, + +TRFD1: TLO FF,FLUNRD ; come here to re-read last char +TRFD2: PUSHJ P,RCH ; Get char +TRFD21: CAIE A,40 ; Space? (come here to scan already-read char) + CAIN A,^I ; or tab? + JRST [TRNE FF,FRCMND ; Space/tab, if reading command line + JRST TRFD2 ; then ignore and continue scanning (for switches), but + JRST TRFD15] ; if not in cmd line, go flush entire rest of line! + CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST TRFD01 ; Sigh, pretend starting over. + TRNN FF,FRCMND ; Must we check for cmd line frobs? + JRST TRFD22 ; Nope, skip them. + + ; Must check for chars special only in command line. + CAIN A,"= + MOVEI A,"_ + CAIE A,"_ ; backarrow is filename terminator... + CAIN A,", ; as is comma. + POPJ P, + CAIN A,"! ; For CCL hacking... + POPJ P, .SEE RFDRUN + PUSHJ P,CMDSW ; Check for switches... + JRST TRFD21 ; got some, process next char (returned by CMDSW) + ; Skips if none, drop thru. + + ; Now see if char signifies start of anything in particular. +TRFD22: CAIE A,"< ; Start of directory name? + JRST TRFD24 ; No + PUSHJ P,RCH + PUSHJ P,TRFDW ; Read word, starting with next char +TRFD23: CAIN A,". ; Allow . as part of directory name + JRST [ PUSHJ P,TRFDW5 ; Read a continuation to this word + JRST TRFD23] ; And try again + MOVEI D,$FDIR ; Set up index. + CAIN A,"> ; Terminator should be end of dir name... + PUSHJ P,RCH ; If so, get next to avoid scan of ">". + ; else bleah, but aren't supposed to fail... + TRNN FF,FRFDEV ; Unless a device has been explicitly given, + SETZM $FDEV(F) ; zap any furnished default. 0 means DSK. + TRO FF,FRFDIR ; Now say dir was explicitly given. + JRST TRFD6 ; Go store it. +TRFD24: CAIN A,". ; Start of $FTYPE or $FVERS (20x)? + JRST [ MOVEI D,$FTYPE ; Assume reading $FTYPE field, + TLNE FF,FL20X ; always if 10X, but if really on 20X, then + TRON FF,FRFEXT ; use $FTYPE only if not already seen. + JRST TRFD4 ; $FTYPE - jump to get word & store. + PUSHJ P,TRFDNM ; $FVERS - 20X and $FTYPE already seen. Get #. + MOVEM B,$FVERS(F) ; Store it away if successful. + JRST TRFD1] ; and go re-read delimiting char. + + CAIN A,"; ; Start of $FVERS (10x) or attribute? + JRST [ PUSHJ P,RCH ; Find what next char is. + CAIL A,"a ; Must uppercasify. + CAILE A,"z + CAIA + SUBI A,40 + CAIN A,"T ; Temporary file? + JRST [ SETOM $FTEMP(C) + JRST TRFD2] + CAIN A,"A ; Account? + JRST [ MOVEI D,$FACCT ; Set index, and + JRST TRFD4] ; go gobble following word. + CAIN A,"P ; Protection? + JRST [ MOVEI D,$FPROT ; Set index, and + JRST TRFD4] ; go gobble following word. + TLO FF,FLUNRD ; Not alpha, try numeric. Re-read char, + PUSHJ P,TRFDNM ; trying to parse as number. + MOVEM B,$FVERS(F) ; Win, parsed as number! Store it. + JRST TRFD1] ; If none of above, ignore ";" entirely. + + PUSHJ P,TRFDW ; Let's try reading it as word, + JUMPLE C,APOPJ ; If nothing read, assume it's some terminating delimiter. + CAIN A,": ; Else have something, check trailing delim for special cases + JRST [ MOVEI D,$FDEV ; Aha, a device. + PUSHJ P,RCH ; Flush the terminator & get next char. + TRNN FF,FRFDIR ; Unless dir was explicitly given, + SETZM $FDIR(F) ; zap furnished default. 0 uses connected dir. + TRO FF,FRFDEV ; Say device was explicitly given, and + JRST TRFD6] ; store name away. + MOVEI D,$FNAME ; Else assume it's the filename. + JRST TRFD6 + + +TRFD4: PUSHJ P,RCH ; Here when must gobble next char, +TRFD5: PUSHJ P,TRFDW ; here when first char of wd already read. +TRFD6: PUSHJ P,FNCHKZ ; Note this can return and store a null string! + ADDI D,(F) ; Get address (filblk+index), and + MOVEM A,(D) ; store string pointer in the appropriate place. + TRO FF,FRNNUL ; Say non-null spec seen, + JRST TRFD1 ; and go re-read the delimiter, to process it. + +; TRFDW - Read a word (string), for use by TNXRFD. Copies sequence of +; acceptable filename chars into FNBUF, until non-valid char seen. +; A/ First char of word, +; Returns A/ delimiting char, C/ count of chars in string, +; clobbers nothing else. + +TRFDW4: SUBI A,40 ; Make lowercase +TRFDW5: IDPB A,FNBWP ; Deposit into FNBUF, + PUSHJ P,RCH ; get next char, + AOSA C ; and bump count, skipping over zap instruction. +TRFDW: SETZ C, ; When called, zero cnt of chars in string. + CAIL A,"A ; See if char is uppercase alpha, + CAILE A,"Z + CAIA + JRST TRFDW5 + CAIL A,"a ; or lowercase alpha, + CAILE A,"z + CAIA + JRST TRFDW4 + CAIL A,"0 ; or numeric, + CAILE A,"9 + CAIA + JRST TRFDW5 + CAIE A,"$ ; or dollarsign + CAIN A,"- ; or hyphen + JRST TRFDW5 + CAIN A,"_ ; Backarrow is special case, because + JRST [ TRNN FF,FRCMND ; if reading command, + TLNN FF,FL20X ; or running on 10X, + POPJ P, ; must treat as delimiter. + JRST TRFDW5] + CAIN A,^V ; ^V is quote char... + JRST [ PUSHJ P,RCH ; Quote, get next. + CAIE A,^M ; Quote anything but this. + CAIN A,0 ; or this. + POPJ P, ; time to exit. + PUSH P,A ; Quote it! Save char, + MOVEI A,^V ; so that a quoter can precede it. + IDPB A,FNBWP ; Fortunately this hair only needs care + POP P,A ; for quoted chars, which are + JRST TRFDW5] ; rare. + TLNE FF,FL20X ; Are we on a 10X? + POPJ P, ; If not, anything at this point is delimiter. + CAIL A,41 ; Check general bounds + CAIL A,137 ; Range from space to _ exclusive. + POPJ P, ; If outside that, delimiter. + CAIL A,72 ; This range includes :, ;, <, =, > + CAILE A,76 + CAIA + POPJ P, ; delimiter. + CAIE A,". + CAIN A,", + POPJ P, + CAIE A,"* + CAIN A,"@ + POPJ P, + ; Finally, check out chars which are acceptable to 10X but which + ; might be delimiter in cmd line... + TRNN FF,FRCMND + JRST TRFDW5 ; Not hacking cmd line, it's an OK char. + CAIE A,"/ + CAIN A,"( + POPJ P, + CAIN A,"! + POPJ P, + JRST TRFDW5 ; at long last done. + + +; TRFDNM - Read numerical string, halt when non-digit +; seen, leaves result (decimal) in B, with delimiting char in A. +; One peculiarity is skip return if no numerical char is seen at all; +; else doesn't skip and B has a valid number. + +TRFDNM: PUSHJ P,RCH ; First char needs special check. + CAIL A,"0 + CAILE A,"9 + JRST POPJ1 ; Not a number at all? + TDZA B,B +TRFDN2: IMULI B,10. + ADDI B,-"0(A) ; Convert to number + PUSHJ P,RCH ; Get following chars. + CAIL A,"0 + CAILE A,"9 + POPJ P, ; Nope, not digit so treat as delimiter. + JRST TRFDN2 ; Yep, a number + +] ;IFN TNXSW + +IFN TNXSW,[ + +; TYPFB - Type out FB pointed to by F + +TYPFB: SKIPE B,$FDEV(F) ; First, device name? + JRST [ PUSHJ P,TYPZ + MOVEI A,": + PUSHJ P,TYOERR + JRST .+1] + SKIPE B,$FDIR(F) ; Directory? + JRST [ MOVEI A,"< + PUSHJ P,TYOERR + PUSHJ P,TYPZ + MOVEI A,"> + PUSHJ P,TYOERR + JRST .+1] + SKIPE B,$FNAME(F) + PUSHJ P,TYPZ + MOVEI A,". + PUSHJ P,TYOERR + SKIPE B,$FEXT(F) + PUSHJ P,TYPZ + MOVEI A,". ; 20X uses "." to set off version, + TLNN FF,FL20X ; but 10X uses ";". + MOVEI A,"; + PUSHJ P,TYOERR + HRRE A,$FVERS(F) + JUMPL A,[MOVM B,A ; Is possible to have -1, -2, etc. + MOVEI A,"- + PUSHJ P,TYOERR + MOVE A,B + JRST .+1] + PUSHJ P,DPNT ; Version # output in decimal. + SKIPE $FTEMP(F) + TYPE ";T" ; May be temporary. + SKIPE B,$FPROT(F) + JRST [ TYPE ";P" + PUSHJ P,TYPZ + JRST .+1] + SKIPE B,$FACCT(F) + JRST [ TYPE ";A" + PUSHJ P,TYPZ + JRST .+1] + POPJ P, + + ; Takes BP in B, outputs to TYOERR until zero byte seen. +TYPZ: CAIA + PUSHJ P,TYOERR + ILDB A,B + JUMPN A,TYPZ+1 + POPJ P, +] ; IFN TNXSW + +SUBTTL TENEX misc. Filename Routines, FS string storage + +IFN TNXSW,[ .SEE FSDSK ; Part of this page is NOT conditionalized!! + +; To handle filenames of ASCIZ strings instead of SIXBIT words, each +; word has instead a byte pointer to an ASCIZ string. For purposes of +; easy comparison, all of these bp's point into FNBUF, and a routine +; (FNCHK) is provided which checks a just-stored string and returns a bp +; to either this string, if unique, or to a previously stored string if +; it is the same as the one just stored (which is then flushed). Thus +; strings can be compared for equality simply by a comparison of their +; byte pointers. While not necessary, strings are stored beginning on +; word boundaries for easier hacking. + + ; <# files>**+<# wds for constants> +LFNBUF==*5*3+20 ; Enough to hold strings for all output files, + ; all translated files, and all .insrt files encountered. + ; Later a GC'er can be hacked up so that of the latter only + ; enough for the max .insrt level need be allocated. + +LVAR FNBUF: BLOCK LFNBUF + + ; Macro to easily define constant strings for comparison purposes +DEFINE DEFSTR *STR* +440700,,%%FNLC +%%LSAV==. +LOC %%FNLC +ASCIZ STR +%%FNLC==. +LOC %%LSAV +TERMIN + %%FNLC==FNBUF +] ; IFN TNXSW!!! + + ; If not assembling for TENEX, the following strings become + ; simple SIXBIT values. This makes it possible to write simple + ; code to work for both TENEX and non-TENEX without messy conditionals. + +IFE TNXSW,[EQUALS DEFSTR,SIXBIT] + +FSDSK: DEFSTR /DSK/ ; This stuff defines various BP's into FNBUF to +FSSYS: DEFSTR /SYS/ ; use for comparison purposes later. +FSTTY: DEFSTR /TTY/ +FSNUL: DEFSTR /NUL/ +FSPTP: DEFSTR /PTP/ +FSATSN: DEFSTR /@/ +FSSBSY: DEFSTR /SUBSYS/ +FSPROG: DEFSTR /PROG/ +FSMID: DEFSTR /MID/ +FSMDAS: DEFSTR /MIDAS/ +FSGRTN: DEFSTR />/ +FSCRF: DEFSTR /CRF/ +FSCREF: DEFSTR /CREF/ +FSERR: DEFSTR /ERR/ +FSLST: DEFSTR /LST/ +FSLIST: DEFSTR /LIST/ +FSSAV: DEFSTR /SAV/ +FSEXE: DEFSTR /EXE/ + +IFN TNXSW,[ +VBLK +FNBBP: 440700,,FNBUF ; Points to beg of FNBUF (hook for dynamic alloc) +FNBEP: FNBUF+LFNBUF-1 ; Points to last wd in FNBUF (address, not BP) +FNBWP: 440700,,%%FNLC ; Write Pointer into FNBUF. +FNBLWP: 440700,,%%FNLC ; Last Write Pointer, points to beg of string being stored +PBLK +EXPUNG %%FNLC + +; NOTE - provided MIDAS never restarts, no initialization is necessary to +; start using FNCHK. (Unless of course FNBUF is dynamically allocated someday) + +; FNCHK - Check out just-stored filename. Returns BP in A to ASCIZ string, +; which will be "canonical" for comparison purposes. +; Clobbers A,B,T,TT,AA +; FNCHKZ - Makes sure just-writ string is ASCIZ'd out before FNCHK'ing. + +FNCHKZ: MOVE B,FNBWP ; Get write ptr, + LDB A,B ; see if last char was 0, + JUMPE A,FNCHK0 ; if so can skip one clobberage. + SETZ A, + IDPB A,B ; zero out bytes, +FNCHK0: TLNE B,760000 ; until at end of word. + JRST .-2 + ADD B,[<440700,,1>-<010700,,>] ; bump BP to point canonically at next. + MOVEM B,FNBWP + +FNCHK: HRRZ B,FNBWP ; See if write ptr + CAML B,FNBEP ; has hit end of FNBUF, and + ETF [ASCIZ /Filename buffer overflow/] ; barf horribly if so. + MOVE A,FNBBP ; A - bp to start of existing string + MOVE AA,FNBLWP ; AA - bp to start of new string to store +FNCHK2: MOVEI T,(A) ; T - current addr being checked, existing str + MOVEI TT,(AA) ; TT - current addr, new str + CAIL T,(TT) ; If addrs are same, or overran somehow, + JRST [ MOVE A,AA ; didn't find any match, accept new string. + MOVE B,FNBWP + MOVEM B,FNBLWP ; Set up new last-write-ptr + POPJ P,] +FNCHK3: MOVE B,(T) + CAMN B,(TT) ; Compare strings, full word swoops. + JRST [ TRNE B,377 ; equal, last char zero? + AOJA T,[AOJA TT,FNCHK3] ; no, continue for whole string + ; Found it! Flush just-stored string, don't want duplicate. + MOVEM AA,FNBWP ; Clobber write ptr to previous value. + POPJ P,] + ; Not equal, move to next string to compare + MOVEI B,377 ; Check for ASCIZ, + TDNE B,(T) ; moving to end of current string + AOJA T,.-1 + HRRI A,1(T) ; and updating BP to point at new string. + JRST FNCHK2 ; (T gets pointed there too at FNCHK2). + +; JFNSTR - Get filename strings for active JFN. +; A/ active JFN +; F/ addr of filename block to clobber. +; JFNSTB - Same, but ignores A and assumes JFN is already stored in block. +; Clobbers A,C + +JFNSTB: SKIPA A,$FJFN(F) ; JFNSTB gets the JFN from block itself. +JFNSTR: MOVEM A,$FJFN(F) ; whereas JFNSTR stores it there... + MOVSI D,-NJSTRF ; Set up aobjn thru table. +JFNST2: PUSH P,T + SYSCAL JFNS,[FNBWP ? $FJFN(F) ? JSTRFX+1(D)][FNBWP] + POP P,T + MOVE C,JSTRFX(D) ; Now get index to place it belongs in file block, + CAIN C,$FVERS ; and check for this, because + JRST [ MOVE A,FNBLWP ; it wants to be a number, not a string. + MOVEM A,FNBWP ; Zap write pointer back to forget string, + PUSHJ P,CVSDEC ; and quickly convert before anything clobbers it. + JRST .+2] ; Skip over the FNCHKZ call. + PUSHJ P,FNCHKZ ; Fix it up, and get BP to it. + ADDI C,(F) ; make it an addr, and + MOVEM A,(C) ; store BP. (or value, for $FVERS) + ADDI D,1 + AOBJN D,JFNST2 + POPJ P, + + ; Filblk idx, output format wd for JFNS call +JSTRFX: $FDEV ? 100000,, + $FDIR ? 010000,, + $FNAME ? 001000,, + $FTYPE ? 000100,, + $FVERS ? 000010,, +NJSTRF==<.-JSTRFX>/2 + +; CVSDEC - Converts ASCIZ string to decimal, assumes only digits seen. +; A/ BP to ASCIZ +; Returns value in A, clobbers nothing else. + +CVSDEC: PUSH P,B + PUSH P,C + MOVE C,A + SETZ A, + JRST CVSDC3 +CVSDC2: IMULI A,10. + ADDI A,-"0(B) +CVSDC3: ILDB B,C + JUMPN B,CVSDC2 + POP P,C + POP P,B + POPJ P, + +; CVSSIX - Converts ASCIZ string to SIXBIT word. +; A/ BP to ASCIZ string, +; Returns SIXBIT word in A. Clobbers nothing else. + +CVSSIX: PUSH P,B + PUSH P,C + PUSH P,D + MOVE D,A + SETZ A, + MOVE B,[440600,,A] + JRST CVSSX3 +CVSSX2: CAIL C,140 + SUBI C,40 ; Uppercase force + SUBI C,40 ; cvt to 6bit + IDPB C,B ; deposit + TLNN B,770000 ; If BP at end of word, + JRST CVSSX5 ; leave loop. +CVSSX3: ILDB C,D + JUMPN C,CVSSX2 +CVSSX5: POP P,D + POP P,C + POP P,B + POPJ P, + +; CV6STR - Takes 6bit word in A, writes into FNBUF and makes a string of +; it, returning BP in A. +; Clobbers A,B,T,TT,AA (due to FHCHKZ) + +CV6STR: MOVE B,A +CV6ST2: SETZ A, + LSHC A,6 ; Get a 6bit char + ADDI A,40 ; Make ASCII + IDPB A,FNBWP ; deposit + JUMPN B,CV6ST2 ; Continue until nothing left + PJRST FNCHKZ ; Make output thus far a string. + + +; CVFSIX - Takes current filblk (pointed to by F) and puts the +; right stuff in $F6 entries. + +CVFSIX: PUSH P,A + PUSH P,B + MOVSI B,-L$F6BL +CVFSX2: MOVE A,@CVFTAB(B) ; Get BP to string + PUSHJ P,CVSSIX ; Convert to 6bit + ADDI B,$F6DEV(F) ; Get index to right place to store. + MOVEM A,(B) + SUBI B,$F6DEV(F) ; restore aobjn pointer... + AOBJN B,CVFSX2 + POP P,B + POP P,A + POPJ P, + +CVFTAB: $FDEV(F) + $FNAME(F) + $FEXT(F) + $FDIR(F) +IFN <.-CVFTAB>-L$F6BL, .ERR CVFTAB loses. + +] ; IFN TNXSW + +SUBTTL DEC/TENEX - RUN hacking. (Process FOO! in CCL) +IFN DECSW,[ + +; Process "FOO!", which means "run SYS:FOO with an offset of 1". +; Note that the RUN call needs a block of 6 ACs, but at this point +; it doesn't matter what gets clobbered. + + + ; Entry point for restart, from TSRETN. +RERUN: MOVE B,FSMDAS ; Get name - using SYS:MIDAS + SETZB C,D+1 ; (no ext or ppn) + JRST RFDRU1 + +VBLK + +RFDRUN: MOVE A,$F6DEV(F) ; Load up the 4 filenames to use. + MOVE B,$F6FNM(F) + MOVE C,$F6EXT(F) + MOVE D+1,$F6DIR(F) + JUMPN A,RFDRU3 ; If device specified, use that, + MOVSI A,'DSK ; else default to DSK + CAIN D+1, ; if a PPN was given, and +RFDRU1: MOVSI A,'SYS ; to SYS: otherwise. +RFDRU3: SETZB D,D+2 ; These acs must always be zero... + MOVEI D+3,177 ; Flush all core above this address. +IFN SAILSW,[ + SETZ D+4, + CORE2 D+4, ; Flush hiseg by hand on SAIL. + GOHALT + ] +.ELSE HRLI D+3,1 ; Elsewhere, just set LH to this to flush hiseg. + + MOVE D+4,[RUNCOD,,D+5] ; Move core-less code into position in ACs. + BLT D+4,+LRUNCD-1 + MOVE D+4,[1,,A] ; ,,
+ JRST D+5 ; Go flush core and run program. + +RUNCOD: CORE D+3, ; Flush as much core as possible; RUN uuo can lose + GOHALT ; Because of how much we have. + RUN D+4, + GOHALT +LRUNCD==.-RUNCOD + ; Make sure symbols A-D leave enuf room. +IFL 17-, .ERR RFDRUN ACs lose. +PBLK +] ;END IFN DECSW + +IFN TNXSW,[ + ; On TENEX, we'll do things without compat package (boo hiss) + + ; Entry point for starting new MIDAS, come here from TSRETN. +RERUN: MOVEI F,FB + BLTZ L$FBLK,FB ; Clear out scratch filblk, point at it. + MOVE A,FSMDAS ; Get BP to "MIDAS", store in + MOVEM A,$FNAME(F) ; filblk, and drop thru for defaults. + + ; Here to start up specified program, for CCL hacking. +RFDRUN: TLNN FF,FL20X ; 20X or Tenex? + JRST [ MOVE A,FSSBSY ; Tenex, get BP to SUBSYS string + SKIPN $FDIR(F) ; Unless directory specified, + MOVEM A,$FDIR(F) ; default dir to . + MOVE A,FSSAV ; And do similar thing for ext (.SAV) + JRST RFDRN2] + MOVE A,FSSYS ; 20X, get BP to SYS string + SKIPN $FDEV(F) ; Unless device specified, + MOVEM A,$FDEV(F) ; default dev to SYS:. + MOVE A,FSEXE ; And ditto for ext (.EXE) + +RFDRN2: SKIPN $FEXT(F) ; If extension not specified, + MOVEM A,$FEXT(F) ; Store appropriate one. + PUSHJ P,GETJFI ; Get JFN for input... + GOHALT ; Ugh, bletch, etc. + + ; OK, all ready to smash ACs with loader, etc. + MOVE R1,$FJFN(F) ; Put JFN into RH + HRLI R1,.FHSLF ; and fork handle (self) in LH. + MOVE R2,[RUNCOD,,R3] ; Load into ACs beginning at AC 3 + BLT R2,R3+LRUNCD-1 + JRST R3 ; Off we go, never to return... + + ; Following code is executed in AC's, position independent. +RUNCOD: GET ; Load up the file. + MOVEI R1,.FHSLF + GEVEC ; Find entry vector word for it, returned in AC 2. + JRST R1(R2) ; and go execute instruction in reenter slot. +LRUNCD==.-RUNCOD ; Pretty small loader, huh? +] ; IFN TNXSW + +SUBTTL Core Allocation routine - GCCORQ gets another K for MACTAB + +; Get another K of MACTAB space. + +GCCORQ: MOVE A,MACHI + LSH A,-2 ; Convert to word # + CAIL A,MXMACL ; Want more than allowed? + POPJ P, + MOVE A,MACTND ; No, get addr of block we want to get. + PUSH P,A ; Entry, save A in case have to try again +CORRQ1: +IFN ITSSW,[ + LSH A,-10. + SYSCAL CORBLK,[MOVEI %CBNDR+%CBNDW + MOVEI %JSELF ? A ? MOVEI %JSNEW] + JRST CORRQL ; Lose +] +IFN DECSW,[ + IORI A,1777 + CORE A, + JRST CORRQL ; Lose +] +IFN TNXSW,[ + SKIPN MEMDBG ; Only need to hack if want. + JRST CORRQ3 + ; Super kludge. No way to ask 10X for a "new page"; must + ; get it via default create-on-reference. Hence to get page + ; without bombing, must be sure .ICNXP interrupt deactivated! + PUSH P,T + SYSCAL DIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Deactivate. + SETZM (A) ; Reference 1st page + SETZM 1000(A) ; Reference 2nd page. + SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Re-activate. + POP P,T +CORRQ3: +] + + REST A + ADDI A,2000 + JRST MACIN2 ; Update pointers to end of MACTAB. + +IFN ITSSW\DECSW,[ + ; Lossage handler for GCCORQ. Only ITS or DEC can fail. +CORRQL: PUSH P,C + PUSH P,D + TLOE AA,400000 + JRST CORQL1 + TYPE " +No core for macro table." +CORQL1: TYPE " +Try again? " +CORQL2: PUSHJ P,TYI ; Get char + CAIL A,140 ; Cheap uppercase force + SUBI A,40 + CAIN A,"Y ; Y, + JRST CORRQA ; => try again + CAIN A,"N ; N, + JRST CORRQB ; => back to DDT then try again + CAIN A,"? ; ?, + ERJ CORQL1 ; => type out error-type blurb + TYPE "? " ; something else + JRST CORQL2 + +CORRQB: +IFN ITSSW,.VALUE ; Loop point for don't-proceed +IFN DECSW,EXIT 1, + TLZ AA,400000 +CORRQA: POP P,D + POP P,C + MOVE A,(P) ; Restore A from PDL + JRST CORRQ1 +] ; IFN ITSSW\DECSW + +SUBTTL CORGET - allocate fresh pages + +; CORGET - Takes arg in AA, an ITS page AOBJN to pages to grab. +; AA/ -<# pages>,,<1st page #> +; Clobbers only AA. + +CORGET: JUMPGE AA,APOPJ ; Ignore arg if nothing to do about it. +IFN ITSSW,[ + SYSCAL CORBLK,[ MOVEI %CBNDR+%CBNDW ; Get both read and write. + MOVEI %JSELF ; Into self + AA ; AA is AOBJN of pages. + MOVEI %JSNEW] ; Want fresh pages. + .LOSE %LSSYS +] +IFN TNXSW,[ + SKIPN MEMDBG ; Ignore anyway if not hacking mem ref debugging. + POPJ P, + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 + MOVE R3,AA + ASH R3,1 ; Get Tenex page AOBJN + MOVEI R1,(R3) + LSH R1,9. ; Get word address of first page. + HRR R3,R1 ; Stick back in AOBJN. + + ; Super kludge. No way to ask 10X for a "new page"; must + ; get it via default create-on-reference. Hence to get page + ; without bombing, must be sure .ICNXP interrupt deactivated! + MOVEI R1,.FHSLF + MOVE R2,[1_<35.-.ICNXP>] + DIC ; Deactivate. +TCORG3: SETZM (R3) ; Get the page. + ADDI R3,777 ; Bump word address, + AOBJN R3,TCORG3 ; and get next page (note adds 1 more to RH) + AIC ; Now re-activate... + POP P,R3 + POP P,R2 + POP P,R1 +] ;IFN TNXSW + POPJ P,