PDP-10 Machine Language.

This file attempts to teach the machine language of the PDP-10 computer. It describes what instructions are available and what they do. The conventions of the assembler in which PDP-10 machine programs are usually written are another subject; see *Note MIDAS: (MIDAS).

The machine language itself:

Program examples:

I haven't got the time to test these examples. That means they may have bugs. Sorry. But it's a useful exercise to test one and, if it doesn't work, fix it and tell BUG-INFO.

Introduction to PDP-10 Assembly Language Programming

The PDP-10 is a general purpose stored program computer. There are four different processors (computers) in the PDP-10 family (the PDP-6, the KA10, the KI10 and the KL10). This file discusses primarily the KA-10 version, which is what most of the ITS systems are.

There are three principal aspects of assembly language programming: the machine instructions, the assembler, and the operating system.

The machine instructions are the primitive operations with which we write programs. Learning the instruction set means learning what operations are performed by each instruction. Programming is the art or science of combining these operations to accomplish some particular task.

The machine instructions, like everything else in a computer, are in binary. The assembler is a program that translates the mnemonic names by which we refer to instructons into the binary form that the computer recognizes. The assembler also does a variety of other chores that are essentially bookkeeping. There are several assemblers for the PDP-10, which differ in various ways; what they all have in common is the PDP-10 machine instructions, which are described in this file. Everything else about how to use a particular assembler is documented under that assembler. The assembler used most on ITS is called MIDAS; *Note MIDAS: (MIDAS).

The operating system is a special program that handles all input and output and which schedules among user programs. For its own protection and the protection of other users the operating system places various restrictions on user programs. User mode programs are resticted to memory assigned to them by the operating system; they may not perform any machine input-output instructions, nor can they perform several other restricted operations (e.g., HALT instruction). To facilitate user input-output and core allocation the operating system provides various system calls (UUO or JSYS operations) by which a user program can communicate its wishes to the system. Essentially all programs except the operating system itself are run as user mode programs. Editors, assemblers, compilers, utilities, and programs that you write yourself are all user mode programs.

Memory

In programming the PDP-10 it is convenient to imagine that your program occupies contiguous virtual memory locations from 0 to some maximum address. All memory locations are equivalent for most purposes (but some operating systems reserve some of your space for their own purposes).

Accumulators

Sixteen memory locations (addresses 0 to 17 - note that addresses will appear in octal) are distinguished by their use as general purpose registers (also called accumulators or index registers). Most PDP-10 instructions address one memory operand and one accumulator (so-called "one and a half address" architecture). This means that nearly all instruction affect some accumulator. These registers are actually implemented in high speed solid state memory rather than in slower core. For any purpose where it is convenient to do so, a user may reference an accumulator as memory.

Instruction Formats

The PDP-10 is a word oriented machine. Words contain 36 data bits, numbered (left to right) 0 to 35. Every machine instruction is one word. The program counter or PC is a register which contains the address of the next word to be used as an instruction; after a normal instruction, the PC is incremented by one so that successive instructions come from successive words.

There are two formats for machine instructions. Most instructions have the format:

 000000000 0111 1 1111 112222222222333333
 012345678 9012 3 4567 890123456789012345
 ________________________________________
|         |    | |    |                  |
|   OP    | AC |I| X  |        Y         |
|_________|____|_|____|__________________|

Input-output instructions (which are illegal in user mode) have the format: (These instructions are not discussed any farther by this file).

 000 0000000 111 1 1111 112222222222333333
 012 3456789 012 3 4567 890123456789012345
 _________________________________________
|   |       |   | |    |                  |
|111|  DEV  |IOP|I| X  |        Y         |
|___|_______|___|_|____|__________________|

In the diagrams above the field names are

        OP  = operation code
        AC  = accumulator field
        I   = indirect bit
        X   = index field
        Y   = address field
        DEV = device code
        IOP = input-output operation code

Some example intructions are:

        MOVE 1,@100             ;MOVE is the OP.  AC is 1.
                                ;@ sets the I bit.
                                ;X is zero, Y is 100.

        HRRZ 17,1(3)            ;HRRZ is the OP. AC is 17,
                                ;Y = 1, X = 3, I = 0

        SOS FOO                 ;SOS is OP, FOO is symbolic
                                ;for the Y field.  AC, X, I are 0.

The address field, the index field, and the indirect bit are all used in effective address computation. See also Addr-Comp.

Terminology

Symbols particular to this file:

  • # means "not equal".
  • <= means "less than or equal".
  • >= means "greater than or equal".
  • <- means "is assigned the new value".

  • AC means the contents of the AC field of the current instruction; this is a number from 0 to 17.
  • E means the value of the effective address of the current instruction. *Note Addr: Addr-Comp, for how this is computed.
  • PC means the address from which the next instruction will be fetched.
  • C(...) surrounding an expression refers to the contents of the memory location whose address is the value of the expression. Thus, C(AC) is the contents of the accumulator which the instruction refers to, and C(E) is the contents of the memory location which the instruction refers to.
  • CR(...) means the right half, only, of the contents.
  • CS(...) means the contents, wit the two halves swapped.
  • CL(...) means the left half, only, of the contents.

Symbols which are taken from assembler language:

  • x,,y means a word whose left half contains x, and whose right half contains y. This is similar to x*1000000+y, except that x,,y truncates y, using only the low 18 bits of it.
  • <...> surrounding an expression serves the same purpose as parentheses in algebra. Thus, 5*<1,,1> equals 5,,5.
  • [...] surrounding an expression means the address of a word in memory which contains the specified expression. Thus, [2] means the address of a word containing 2. This is called a literal. The address could turn out to be anything at all, but the proper ways to use literals are such that only the contents matter.
  • (...) surrounding an expression exchanges the halves of that expression. Thus, (3,,4) equals 4,,3.

Effective Address Calculation

All instructions without exception calculate an "effective address". The effective address gets its name because it is usually used as the address of an operand in memory. Depending on the instruction, that operand might be read, written or both. For some instructions, called "immediate" instructions, the effective address is not used to address memory; it is used directly, as a number, in the operation. For example, the ADD instruction uses the effective address as the address of a location in memory, and uses the contents of that location in the addition. The ADDI instruction (Add Immediate) uses the effective address itself as the number to add.

The effective address computation uses three fields of the instruction word: the 18-bit address field (Y), the index field (X), and the indirect bit (I). The result is an 18-bit effective address.

If the X field and I bit are zero, the effective address is simply the contents of the address field (Y).

If the index field X is nonzero, then it is the number of an accumulator to use as an index rgister. Any accumulator except accumulator 0 can be so used. The right half of the contents of the index register is added to the address field (Y) from the instruction to get the effective address.

The I bit specifies indirect addressing. If it is 1, then the result of the previous steps (Address field, or address field plus index quantity) is used as the address of an "indirect word". From the contents of this indirect word, a new address field Y, index field X and indirect bit I are obtained. Then the process starts from the beginning. If the I bit in the indirect word is 1, a second indirect word is eventually fetched. Indirection can happen any number of times, and only stops when an indirect word has 0 in its I bit.

The result of the effective address calculation may be thought of as an instruction word where bits 0:12 are copied from the original instruction, bits 13:17 are zero, and 18:35 contain the effective address.

The effective address computation is described by the following program. MA means memory address. PC means program counter. C(MA) means contents of the word addressed by MA.

IFETCH: MA <- PC
        OP <- Bits  0:8  of C(MA);
        AC <- Bits  9:12 of C(MA);
EACOMP: I  <- Bit  13    of C(MA);
        X  <- Bits 14:17 of C(MA);
        Y  <- Bits 18:35 of C(MA);
        E  <- Y;
        IF NOT(X=0) then E <- E+C(X);
        IF I=0 then go to done;
        MA <- E;
        GO TO EACOMP;
DONE:

Full word instructions. MOVE, BLT, EXCH, PUSH, POP

These are the instructions whose basic purpose is to move one or more full words of data from one location to another, usualy from an accumulator to a memory location or vice versa. In some cases, minor arithmetic operations are performed, such as taking the magnitude or negative of a word.

The MOVE class of instructions perform full word data transmission between an accumulator and a memory location. There are sixteen instructions in the MOVE class. All mnemonics begin with MOV. The first modifier specifies a data transformation operation; the second modifier specifies the source of data and the destination of the result.

        |E no modification      |  from memory to AC
MOV     |N negate source        |I Immediate.  Move the address to AC.
        |M magnitude            |M from AC to memory
        |S swap source          |S to self.  If AC#0, move to AC also

"Magnitude" means that the absolute value of the input quantity is what is stored in the output.

"Swap Source" means that the right and left halves of the input quantity are interchanged before storing into the output.

In a "to self" instruction, the input value (negated, swapped, or the magnitude, if appropriate) is stored back into the memory location; if the AC field is nonzero, the value is stored in the AC as well.

MOVE                    C(AC) <- C(E)
MOVEI                   C(AC) <- 0,,E
MOVEM                   C(E)  <- C(AC)
MOVES                   C(E)  <- C(E); if AC#0 then C(AC) <- C(E)

MOVN                    C(AC) <- -C(E)
MOVNI                   C(AC) <- -E
MOVNM                   C(E)  <- -C(AC)
MOVNS                   C(E)  <- -C(E); if AC#0 then C(AC) <- -C(E)

MOVM                    C(AC) <- |C(E)|
MOVMI                   C(AC) <- 0,,E
MOVMM                   C(E)  <- |C(AC)|
MOVMS                   C(E)  <- |C(E)|; if AC#0 then C(AC) <- |C(E)|

MOVS                    C(AC) <- CS(E)
MOVSI                   C(AC) <- E,,0
MOVSM                   C(E)  <- CS(AC)
MOVSS                   C(E)  <- CS(E); if AC#0 then C(AC) <- CS(E)

EXCH exchanges the contents of the selected ac with the contents of the effective address.

EXCH    C(AC)><C(E)

The BLT (Block Transfer) instruction copies words from memory to memory. The left half of the selected AC specifies the first source address. The right half of the AC specifies the first destination address. The effective address specifies the last destination address. Words are copied, one by one, from the source to the destination, until a word is stored in an address greater than or equal to the effective address of the BLT.

Caution: BLT clobbers the specified AC. Don't use the BLT AC in address calculation for the BLT; results will be random. If source and destination overlap, remember that BLT moves the lowest source word first. If the destination of the BLT includes the BLT AC, then the BLT AC better be the last destination address.

Programming examples:

;Save all the accumulators:
        MOVEM   17,SAVAC+17
        MOVEI   17,SAVAC        ;Source is 0, destination is SAVAC
        BLT     17,SAVAC+16


;Restore all the accumulators:
        MOVSI   17,SAVAC        ;Source is SAVAC, destination is 0
        BLT     17,17

;Zero 100 words starting at TABLE.
        SETZM   TABLE
        MOVE    AC,[TABLE,,TABLE+1]     ;Source and destination overlap
        BLT     AC,TABLE+77

;Move 77 words from TABLE thru TABLE+76 to TABLE+1 thru TABLE+77: BLT
;can't be done here because the source and destination overlap.  (See
;the description of POP, *Note POP: Stack.)
        MOVE    AC,[400076,,TABLE+76]
        POP     AC,1(AC)        ;Store TABLE+76 into TABLE+77, etc.
        JUMPL   AC,.-1

Stack instructions {#Stack}

The instructions PUSH and POP insert and remove full words in a pushdown list. The address of the top of the list is kept in the right half of the AC referenced by these instructions. The program may keep a control count in the left half of the AC. There are also two subroutine calling instructions (PUSHJ and POPJ) that use this same format pushdown list.

PUSH    C(AC)<-C(AC)+<1,,1>;  C(CR(AC))<-C(E)

The specified accumulator is incremented by adding 1 to each half (in the KI10 and KL10 carry out of the right half is suppressed). If, as result of the addition, the left half of the AC becomes positive, a pushdown overflow condition results (but the instruction procedes to completion). The word addressed by the effective address is fetched and stored on the top of the stack which is addressed by the right half of the (incremented) accumulator.

POP     C(E)<-C(CR(AC)); C(AC)<-C(AC)-<1,,1>

POP undoes PUSH as follows: the word at the top of the stack (addressed by the right half of the selected AC) is fetched and stored at the effective address. Then the AC is decremented by subtracting 1 from both halves (in the KI10 and KL10 carry out of bit 18 is suppressed). If the AC becomes negative as a result of the subtraction a pushdown overflow results.

Often the accumulator used as the pushdown pointer is given the symbolic name P. To initialize a pushdown pointer (e.g., for N words starting at PDLIST), one might do the following:

        MOVE P,[-N,,PDL-1]

Elsewhere in the program should appear:

PDL:    BLOCK   N

which defines the symbolic label PDL and reserves N words following it.

Halfword instructions

The halfword class of instructions perform data transmission between one half of an accumulator and one half of a memory location. There are sixty-four halfword instructions. Each mnemonic begins with H and has four modifiers. The first modifier specifies which half of the source word; the second specifies which half of the destination. The third modifier specifies what to do to the other half of the destination. The fourth modifier specifies the source of data and the destination of the result.

H halfword from |R right  of source to
                |L left

                |R right  of destination
                |L left

                |  no modification of other half
                |Z zero other half
                |O set other half to ones
                |E sign extend source to other half

                |  from memory to AC
                |I Immediate
                |M from AC to memory
                |S to self. If AC#0, then move to AC also.

C18 means bit 18 of the contents (the high bit of the low half); C0 means bit 0 of the contents (the high bit of the high half); E18 means the high bit of the effective address. 777777*X evaluates to 0 if X is 0, or 777777 (all ones) if X is one. Such expressions represent sign extension.

HRR             CR(AC) <- CR(E)
HRRI            CR(AC) <- E
HRRM            CR(E)  <- CR(AC)
HRRS            CR(E)  <- CR(E); if AC#0 then CR(AC) <- CR(E)

HRRZ            C(AC) <- 0,,CR(E)
HRRZI           C(AC) <- 0,,E
HRRZM           C(E)  <- 0,,CR(AC)
HRRZS           C(E)  <- 0,,CR(E); if AC#0 then C(AC) <- 0,,CR(E)

HRRO            C(AC) <- 777777,,CR(E)
HRROI           C(AC) <- 777777,,E
HRROM           C(E)  <- 777777,,CR(AC)
HRROS           C(E)  <- 777777,,CR(E); if AC#0 then C(AC) <- 777777,,CR(E)

HRRE            C(AC) <- 777777*C18(E),,CR(E);
HRREI           C(AC) <- 777777*E18,,E
HRREM           C(E)  <- 777777*C18(AC),,CR(AC)
HRRES           C(E)  <- 777777*C18(E),,CR(E);
                        if AC#0 then C(AC) <- 777777*C18(E),,CR(E)

HRL             CL(AC) <- CR(E)
HRLI            CL(AC) <- E
HRLM            CL(E)  <- CR(AC)
HRLS            CL(E)  <- CR(E); if AC#0 then CL(AC) <- CR(E)

HRLZ            C(AC) <- CR(E),,0
HRLZI           C(AC) <- E,,0
HRLZM           C(E)  <- CR(AC),,0
HRLZS           C(E)  <- CR(E),,0; if AC#0 then C(AC) <- CR(E),,0

HRLO            C(AC) <- CR(E),,777777
HRLOI           C(AC) <- E,,777777
HRLOM           C(E)  <- CR(E),,777777
HRLOS           C(E)  <- CR(E),,777777; if AC#0 then C(AC) <- CR(E),,777777

HRLE            C(AC) <- CR(E),,777777*C18(E)
HRLEI           C(AC) <- E,,777777*E18
HRLEM           C(E)  <- CR(AC),,777777*C18(AC)
HRLES           C(E)  <- CR(E),,777777*C18(E);
                        if AC#0 then C(AC) <- CR(E),,777777*C18(E)

HLR             CR(AC) <- CL(E)
HLRI            CR(AC) <- 0
HLRM            CR(E)  <- CL(AC)
HLRS            CR(E)  <- CL(E); if AC#0 then CR(AC) <- CL(E)

HLRZ            C(AC) <- 0,,CL(E)
HLRZI           C(AC) <- 0
HLRZM           C(E)  <- 0,,CL(AC)
HLRZS           C(E)  <- 0,,CL(E); if AC#0 then C(AC) <- 0,,CL(E)

HLRO            C(AC) <- 777777,,CL(E)
HLROI           C(AC) <- 777777,,0
HLROM           C(E)  <- 777777,,CL(AC)
HLROS           C(E)  <- 777777,,CL(E); if AC#0 then C(AC) <- 777777,,CL(E)

HLRE            C(AC) <- 777777*C0(E),,CL(E);
HLREI           C(AC) <- 0
HRREM           C(E)  <- 777777*C0(AC),,CL(AC)
HRRES           C(E)  <- 777777*C0(E),,CL(E);
                        if AC#0 then C(AC) <- 777777*C0(E),,CR(E)

HLL             CL(AC) <- CL(E)
HLLI            CL(AC) <- 0
HLLM            CL(E)  <- CL(AC)
HLLS            CL(E)  <- CL(E); if AC#0 then CL(AC) <- CL(E)

HLLZ            C(AC) <- CL(E),,0
HLLZI           C(AC) <- 0
HLLZM           C(E)  <- CL(AC),,0
HLLZS           C(E)  <- CL(E),,0; if AC#0 then C(AC) <- CL(E),,0

HLLO            C(AC) <- CL(E),,777777
HLLOI           C(AC) <- 0,,777777
HLLOM           C(E)  <- CL(E),,777777
HLLOS           C(E)  <- CL(E),,777777; if AC#0 then C(AC) <- CL(E),,777777

HLLE            C(AC) <- CL(E),,777777*C0(E)
HLLEI           C(AC) <- 0
HLLEM           C(E)  <- CL(AC),,777777*C0(AC)
HLLES           C(E)  <- CL(E),,777777*C0(E);
                        if AC#0 then C(AC) <- CL(E),,777777*C0(E)

Arithmetic testing. AOBJP, AOBJN, JUMP, SKIP, CAM, CAI, AOS, SOS, SOJ, AOJ

The AOBJ (Add One to Both halves of AC and Jump) instructions allow forward indexing through an array while maintaining a control count in the left half of an accumulator. Use of AOBJN and AOBJP can reduce loop control to one instruction.

AOBJN   C(AC)<-C(AC)+<1,,1>; If C(AC)<0 then PC<-E;
AOBJP   C(AC)<-C(AC)+<1,,1>; If C(AC)>=0 then PC<-E;

Example. Add 3 to N words starting at location TAB:

        MOVSI 1,-N              ;Initialize register 1 to -N,,0
        MOVEI 2,3               ;register 2 gets the constant 3.
        ADDM 2,TAB(1)           ;add 3 to one array element.
        AOBJN 1,.-1             ;increment both the index and the control.
                                ;Loop until the ADDM has been done N times.

By the way, for the sake of consistency, AOBJN should have been called AOBJL and AOBJP should have been called AOBJGE. However, they weren't.

The JUMP instructions compare the selected accumulator to zero and jump (to the effective address of the instruction) if the specified relation is true.

JUMP            Jump never.  This instruction is a no-op.
JUMPL           If C(AC) < 0 then PC<-E;
JUMPLE          If C(AC) <= 0 then PC<-E;
JUMPE           If C(AC) = 0 then PC<-E;
JUMPN           If C(AC) # 0 then PC<-E;
JUMPGE          If C(AC) >= 0 then PC<-E;
JUMPG           If C(AC) > 0 then PC<-E;
JUMPA           PC<-E.  This is an unconditional branch.

Example:

        JUMPLE 5,FOO    ;Jump to FOO if AC 5 is negative or zero.

The SKIP instructions compare the contents of the effective address to zero and skip the next instruction if the specified relation is true. If a non-zero AC field appears, the selected AC is loaded from memory.

SKIP            If AC#0 then C(AC)<-C(E);
SKIPL           If AC#0 then C(AC)<-C(E);  If C(E) < 0 then skip
SKIPLE          If AC#0 then C(AC)<-C(E);  If C(E) <= 0 then skip;
SKIPE           If AC#0 then C(AC)<-C(E);  If C(E) = 0 then skip;
SKIPN           If AC#0 then C(AC)<-C(E);  If C(E) # 0 then skip;
SKIPGE          If AC#0 then C(AC)<-C(E);  If C(E) >= 0 then skip;
SKIPG           If AC#0 then C(AC)<-C(E);  If C(E) > 0 then skip;
SKIPA           If AC#0 then C(AC)<-C(E);  skip;

Example:

        SKIPL FOO       ;Unless FOO's contents are negative,
         MOVE 1,BAR     ;load BAR's contents into accumulator 1.
                        ;By convention, instructions which can be
                        ;are written indented an extra space.

        SKIPN 2,FOO     ;Load FOO's contents into accumulator 2
                        ;and if they are nonzero, skip the next
                        ;instruction.

The AOS (Add One to memory and Skip) instructions increment a memory location, compare the result to zero to determine the skip condition, If a non-zero AC field appears then the AC selected will be loaded (with the incremented data).

AOS             Add One to Storage (don't skip).
                C(E) <- C(E)+1;  If AC#0 then C(AC)<-C(E);

AOSL            Add One and Skip if Less than zero.
                C(E) <- C(E)+1;  If AC#0 then C(AC)<-C(E);
                 If C(E) < 0 then skip;

AOSLE           Add One and Skip if Less than or Equal to zero.
                C(E) <- C(E)+1;  If AC#0 then C(AC)<-C(E);
                 If C(E) <= 0 then skip;

AOSE            Add One and Skip if Equal to zero.
                C(E) <- C(E)+1;  If AC#0 then C(AC)<-C(E);
                 If C(E) = 0 then skip;

AOSN            Add One and Skip if Not zero.
                C(E) <- C(E)+1;  If AC#0 then C(AC)<-C(E);
                 If C(E) # 0 then skip;

AOSGE           Add One and Skip if Greater than or Equal to zero.
                C(E) <- C(E)+1;  If AC#0 then C(AC)<-C(E);
                 If C(E) >= 0 then skip;

AOSG            Add One and Skip if Greater than zero.
                C(E) <- C(E)+1;  If AC#0 then C(AC)<-C(E);
                 If C(E) > 0 then skip;

AOSA            Add One and Skip Always
                C(E) <- C(E)+1;  If AC#0 then C(AC)<-C(E);
                 skip;

Example:

;This is the way, in parallel processing,
;we wait for a lock to be free and then lock it.
;If the lock is unlocked, it contains -1, so incrementing it yields zero.
        AOSE FOO        ;Increment FOO's contents, skip if zero.
         JUMPA .-1      ;If they aren't zero, do it again.

The SOS (Subtract One from memory and Skip) instructions decrement a memory location, then compare the result to zero to decide whether to skip. If a non-zero AC field appears then the AC selected will be loaded (with the decremented data).

The SOS instructions are just like the AOS instrucrtions except that they subtract one instead of adding one.

SOS             Subtract One from Storage (don't skip).
                C(E) <- C(E)-1;  If AC#0 then C(AC)<-C(E);

SOSL            Subtract One and Skip if Less than zero.
                Perform SOS instruction:
                        C(E) <- C(E)-1;  If AC#0 then C(AC)<-C(E);
                Then, if C(E) < 0 then skip;

The other SOS instructions differ from SOSL only in when they skip.

SOSLE           Subtract One and Skip if Less than or Equal to zero.
SOSE            Subtract One and Skip if Equal to zero.
SOSN            Subtract One and Skip if Not zero.
SOSGE           Subtract One and Skip if Greater than or Equal to zero.
SOSG            Subtract One and Skip if Greater than zero.
SOSA            Subtract One and Skip Always

The AOJ (Add One to AC and Jump) instructions increment the contents of the selected accumulator. If the result bears the indicated relation to zero then the instruction will jump to the effective address.

AOJ             Add One (don't jump).
                C(AC) <- C(AC)+1;

AOJL            Add One and Jump if Less than zero.
                C(AC) <- C(AC)+1; If C(AC) < 0 then PC <- E;

The other AOJ instructions differ from AOJL only in how they decide whether to jump.

AOJLE           Add One and Jump if Less than or Equal to zero.
AOJE            Add One and Jump if Equal to zero.
AOJN            Add One and Jump if Not zero.
AOJGE           Add One and Jump if Greater than or Equal to zero.
AOJG            Add One and Jump if Greater than zero.
AOJA            Add One and Jump Always

The SOJ (Subtract One from AC and Jump) instructions decrement the contents of the selected accumulator. If the result bears the indicated relation to zero then the instruction will jump to the effective address.

SOJ             Subtract One (don't jump).
                C(AC) <- C(AC)-1;

SOJL            Subtract One and Jump if Less than zero.
                C(AC) <- C(AC)-1; If C(AC) < 0 then PC <- E;

The other SOJ instructions differ from SOJL only in how they decide whether to jump.

SOJLE           Subtract One and Jump if Less than or Equall to zero.
SOJE            Subtract One and Jump if Equal to zero.
SOJN            Subtract One and Jump if Not zero.
SOJGE           Subtract One and Jump if Greater than or Equal to zero.
SOJG            Subtract One and Jump if Greater than zero.
SOJA            Subtract One and Jump Always

The CAM (Compare Accumulator to Memory) class compare the contents of the selected accumulator to the contents of the effective address. If the indicated condition is true, the instruction will skip. The CAM instruction is suitable for arithmetic comparision of either fixed point quantities or normalized floating point quantities. Needless to say, for the comparison to be meaningful both C(AC) and C(E) should be in the same format (i.e., either both fixed or both floating).

CAM             no op (references memory)
CAML            If C(AC) < C(E) then skip;
CAMLE           If C(AC) <= C(E) then skip;
CAME            If C(AC) = C(E) then skip;
CAMN            If C(AC) # C(E) then skip;
CAMGE           If C(AC) >= C(E) then skip;
CAMG            If C(AC) > C(E) then skip;
CAMA            skip;

The CAI (Compare Accumulator Immediate) class compare the contents of the selected accumulator to the value of the effective address. If the indicated condition is true, the instruction will skip. An effective address is an 18 bit quantity that is always considered to be positive.

CAI             no op
CAIL            If C(AC) < E then skip;
CAILE           If C(AC) <= E then skip;
CAIE            If C(AC) = E then skip;
CAIN            If C(AC) # E then skip;
CAIGE           If C(AC) >= E then skip;
CAIG            If C(AC) > E then skip;
CAIA            skip;

Fixed point arithmetic ADD, SUB, IMUL, IDIV, MUL, DIV

In positive numbers bit 0 is zero. Bits 1 is most significant; bit 35 is least significant. Negative numbers are the twos complement of postive numbers. Results (of ADD, SUB or IMUL) outside the range -2^|35 to 2^|35-1 will set overflow (PC bit 0).

Each arithmetic instruction has four forms, with modifier characters (nothing), M, B and I.

  • The ordinary form operates on an accumulator and memory, putting the result in the accumulator.
  • The Memory form puts the result in the memory location instead. The accumulator is not changed.
  • The Both form stores the result in both the accumulator and the memory location.
  • The Immediate form uses an accumulator and the effective address, putting the result in the accumulator.
ADD     C(AC) <- C(AC) + C(E);
ADDI    C(AC) <- C(AC) + E;
ADDM    C(E)  <- C(AC) + C(E);
ADDB    C(AC) <- C(AC) + C(E);  C(E) <- C(AC);

SUB     C(AC) <- C(AC) - C(E);
SUBI    C(AC) <- C(AC) - E;
SUBM    C(E)  <- C(AC) - C(E);
SUBB    C(AC) <- C(AC) - C(E);  C(E) <- C(AC);

The IMUL instructions are for multiplying numbers where the product is expected to be representable as one word.

IMUL    C(AC) <- C(AC) * C(E);
IMULI   C(AC) <- C(AC) * E;
IMULM   C(E)  <- C(AC) * C(E);
IMULB   C(AC) <- C(AC) * C(E);  C(E) <- C(AC);

The IDIV instructions are for divisions in which the dividend is a one word quantity. Two consecutive accumulators are used for the results; these are AC for the quotient, and AC+1 for the remainder (Actually, AC+1 is calculated mod 20, so if AC=17, the remainder is stored in accumulator 0.) If the divisor is zero set overflow and no divide; don't change AC or memory operands. The remainder will have the same sign as the dividend.

IDIV    C(AC) <- C(AC) / C(E);  C(AC+1) <- remainder
IDIVI   C(AC) <- C(AC) / E;  C(AC+1) <- remainder;
IDIVM   C(E)  <- C(AC) / E;
IDIVB   C(AC) <- C(AC) / C(E);  C(AC+1) <- remainder; C(E) <- C(AC);

The MUL instructions produce a double word product. A double word integer has 70 bits of significance. Bit 0 of the high order word is the sign bit. In data, Bit 0 of the low order word is ignored by the hardware. In results, bit 0 of the low word is the same as bit 0 in the high word. MUL will set overflow if both operands are -2^|35.

MUL     C(AC AC+1) <- C(AC) * C(E);
MULI    C(AC AC+1) <- C(AC) * E;
MULM    C(E)  <- high word of product of C(AC) * C(E);
MULB    C(AC AC+1) <- C(AC) * C(E);  C(E) <- C(AC);

The DIV instructions are for divisions in which the dividend is a two word quantity (such as produced by MUL). If C(AC) is greater than the memory operand then set overflow and no divide.

DIV     C(AC) <- C(AC AC+1) / C(E); C(AC+1) <- remainder;
DIVI    C(AC) <- C(AC AC+1) / E;    C(AC+1) <- remainder;
DIVM    C(E)  <- C(AC AC+1) / E;
DIVB    C(AC) <- C(AC AC+1) / C(E); C(AC+1) <- remainder;
          C(E) <- C(AC);

KL-10 Only Instructions

This node describes some instructions that only KL-10's have. This means that the only ITS machine which has them is MC. You should probably not use them even if you expect to run on MC, so that your program can be moved.

Double word Move instructions (KI10 and KL10)

There are four double word move instructions. These are suitable for manipulating KI10 and KL10 double precision floating point numbers, and for KL10 double precision integers.

DMOVE   C(AC AC+1) <- C(E E+1)
DMOVEM  C(E E+1) <- C(AC AC+1)
DMOVN   C(AC AC+1) <- -C(E E+1)
DMOVNM  C(E E+1) <- -C(AC AC+1)

Note that the DMOVN and DMOVNM are NOT to be used for KA10 double precision floating point numbers!

If a program is written that may be have to be run on a KA10, the use of all double word instructions should be avoided.

Double Precision Integer Arithmetic (KL10 only)

There are four instructions for double precision integer arithmetic. None of these instructions have any modifier: they all operate on double (or quadruple) accumulators and double words in memory with results to double (or quadruple) accumulators.

The format for a double word integer is the same as that produced by MUL, i.e., a 70 bit integer in twos complement, with bit 0 of the most significant word is the sign; in operands, bit 0 of the low order word is ignored. A quadruple word has 140 bits; bit 0 of the most significant word is the sign; in operands, bit 0 in all other words is ignored. In double (and quadruple) arithmetic results bit 0 of the low order word(s) is stored with the same value as bit 0 of the high order word.

DADD    C(AC AC+1) <- C(AC AC+1) + C(E E+1);
DSUB    C(AC AC+1) <- C(AC AC+1) - C(E E+1);
DMUL    C(AC AC+1 AC+2 AC+3) <- C(AC AC+1) * C(E E+1);
DDIV    C(AC AC+1) <- C(AC AC+1 AC+2 AC+3) / C(E E+1);
                C(AC+2 AC+3) <- remainder;

Floating Point Arithmetic

Single precision floating point numbers are represented in one 36 bit word as follows:

 0 00000000 011111111112222222222333333
 0 12345678 901234567890123456789012345
 ______________________________________
| |       |                            |
|S| EXP   |     Fraction               |
|_|_______|____________________________|

If S is zero, the sign is positive. If S is one the sign is negative and the word is in twos complement format. The fraction is interpreted as having a binary point between bits 8 and 9. The exponent is an exponent of 2 represented in excess 200 (octal) notation. In a normalized floating point number bit 9 is different from bit 0, except in a negative number bits 0 and 9 may both be one if bits 10:35 are all zero. A floating point zero is represented by a word with 36 bits of zero. Floating point numbers can represent numbers with magnitude within the range 0.5*2^|-128 to (1-2^|-27)*2^|127, and zero.

A number that in which bit 0 is one and bits 9-35 are zero can produce an incorrect result in any floating point operation. Any word with a zero fraction and non-zero exponent can produce extreme loss of precision if used as an operand in a floating point addition or subtraction.

In KI10 (and KL10) double precision floating point, a second word is included which contains in bits 1:35 an additional 35 fraction bits. The additional fraction bits do not significantly affect the range of representable numbers, rather they extend the precision.

The KA10 lacks double precision floating point hardware, however there are several instructions by which software may implement double precision. These instructions are DFN, UFA, FADL, FSBL, FMPL, and FDVL. Users of the KL10 are strongly advised to avoid using these intructions.

In the PDP-6 floating pointing is somewhat different. Consult a wizard.

            |AD add                       |  result to AC
F floating  |SB subtract  |R rounded      |I Immediate. result to AC
            |MP multiply  |               |M result to memory
            |DV divide    |               |B result to memory and AC
                          |
                          |
                          |  no rounding  |  result to AC
                                          |L Long mode
                                          |M result to memory
                                          |B result to memory and AC


                   |AD add
DF double floating |SB subtract
                   |MP multiply
                   |DV divide

Note: In immediate mode, the memory operand is <E,,0>. In long mode (except FDVL) the result appears in AC and AC+1. In FDVL the AC operand is in AC and AC+1 and the quotient is stored in AC with the remainder in AC+1.

Other floating point instructions:

FSC (Floating SCale) will add E to the exponent of the number in AC and normalize the result. One use of FSC is to convert an integer in AC to floating point (but FLTR, available in the KI and KL is better) To use FSC to float an integer, set E to 233 (excess 200 and shift the binary point 27 bits). The integer being floated must not have more than 27 significant bits. FSC will set AROV and FOV if the resulting exponent exceeds 127. FXU (and AROV and FOV) will be set if the exponent becomes smaller than -128.

DFN (Double Floating Negate) is used only to negate KA10 software format double precision floating point numbers. DFN treats AC and E as a KA10 double floating point number which it negates and stores back. AC is the high order word. Usually the low order word is in AC+1, so the instruction most often appears as DFN AC,AC+1.

UFA (Unnormalized Floating Add) is used in KA10 to assist in software format double precision arithmetic. UFA will add C(AC) to C(E) and place the result in AC+1. The result of UFA will not be postnormalized unless in original operands the exponents and signs were the same and a fraction with magnitude greater than or equal to 1 was produced. Only in this case will a one step normalization (right shift) occur. UFA will overflow in the same circumstances as FAD. Underflow is not possible.

FIX will convert a floating point number to an integer. If the exponent of the floating point number in C(E) is greater than (decimal) 35 (which is octal 243) then this instruction will set AROV and not affect C(AC). Otherwise, convert C(E) to fixed point by the following procedure: Move C(E) to AC, copying bit 0 of C(E) to bits 1:8 of AC (sign extend). Then ASH AC by X-27 bits (where X is the exonent from bits 1:9 of C(E) less 200 octal). FIX will truncate towards zero, i.e., 1.9 is fixed to 1 and -1.9 is fixed to -1.

FIXR (Fix and round) will convert a floating point number to an integer by rounding. If the exponent of the floating point number in C(E) is greater than (decimal) 35 (which is octal 243) then this instruction will set AROV and not affect C(AC). Otherwise, convert C(E) to fixed point by the following procedure: Move C(E) to AC, copying bit 0 of C(E) to bits 1:8 of AC (sign extend). Then ASH AC by X-27 bits (where X is the exponent from bits 1:9 of C(E) less 200 octal). If X-27 is negative (i.e., right shift) then the rounding process will consider the bits shifted off the right end of AC. If AC is positive and the discarded bits are >=1/2 then 1 is added to AC. If AC is negative and the discarded bits are >1/2 then 1 is added to AC. Rounding is always in the positive direction: 1.4 becomes 1, 1.5 becomes 2, -1.5 becomes -1, and -1.6 becomes -2.

FLTR (FLoaT and Round) will convert C(E), an integer, to floating point and place the result in AC. The data from C(E) is copied to AC where its is arithmetic shifted right 8 places (keeping the bits that fall off the end) and the exponent 243 is inserted in bits 1:8. The resulting number is normalized until bit 9 is significant (normalization may result in some or all of the bits that were right shifted being brought back into AC). Finally, if any of the bits that were right shifted still remain outside the AC the result is rounded by looking at the bit to the right of the AC.

Shift instructions

The following instructions shift or rotate the AC or the double word formed by AC and AC+1.

Shift instructions are all immediate instructions. The effective address is not used as the ddress of a memory operand. Instead, it is used as the number of places to shift. A positive number means a left shift; a negative number (bit 18 = 1) means a right shift.

Aside from the sign bit of the effective address, only the lowest eight bits are used. The other nine bits are ignored.

  • LSH Logical Shift. C(AC) is shifted as specified by E. Zero bits are shifted into the AC.
  • LSHC Logical Shift Combined. C(AC AC+1) is shifted as a 72 bit quantity. Zero bits are shifted in.
  • ASH Arithmetic Shift. Bit 0 is not changed. In a left shift zero bits are shifted into the right end of AC. In a left shift, if any bit of significance is shifted out of bit 1, AROV (overflow) is set. In a right shift, bit 0 is shifted into bit 1.
  • ASHC Arithmetic Shift Combined. AC bit 0 is not changed. If E is non zero, AC bit 0 is copied to AC+1 bit 0. C(AC AC+1) is shifted as a 70 bit quantity. In a left shift zero bits are shifted into the right end of AC+1. In a left shift, if any bit of significance is shifted out of AC bit 1 then AROV is set. In a right shift AC bit 0 is shifted into AC bit 1.
  • ROT Rotate. The 36 bit C(AC) is rotated. In a left rotate bits shifted out of bit 0 are shifted into bit 35. In a right rotate, bit 35 is shifted into bit 0.
  • ROTC Rotate Combined. AC and AC+1 are rotated as a 72 bit quantity. In a left rotate AC bit 0 shifts into AC+1 bit 35 and AC+1 bit 0 shifts into AC bit 35. In a right rotate, AC+1 bit 35 shifts into AC bit 0, etc.
  • JFFO Jump if Find First One. This is not actually a shift instruction, but it is a related sort of thing. It counts the number of leading zeros in the contents of AC, and stores this number in AC+1. (If AC contains zero, the number stored in AC+1 is zero, not 36). The instruction also jumps to its effective address if C(AC) # 0 (in other words, if it succeeded in finding the first one bit).

Example:

;Suppose that each bit in accumlator 1 is a flag
;telling us that some sort of processing needs to be done.
;We would like to find out which flags are set
;and, for each one, do the processing.  But we don't want to
;waste a lot of time checking flags which are not set.

LOOP:   JFFO 1,[JRST @TABLE(2)]
        ...                     ;Here all flags are zero.

TABLE:  FOO                     ;FOO handles flag bit 0
        BAR                     ;BAR handles flag bit 1.
        ...                     ;Other addresses for the remaining
flags.

FOO:    ...                     ;Do the work.
        TLZ 1,400000            ;Clear flag bit 0
        JRST LOOP               ;Find the next flag which is set.

Byte instructions

In the PDP-10 a "byte" is some number of contiguous bits within one word. A byte pointer is a quantity (which occupies a whole word) which describes the location of a byte. There are three parts to the description of a byte: the word (i.e., address) in which the byte occurs, the position of the byte within the word, and the length of the byte.

A byte pointer has the following format:

 000000 000011 1 1 1111 112222222222333333
 012345 678901 2 3 4567 890123456789012345
 _________________________________________
|      |      | | |    |                  |
| POS  | SIZE |U|I| X  |        Y         |
|______|______|_|_|____|__________________|

POS is the byte position: the number of bits from the right end of the byte to the right end of the word.

SIZE is the byte size in bits.

The U field is ignored by the byte instructions.

The I, X and Y fields are used, just as in an instruction, to compute an effective address which specifies the location of the word containing the byte.

Here are the byte instructions.

  • LDB - Load byte. The contents of the effective address of the LDB instruction is interpreted as a byte pointer. The byte described there is loaded, right adjusted, into the AC. The rest of the AC is cleared.
  • DPB - Deposit byte. The contents of the effective address of the DPB instruction is interpreted as a byte pointer. The byte described there is deposited from the byte of the same size at the right end of the AC. AC and the remainder of the word into which the byte is deposited are left unchanged.
  • IBP - Increment byte pointer. The purpose of this instruction is to advance a byte pointer to point at the next consecutive byte. The AC field must be zero. The contents of the effective address are fetched. The POS field is changed by subtracting the size field from it. If the result of the subtraction is greater than or equal to zero, store the difference in the POS field. If the difference is negative, add 1 to the Y field (in the KA10 and PDP-6 if Y contains 777777 then this will carry into the X field; in the KI10 and KL10 the carry out is suppressed) and set POS field to 44-SIZE (44 is octal). The effect of this is to modify the byte pointer to address the next byte (of the same size) that follows the byte addressed by the original pointer.
  • ILDB - Increment and Load Byte. Increment the byte pointer contained at the effective address. Then perform a LDB function using the updated byte pointer.
  • IDPB - Increment and Deposit Byte. Increment the byte pointer contained at the effective address. Then perform a DPB function using the updated byte pointer.

Text strings are typically stored using seven-bit bytes, five per word. ILDB and IDPB can then be used to step through a string. The byte pointer should be initialized to 440700,,<address of string>. Then the first ILDB will increment it to point at the first character of the string.

Logical Testing and Modification.

The Test instructions are for testing and modifying bits in an accumulator. There are 64 test instructions. Each one's name is T followed by three modifiers.

                 |R right half immediate
Test accumulator |L left half immediate
                 |D direct mask
                 |S swapped mask

                        |N no modification
                        |Z zero selected bits
                        |O set selected bits to One
                        |C complement selected bits

                                |  never skip
                                |N skip unless all selected bits are zero
                                |E skip if all selected bits are zero
                                |A skip always

The test operation considers two 36 bit quantities. One of these is the contents of the selected AC. The other quantity, called the mask, depends on the first modifier letter. For R the mask is <0,,E>; for L it is <E,,0>. For D the mask is C(E), and for S the mask is CS(E), the swapped contents of E.

  • If the skip condition N is specified, then the test instruction will skip if the AND of the mask and the AC operand is Not equal to zero.
  • If the skip condition E is specified, then the test instruction will skip if the AND of the mask and the AC operand is Equal to zero.
  • If the modification code Z appears then bits that are one in mask are made zero in the AC.
  • If the modification code O appears then bits that are one in mask are made one in the AC.
  • If the modification code C appears then bits that are one in mask are complemented in the AC.

Note that the skip condition is determined on the basis of the contents of the AC before it is modified.

The principle use for the Test instructions is in testing and modifying single bit flags that are kept in an accumulator.

Example:

        TRON 5,FOOFLG   ;Where FOOGLF has the value 200

This turns on the 200 bit in the right half of accumulator 5, and skips if the bit was already on.

Boolean Logic

There are 16 possible boolean functions of 2 variables. The PDP-10 has 16 instruction classes (each with 4 modifiers) that perform these operations. Each boolean function operates on the 36 bits of AC and memory as individual bits.

[The original had a typo; ORCA was in there twice instead of ORCM. The table below has been rearranged in opcode order. -Joe]

     C(AC)   0       1       0       1
     C(E)    0       0       1       1

400  SETZ    0       0       0       0       SET to Zero
404  AND     0       0       0       1       AND
410  ANDCA   0       0       1       0       AND with Complement of AC
414  SETM    0       0       1       1       SET to Memory
420  ANDCM   0       1       0       0       AND with Complement of Memory
424  SETA    0       1       0       1       SET to AC
430  XOR     0       1       1       0       eXclusive OR
434  IOR     0       1       1       1       Inclusive OR
440  ANDCB   1       0       0       0       AND with Complements of Both
444  EQV     1       0       0       1       EQuiValence
450  SETCA   1       0       1       0       SET to Complement of AC
454  ORCA    1       0       1       1       OR with Complement of AC
460  SETCM   1       1       0       0       SET to Complement of Memory
464  ORCM    1       1       0       1       OR with Complement of Memory
470  ORCB    1       1       1       0       OR with Complements of Both
474  SETO    1       1       1       1       SET to One

Each of the 16 instructions above have four modifiers that specify where to store the result. No modifier means result to AC. Modifier I means Immediate: the memory data is <0,,E> and the result goes to AC. M as a modifier means result should be stored in memory. B means store the results in both memory and AC.

PC format.

A subroutine call instruction is one which changes the PC (jumps) but stores the old value of the PC so that the subroutine can "return" (jump back) when it is done. There are several subroutine call instructions on the PDP-10, but they all store the PC in the same format:

 0 0 0 0 0 0 0 0 0 0 1 1 1 11111 112222222222333333
 0 1 2 3 4 5 6 7 8 9 0 1 2 34567 890123456789012345
 __________________________________________________
|A|C|C|F|F|U|I|P|A|T|T|F|D|     |                  |
|R|R|R|O|P|S|O|U|F|R|R|X|C|00000|       PC         |
|O|Y|Y|V|D|E|T|B|I|A|A|U|K|     |                  |
|V|0|1| | |R| |L| |P|P| | |     |                  |
| | | | | | | | | |2|1| | |     |                  |
|_|_|_|_|_|_|_|_|_|_|_|_|_|_____|__________________|

The right half is the PC proper -- the address of the next instruction to be executed (the one which follows the subroutine call instruction). The other individual bits are the status flags. They are stored in case the subroutine wants to restore them when it returns.

AROV, ARithmetic OVerflow, is set by any of the following:

  • A single instruction has set one of CRY0 or CRY1 without setting them both.
  • An ASH or ASHC has left shifted a significant bit out of AC bit 1.
  • A MULx instruction has multiplied -2^|35 by itself.
  • A DMUL instruction has multiplied -2^|70 by itself.
  • An IMULx instruction has produced a product less than -2^|35 or greater than 2^|35-1.
  • A FIX or FIXR has fetched an operand with exponent greater than 35.
  • FOV (Floating Overflow) has been set.
  • DCK (Divide ChecK) has been set.

CRY0, short for Carry 0, means that there was a carry out of bit 0 in an addition. Note that a carry out of bit 0, with no accompanying carry out of bit 1 (into bit 0), causes AROV to be set.

The precise conditions which can set CRY0 and not CRY1 are:

  • An ADDx has added two negative numbers with sum less than -2^|35.
  • A SUBx has subtracted a positive number from a negative number and produced a result less than -2^|35.
  • A SOSx or SOJx has decremented -2^|35.

CRY1, short for Carry 1, means that there was a carry out of bit 1 in an addition. Note that a carry out of bit 1, with no accompanying carry out of bit 0, causes AROV to be set.

The precise conditions which can set CRY1 and not CRY0 are:

  • An ADDx has added two positive number with a sum greater than 2^|35-1.
  • A SUBx has subtracted a negative number from a positive number to form a difference greater than 2^|35-1.
  • An AOSx or AOJx instruction has incremented 2^|35-1.
  • A MOVNx or MOVMx has negated -2^|35.
  • A DMOVNx has negated -2^|70

In addition, the following non-overflow conditions set both CRY0 and CRY1:

  • In ADDx both summands were negative, or their signs differed and the postive one was greater than or equal to the magnitude of the negative summand.
  • In SUBx the sign of both operands was the same and the AC operand was greater than or equal to the memory operand, or the AC operand was negative and the memory operand was postive.
  • An AOJx or AOSx has incremented -1.
  • A SOJx or SOS has decremented a non zero number other than -2^|35.
  • A MOVNx has negated zero.

FOV, Floating point OVerflow, is set by any of:

  • In a floating point instruction other than FLTR, DMOVNx, or DFN the exponent of the result exceeds 127.
  • FXU (Floating eXponent Underflow) has been set.
  • DCK (Divide ChecK) has been set by FDVx, FDVRx, or DFDV.

FPD, First Part Done, is set when the processor responds to a priority interrupt, after having completed the first part of a two part instruction (e.g., ILDB). This flag is not usually of interest to the programmer.

USER is set while the processor is in user mode. In user mode, various instruction and addressing restrictions are in effect.

IOT, User IN-Out mode, (also called IOT User), is a special mode in which some of the user mode instruction (but not addressing) restrictions are removed. In this mode a user program may perform the hardware I/O instructions.

[PUBL, Public mode, signifies that the processor is in user public mode or in exec supervisor mode. This bit exists only on standard KL-10 systems; it is not on ANY ITS system.]

AFI, Address Failure Inhibit, if this flag is set, address break is inhibited for during the execution of the next instruction [KI10, KL10 only].

TRAP2 - if bit 10 is not also set, pushdown overflow has occurred. If traps are enabled, setting this flag immediately causes a trap. At present no hardware condition sets both TRAP1 and TRAP2 simultaneously. [KI10 KL10 only]

TRAP1 - if bit 9 is not also set, arithemetic overflow has occurred. If traps are enabled, setting this flag immediately causes a trap. At present no hardware condition sets both TRAP1 and TRAP2 simultaneously. [KI10 KL10 only]

FXU, Floating eXponent Underflow, is set to signify that in a floating instruction other than DMOVNx, FLTR, or DFN, the exponent of the result was less than -128 and AROV and FOV have been set.

DCK, Divide ChecK, signifies that one of the following conditions has set AROV:

  • In a DIVx the high order word of the dividend was greater than or equal to the divisor.
  • In an IDIVx the divisor was zero.
  • In an FDVx, FDVRx, or DFDV, the divisor was zero, or the magnitude of the dividend fraction was greater than or equal to twice the magnitude of the divisor fraction. In either case, FOV is also set.

Bits 13 through 17 of the PC word are always zero to facilitate the use of indirect addressing to return from a subroutine.

Bits 18 through 35 store an address that is one greater than the address of the instruction that stores the PC. Thus, the PC word points at the instruction immediately following the subroutine call.

Recommended jump instructions: PUSHJ, POPJ, JRST, JFCL, XCT.

PUSHJ   C(AC)<-C(AC)+<1,,1>;  C(CR(AC))<-<flags,,PC>; PC<-E;

PUSHJ (PUSH return address and Jump) is like PUSH except the data that is pushed onto the top of the stack is the PC and flags word. The PC that is stored is the PC of the instruction that follows the PUSHJ. Then the PC is set to the effective address of the instruction. Pushdown overflow results if the AC becomes positive when it is incremented.

POPJ    PC<-CR(CR(AC)); C(AC)<-C(AC)-<1,,1>

POPJ (POP return address and Jump) undoes PUSHJ. The right half of the word at the top of the stack is loaded into the PC (the flags are unchanged). Then the stack pointer is decremented as in POP. The effective address of POPJ is ignored. Pushdown overflow obtains if the AC becomes negative as a result of the subtraction.

Programming hints:

If a subroutine called by PUSHJ AC, wants to skip over the instruction following the PUSHJ, the following sequence accomplishes that result:

        AOS (AC)                ;AC better be non zero.
        POPJ AC,

If you must restore the flags that PUSHJ saved, the following sequence should be used instead of POPJ:

        POP AC,(AC)             ;Adjust the stack
        JRST 2,@1(AC)           ;Restore flags and PC from old stack top.

However, this sequence has a timing error in that the word is released from the stack while its contents are still needed. This can cause a bug if you have any interrupt processing in your program. JRST, Jump and ReSTore, is an unconditional jump instruction. In JRST, the AC field does not address an accumulator. Instead, the AC is decoded to signify various things.

JRST            PC<-E;
JRST 2,         PC<-E; flags are restored (see text);
JRST 10,        PC<-E; Dismiss current priority interrupt;
JRST 12,        PC<-E; restore flags and dismiss priority interrupt;

If the AC field is zero, only a jump occurs. JRST is everyone's favorite unconditional jump instruction (the only other one is JUMPA which is more typing, also, on the KA-10 JUMPA is slower than JRST).

JRST 2, (i.e., JRST with AC field set to 2) signifies jump and restore flags. (The assembler also recognizes the mnemonic JRSTF for JRST 2,). If indirection is used in JRSTF, then the flags are restored from the last word fetched in the address calculation. If indexing is used with no indirection, the flags are restored from the left half of the specified index register. If neither indexing nor indirection is used in the address calculation the flags are restored from the left half of the JRSTF itself! In a user mode program JRSTF cannot clear USER nor can it set IOT User (it can however, clear IOT User).

The following are all illegal in user mode and are trapped as UUOs.

JRST 4, (alternate mnemonic HALT) sets the PC from E and stops the processor.

JRST 10, is used to dismiss the current priority interrupt. Usually JRST 12, is used for this purpose since JRST 10, fails to retore flags.

JRST 12, (an alternate mnemonic is JEN, jump and enable priority interrupts) combines the functions of JRST 10, and JRST 2,. The JFCL (Jump on Flag and CLear) instruction is another case in which the AC field is decoded to modify the instruction. The AC field selects the four flags in PC bits 0 through 3. PC bits 0 to 3 correspond to bits 9 to 12 in the JFCL instruction. JFCL will jump if any flag selected by the AC field is a 1. All flags selected by the AC field are set to zero.

JFCL 0, since it selects no PC bits, is a no-op.

JFCL 17, will clear all flags, and will jump if any of AROV, CRY0, CRY1, or FOV are set.

JFCL 1, (JFOV) jumps if FOV is set and clears FOV.

JFCL 10, (JOV) jumps if AROV is set and clears AROV. XCT, the execute instruction, fetches the word addressed by the effective address and executes that word as an instruction. In the case of XCTing an instruction that stores a PC, the PC that is stored is the address of the instruction that follows the XCT. If the executed instruction skips, then that skip is relative to the XCT. The AC field of the XCT should be zero. [In exec mode a non zero AC field in an XCT is significant.]

Obsolete and not-recommended jump instructions: JSR, JSP, JSA and JRA

The JSR and JSP instructions are two non-stack subroutine calls which are typical of most non-stack machines. JSP stores the old PC in an accumulator, and JSR stores it in a word at the beginning of the subroutine. JSP is useful once in a while, such as, for a subroutine whose job is to push or pop several words on the stack. JSR is useful only for UUO-handlers. *Note JSR: UUO Handlers. PUSHJ and POPJ should be used for all ordinary subroutines.

JSA and JRA are a peculiar subroutine call and matching return which were invented for PDP-6 Fortran. In most programs they are not used at all.

JSR     C(E)<-<flags,,PC>; PC<-E+1;

JSR, Jump to SubRoutine, stores the PC in the word addressed by the effective address and jumps to the word following the word where the PC is stored. This is the only PDP-10 instruction that stores the PC and flags without modifying any ACs; however, it is non-reentrant, so PUSHJ is favored in most cases. The usual return from a subroutine called by a JSR is via JRST (or JRST 2,) indirect through the PC word. (See JRST)

JSP     C(AC)<-<flags,,PC>; PC<-E;

JSP, Jump and Save PC, stores the PC and flags in the selected accumulator and jumps.

JSA     C(E)<-C(AC); C(AC)<-<E,,PC>; PC<-E+1;

JSA, Jump and Save AC, stores the AC in word addressed by the effective address. Then the left half of the AC is set to the effective address and the right half of AC is set to the return PC. Then the PC is set to one greater than the effective address. The JRA instruction unwinds this call. The advantage of this call is that a routine may have multiple entry points (which is difficult to do with JSR) and it's easy to find (and later to skip over) arguments that follow the calling instruction (which is possible to do with PUSHJ, but not quite so convenient). Among the disadvantages of this call is that it is non reentrant, and it doesn't save flags.

JRA     C(AC)<-C(CL(AC)); PC<-E;

JRA, Jump and Restore AC, is the return from JSA. If, e.g., a subrountine is called with JSA AC, then the return is made by:

        JRA AC,(AC).

A Trivial Complete MIDAS Program.

This program stores, in each word of TABLE, the index of that word. Thus, the 0th word gets 0, the next gets 1, etc.

        TITLE   COUNT

A=1                             ;Define a name for an accumulator.

START:  MOVSI A,-100            ;initialize loop counter.
                                ;A contains -100,,0
LOOP:   HRRZM A,TABLE(A)        ;Use right half of A to index.
        AOBJN A,LOOP            ;Add 1 to both halves (-77,,1 -76,,2 etc.)
                                ;Jump if still negative.
        .VALUE                  ;Halt program.

TABLE:  BLOCK 100               ;Assemble space to fill up.

END START                       ;End the assembly.

NOTES:

  • TITLE: Every MIDAS program should begin with a TITLE statement which contains the program's name.
  • A: It is best to give names to the accumulators you use. Single character names are good except for an AC which is used generally for the same thing throughout the program. Define a symbolic name for an AC with the assembler operator =.
  • Comments: Everything after a semicolon is a comment, until the end of the line. Actually, this is only true if the semicolon is not inside of a text string of some sort.
  • START: This is a label, which marks a location in the program. The label START is used to name the instruction at which the program should start running. The name START itself is nothing special. MIDAS knows to use the value of START as the starting address because START is the operand of the END statement.
  • .VALUE: This is a system call instruction. It halts the program, and makes DDT print out the program counter. All system calls have names starting with a period.
  • BLOCK: The BLOCK n statement reserves n words of storage, which are not initialized.
  • END: The end statement tells MIDAS that the assembly input is finished, and its argument says what address to start the program at. In this case the argument is the value of the label START.

Print the string FOO on the terminal.

        TITLE   PRINT
A=1                             ;Symbolic AC names are defined

CHTTYO==1                       ;Channel for output
                                ;== means don't use this symbol
                                ;for symbolic typeout in DDT.

START:                          ;Open TTY channel.
        .CALL [SETZ ? SIXBIT/OPEN/
                [.UAO,,CHTTYO] ? [SIXBIT/TTY/] ((SETZ))]
         .LOSE %LSFIL
        .IOT CHTTYO,["F]        ;Print F.
        .IOT CHTTYO,["O]        ;Print O.
        .IOT CHTTYO,["O]        ;Print O.
        .VALUE                  ;Halt program.

END START                       ;Tell MIDAS this is the end of the text
                                ;and specify the address to start execution.

NOTES:

CHTTYO: All I/O is done by means of I/O channels, of which there are sixteen, numbered 0 through 17. It is best to make symbolic names for the channels you use and start them all with CH. Define these names with the MIDAS operator ==, which is like = except that symbols defined with == are not used for symbolic typeout by the DDT debugger. We call this "half killing". In this example, CHTTYO and A both have the value 1, but CHTTYO is half killed, so 1 will always be output symbolically as A. This is the desired result, because references to address or AC 1 are more likely to mean A than CHTTYO.

.CALL: This is an ITS symbolic system call. Its format is, in general,

        .CALL [SETZ ? SIXBIT/callname/ ? arguments ((SETZ))]

(Note that the value of SETZ is a word with just the sign bit set). The [ ... ] construct is a literal, and "?" is equivalent to a line separator. Thus, the .CALL instruction is assembled with an address field that points at a block of words containing a SETZ, a SIXBIT/OPEN/, and finally the arguments. ((SETZ)) is a magic assembler incantation which sets the sign bit of the last argument word.

The arguments are simply addresses of words containing data for the system call. There are other kinds of arguments, but we won't get into that. See .INFO.;.CALLS > for more information on symbolic system calls.

A symbolic system call skips if it is successful.

OPEN: This is the name of the symbolic system call used in the example. The OPEN call is used to open an I/O channel so it can be used for I/O. It requires two arguments: the first one containing the channel number and the I/O mode, and the second one containing the device name in SIXBIT. In this example, the channel is CHTTYO, the mode is .UAO (unit ascii output), and the device name is TTY, for the terminal.

Most OPENs will also specify two filenames and a directory name as additional arguments, but for device TTY they are not necessary.

.LOSE %LSFIL: This is a system call which prints an error message and halts. It is designed to be used as the instruction following an OPEN or other symbolic system call which deals with an I/O channel. Sophisticated programs can recover from failing system calls, and sometimes the failure should simply be ignored, but often it is easiest just to use .LOSE %LSFIL. This instruction is indented because it can be skipped over.

.IOT: This is the system call for doing actual I/O. It is an instruction whose AC field should be the I/O channel and whose address points to a word containing a character to be output. "F in MIDAS represents the code for the character F.

Simple terminal input and output.

The following program accepts a line of input (terminated by Carriage Return) from the terminal and outputs that line with the characters reversed.

        TITLE   REVERSE
A=1                             ;Symbolic AC names are defined
P=17

CHTTYO==1                       ;Channel for output
CHTTYI==2                       ;Channel for input

PDLLEN==100                     ;Length of push down stack
PDL:    BLOCK   PDLLEN          ;Storage for push down stack

BEG:    MOVE P,[-PDLLEN,,PDL-1] ;Initialize stack pointer.
                                ;Open TTY channels.
        .CALL [SETZ ? SIXBIT/OPEN/
                [.UAI,,CHTTYI] ? [SIXBIT/TTY/] ((SETZ))]
         .LOSE %LSFIL
        .CALL [SETZ ? SIXBIT/OPEN/
                [.UAO,,CHTTYO] ? [SIXBIT/TTY/] ((SETZ))]
         .LOSE %LSFIL
LOOP:   .IOT CHTTYO,["*]        ;Prompt for input.
        PUSHJ P,REVERS          ;do the work, once.
        .IOT CHTTYO,[^M]        ;Output CRLF to go to new line.
        .IOT CHTTYO,[^J]
        JRST LOOP               ;Jump back to repeat.

REVERS: .IOT CHTTYI,A           ;Read a character.
        CAIN A,^M               ;If it is a Carriage Return, the line is ended,
         POPJ P,                 ;so return.
        PUSH P,A                ;Else save this character on the stack,
        PUSHJ P,REVERS          ;call REVERS recursively,
        POP P,A                 ;get our character back
        .IOT CHTTYO,A           ;and print it.
        POPJ P,                 ;Return.

END BEG

NOTES:

  • OPEN: Two tty channels are used, one for input and one for output. The input channel is opened in mode .UAI (unit ascii input) and the output channel in mode .UAO (unit ascii output). The mode is how the system knows whether to make an input channel or an output channel.
  • .IOT: It works on input channels as well as on output channels. On an input channel, it stores the input character (or word) in the addressed memory location. The ITS system does not do any sort of input editing or "rubout processing". There is a library for that: SYSENG;RUBOUT >.
  • To output "go to a new line", output a ^M followed by a ^J. ^M is the MIDAS syntax for the code for Control-M, which is Carriage Return. When the user types Carriage Return, which echoes as going to a new line, it is read by the program as only one character, a ^M.
  • The subroutine REVERS is recursive. The first call to REVERS reads the first character, calls REVERS (to read the rest of the line and print it in reverse), and lastly prints the first character. Over the recursive call to REVERS, the first character is saved on the stack.
  • P is the conventional name for the AC used as the stack pointer. The MOVE instruction is there to set it up with a pointer to the allocated area. Initializing a stack is one of the first things any real program should do. From then on, calling is done with PUSHJ and returning with POPJ. PUSH is used to save data on the stack, and POP to get it back.
  • The POPJ P, which is skipped over by the CAIN is indented one extra column. If there is a sequence of skipping instructions, each instruction is indented one more than the previous one. It is reasonable to omit the address field of an instruction if it is unused (as it is in a POPJ). An omitted field assembles as zero, but you should never omit a field which is supposed to contain a zero which actually stands for something. For example, instructions which refer to AC zero should always have a zero (or better, a symbolic name) where the AC is referred to.

Separate Even-Numbered and Odd-Numbered Characters. Rubout Processing.

The following program accepts a line of input (terminated by carriage return) from the terminal and outputs the even (i.e., every second) letters followed by the odd letters. Also, we exhibit a subroutine for reading a line from the terminal with rubout processing.

        TITLE   EVEN ODD
A=1                             ;Symbolic AC names are defined.
B=2
P=17

CHTTYO==1                       ;Channel for output
CHTTYI==2                       ;Channel for input

PDLLEN==100                     ;Length of push down stack
PDL:    BLOCK PDLLEN            ;Storage for push down stack

BUF:    BLOCK 30                ;Storage for 79 characters at 5 per word.
LINBUF: BLOCK 30
LINBFE::

START:  MOVE P,[-PDLLEN,,PDL-1]
                                ;Open TTY channels.
        .CALL [SETZ ? SIXBIT/OPEN/
                [.UAI,,CHTTYI] ? [SIXBIT/TTY/] ((SETZ))]
         .LOSE %LSFIL
        .CALL [SETZ ? SIXBIT/OPEN/
                [.UAO,,CHTTYO] ? [SIXBIT/TTY/] ((SETZ))]
         .LOSE %LSFIL
L:      PUSHJ P,GETLIN          ;Read in an entire line.
        MOVE C,[440700,,LINBUF] ;Initialize byte pointer to fetch from the line
.
        MOVE B,[440700,,BUF]    ;Initialize byte pointer to store into BUF.
;Get odd-numbered character.
L1:     ILDB A,C                ;Get next odd-numbered char of the line.
        JUMPE A,L2              ;Zero byte => end of line.
        IDPB A,B                ;Store char in BUF.  Advance pointer first.
;Get even-numbered character.
        ILDB A,C                ;Get next even-numbered char of the line.
        JUMPE A,L2              ;Zero byte => end of line.
        .IOT CHTTYO,A           ;Output this character right away.
        JRST L1                 ;Keep going till we get a terminator.

L2:     MOVEI A,0               ;Store a terminating character (code zero)
        IDPB A,B                ;at the end of the string in BUF.
                                ;Now it is an ASCIZ string.
        MOVEI A,BUF
        PUSHJ P,OUTSTR          ;Call OUTSTR to output ASCIZ string
                                ;starting at address in A.
        MOVEI A,[ASCIZ /
/]
        PUSHJ P,OUTSTR          ;Output a CRLF.
        JRST L

;Subroutine to read in a line and store it in LINBUF,
;checking to avoid running past the end of LINBUF.
;Discards the line terminator and leaves a null (zero) character
;in the buffer at the end of the string.
;Rubout cancels one character.
;Clobbers A and B.
GETLIN: .IOT CHTTYO,["*]        ;Prompt for input.
        MOVE B,[440700,,LINBUF]
GETLI1: .IOT CHTTYI,A           ;Read the character
        CAIN A,177              ;Rubout means cancel one character.
         JRST GETLRB
        CAIN A,^M               ;Carriage Return ends the line.
         JRST GETLCR
        CAME B,[100700,,LINBFE-1]       ;Don't store if buffer almost full.
                                        ;(Leaves room for one more char:
                                        ; the zero at the end)
         IDPB A,B               ;Any other character is stored in the buffer.
        JRST GETLI1

;Come here after reading the carriage return.
GETLCR: SETZ A,                 ;Store a zero to mark end of string - and make
it ASCIZ.
        IDPB A,B
        POPJ P,

;Come here after reading a rubout.
GETLRB: CAMN B,[440700,,LINBUF] ;Is there anything to rub out?
         JRST GETLNL
        LDB A,B                 ;Yes => get back the char we are cancelling
        .IOT CHTTYO,A           ;and print it out so user can see it.
        ADD B,[070000,,]        ;To discard char, decrement the byte pointer.
                                ;First increase position by one byte (7).
        SKIPGE B                ;If byte pointer negative, position is 44,
         SUB B,[430000,,1]      ;so change it to position 01 in previous word.
        JRST GETLI1

;Come here after reading a rubout with nothing to rub out.
GETLNL: MOVEI A,[ASCIZ /
/]
        PUSHJ P,OUTSTR          ;Just output a blank line.
        JRST GETLIN             ;Prompt again.

;Subroutine to output the ASCIZ string which starts
;in the word whose address is inA.  Clobbers A.
OUTSTR: HRLI A,440700           ;Make A into a byte pointer to fetch string.
OUTST1: ILDB B,A                ;Fetch next character of string into B.
        JUMPE B,CPOPJ           ;If it is the terminator, return.
        .IOT CHTTYO,B           ;Else output it
        JRST OUTST1             ;and loop back.

CPOPJ:  POPJ P,                 ;Return.

        END     START

NOTES:

  • "LINBFE::" defines the label LINBFE and half kills it. This is because LINBFE and START are actually the same location; we would prefer to have DDT print out START, so we tell it not to print out LINBFE.
  • 440700: The correct left half for a byte pointer for 7-bit bytes which points to the nonexistent character to the left of a word. The first increment will make it point to the first actual character in the word. This is the right way to start off the pointer because the ILDB and IDPB instructions increment first.
  • Decrementing a byte pointer: This is done in GETLRB. It is the inverse of incrementing the byte pointer, as done by IBP, ILDB and IDPB. The particular three-instruction sequence used above assumes that the byte size is 7. It is not hard to adapt it to other byte sizes, but sizes other than 7 are infrequent.
  • GETLIN: This subroutine does "rubout processing". It gives the user the ability to type in a line and make corrections within it. This is a very simple rubout processor; the only editing character it provides is Rubout, and it does not handle display terminals. SYSENG;RUBOUT > is a rubout processor that you can use in practice.
  • OUTSTR: A subroutine to print out an ASCIZ (ASCII, terminated by a Zero) string. Most programs contain this subroutine under some name or other.
  • CPOPJ: Note that it is possible to conditionaly jump to a POPJ instruction to do a conditional return from a subroutine. Every subroutine in the program can use the same POPJ instruction for this, and the traditional name for it is CPOPJ. You can assume when you see the label CPOPJ used that it is the address of a POPJ P, instruction.

Separate Even Characters, Odd Vowels, and Odd Consonants.

The following program accepts a line of input (terminated by carriage return) from the terminal and outputs the even (i.e., every second) letters followed by those odd letters that are not vowels, followed by those odd letters that are vowels.

In the program of example 4, take the code

L2:     MOVEI A,0               ;Store a terminating character (code zero)
        IDPB A,B                ;at the end of the string in BUF.
                                ;Now it is an ASCIZ string.
        MOVEI A,BUF
        PUSHJ P,OUTSTR          ;Call OUTSTR to output ASCIZ string
                                ;starting at address in A.
        MOVEI A,[ASCIZ /
/]
        PUSHJ P,OUTSTR          ;Output a CRLF.
        JRST L

and replace it with

L2:     MOVEI A,0               ;Deposit code zero to terminate string
        IDPB A,B                ;of odd letters (i.e., make it ASCIZ).
        MOVE B,[440700,,BUF]    ;Take pointer for odd letters
        MOVE C,B                ;Put pointer for vowels
L3:     ILDB A,B                ;Get one odd letter.
        JUMPE A,L4              ;Stop scanning when we reach the zero.
        PUSHJ P,ISVOW           ;Is this a vowel?
         JRST L3A               ;No.
        IDPB A,C                ;Yes.  Store for later.
        JRST L3

L3A:    .IOT CHTTYO,A           ;Not a vowel, so output now.
        JRST L3

L4:     IDPB A,C                ;Store code zero to end string of vowels.
        MOVEI A,BUF
        PUSHJ P,OUTSTR          ;Output that string.
        MOVEI A,[ASCIZ /
/]
        PUSHJ P,OUTSTR          ;Output a CRLF.
        JRST L

;Subroutine to skip if the character in A is a vowel.
ISVOW:  CAIE A,"A               ;If character is upper case A
         CAIN A,"a              ;or if it is lower case A,
          JRST POPJ1            ;jump to a skip return.
        CAIE A,"E               ;Same for E, etc.
         CAIN A,"e
          JRST POPJ1
        CAIE A,"I
         CAIN A,"i
          JRST POPJ1
        CAIE A,"O
         CAIN A,"o
          JRST POPJ1
        CAIE A,"U
         CAIN A,"u
          JRST POPJ1
        CAIE A,"Y
         CAIN A,"y
          JRST POPJ1
        POPJ P,                 ;Not a vowel, so return with no skip.

;Standard address of single skip return.
POPJ1:  AOS (P)
        POPJ P,

NOTES:

  • Skip return: A subroutine is said to skip return when it skips the instruction which follows the call. The subroutine call instruction therefore acts as a conditional skip instruction. Subroutines called with a PUSHJ skip return by incrementing the return address where it lives on the stack. Subroutines called in other ways implement skip returning in other ways.
  • POPJ1: This is the standard name for a place to jump to for a skip return. Since the procedure for a skip return is independent of the address of the subroutine, every subroutine can use the same POPJ1. If you see the label POPJ1 used, you can assume it is a skip return of the sort shown above.
  • Consecutive skip instructions appear in ISVOW. When this happens, each instruction that can be skipped is indented one more than the previous one. If, on the other hand, you had a subroutine that could skip twice, and followed it by two non-skipping instructions, each of those instructions would be indented only once.
  • Re-using the string: as we scan the string of odd characters for vowels, we print out the consonants and store the vowels in a string again, reusing the same space. The reason why it works to be reading out one string and writing another string in the same memory space is that we write at most one character for each character we read. So we can never clobber a character that has not been read. Even if every character is a vowel, the characters are stored into the bytes they have just been read out of, so nothing is lost.
  • Lower case letters make a difference in a character constant (such as "a).

Alternative Implementation of Previous Example.

The following program performs the same function as the program written for example 5. Some different ideas are shown here.

        TITLE   EVEN ODD #2
A=1                                     ;SYMBOLIC AC NAMES ARE DEFINED
B=2
C=3
D=4
P=17

CHTTYO==1                       ;Channel for output
CHTTYI==2                       ;Channel for input

PDLLEN==100                     ;Length of push down stack
PDL:    BLOCK PDLLEN            ;Storage for push down stack

BUF:    BLOCK 30                ;Storage for 79 characters at 5 per word.
LINBUF: BLOCK 30                ;Read a line into here.
LINBFE::

START:  MOVE P,[-PDLLEN,,PDL-1]
                                ;Open TTY channels.
        .CALL [SETZ ? SIXBIT/OPEN/
                [.UAI,,CHTTYI] ? [SIXBIT/TTY/] ((SETZ))]
         .LOSE %LSFIL
        .CALL [SETZ ? SIXBIT/OPEN/
                [.UAO,,CHTTYO] ? [SIXBIT/TTY/] ((SETZ))]
         .LOSE %LSFIL
L:      PUSHJ P,GETLIN          ;Read in the line.
        MOVE C,[440700,,LINBUF] ;Initialize byte pointer to fetch from the line
.
        MOVE B,[440700,,BUF]    ;Initialize byte pointer to store into BUF.
        SETZ D,0                ;Low bit of D is even-oddness of character.
L1:     ILDB A,C                ;Get next character.  Jump if end of line.
        JUMPE A,L2
        XORI D,1                ;Complement low bit -- count mod 2.
                                ;D is 1, then 0, then 1, then 0.
        XCT XTBL(D)             ;Execute an instruction to dispose of char.
        JRST L1

XTBL:   .IOT CHTTYO,A           ;Even character         non-vowel
        IDPB A,B                ;Odd character          vowel


L2:     MOVEI A,0               ;Deposit a null byte to make string
        IDPB A,B                ;   of odd letters ASCIZ.
        MOVE C,[440700,,BUF]    ;Fetch the string.
        MOVE B,C                ;Store back only the vowels.
L3:     ILDB A,C                ;Get one odd letter.
        JUMPE A,L4              ;Check for end of string.
        PUSHJ P,ISVOW           ;Test character, skip if vowel.
         TDZA D,D               ;Not a vowel, set D=0.
          MOVEI D,1             ;Vowel.  D=-1
        XCT XTBL(D)             ;Dispose of char depending.
        JRST L3

L4:     IDPB A,B                ;Store null to make string of odd vowels ASCIZ.
        MOVEI A,BUF
        PUSHJ P,OUTSTR          ;Type out that string.
        MOVEI A,[ASCIZ /
/]
        PUSHJ P,OUTSTR
        JRST L

ISVOW:
IRPC ZZ,,[AEIOUY]
        CAIE A,"ZZ
         CAIN A,"ZZ+40
          JRST POPJ1
TERMIN
        POPJ    P,

;Copy the GETLIN and OUTSTR subroutines from above into here.

        END     START

NOTES:

  • IRPC is an assembler macro operation which generates repetitive code with small variations. In this case, the three instructions CAIE, CAIN and JRST are repeated once for each vowel. The first time, ZZ is replaced by A. The second, ZZ is replaced by Z. The sixth time, ZZ is replaced by Y. As a result, the subroutine ISVOW in this example is actually identical to the ISVOW in the previous example, though it takes much fewer lines of source code.

Arithmetic Calculator Program.

This program will read an arithmetic expression composed of numbers and the operators +, -, * and /, compute the value and type the result. It shows how to read and print numbers. It does not know about operator precedence; it does operations from left to right always.

        TITLE   NUM
FL=0
A=1
B=2
C=3
D=4
P=17

CHTTYI==1
CHTTYO==2

;FLAG NAMES
NEGF==1
DIGF==2

PDLLEN==100
PDL:    BLOCK PDLLEN
OP1:    0
X1:     0

LINBUF: BLOCK 30
LINBFE::

LINPTR: 0

START:  MOVE P,[-PDLLEN,,PDL-1]
                                ;Open TTY channels.
        .CALL [SETZ ? SIXBIT/OPEN/
                [.UAI,,CHTTYI] ? [SIXBIT/TTY/] ((SETZ))]
         .LOSE %LSFIL
        .CALL [SETZ ? SIXBIT/OPEN/
                [.UAO,,CHTTYO] ? [SIXBIT/TTY/] ((SETZ))]
         .LOSE %LSFIL
START1: PUSHJ P,GETLIN          ;Read in a line of input.
        MOVE A,[440700,,LINBUF]
        MOVEM A,LINPTR          ;Set up to fetch chars from the line.
        PUSHJ P,EVAL            ;Parse and evaluate expression.
        PUSHJ P,DECOUT          ;Print the answer.
        MOVEI A,[ASCIZ/
/]
        PUSHJ P,OUTSTR
        JRST START1

;Read and evaluate an expression.  Value returned in A.
;Clobbers B.
EVAL:   PUSHJ P,DECIN           ;Read one number.
        MOVEM B,OP1             ;Save the number.
EVAL1:  MOVEI B,0
        CAIN A,"+               ;Consider the operation character:
         MOVE B,[ADD B,OP1]     ;B gets an instruction to do that operation.
        CAIN A,"-
         MOVE B,[SUB B,OP1]
        CAIN A,"*
         MOVE B,[IMUL B,OP1]
        CAIN A,"/
         MOVE B,[IDIV B,OP1]
        JUMPE B,EVALX           ;If B is still 0, the terminator
                                ;was not an arith op, so it ends
                                ;the expression or is illegal.
        MOVEM B,X1              ;It is an arith op, so save the instruction.
        PUSHJ P,DECIN           ;Read the second operand.
        EXCH B,OP1              ;B gets first op, OP1 gets second operand.
        XCT X1                  ;Compute result of operation, in B.
        MOVEM B,OP1             ;Save it as first operand of next operation.
        JRST EVAL1              ;A has terminator of second operand,
                                ;which is the next operation.

;Come here on number terminated by char not an arith op.
EVALX:  JUMPN A,ERR             ;Should be end of line, or it's an error.
        MOVE A,OP1              ;Otherwise, last saved value is value of exp.
        POPJ P,

;Print an error message if we see something we don't recognize.
ERR:    MOVEI A,[ASCIZ/Unrecognized character in expression: /]
        PUSHJ P,OUTSTR
        LDB A,LINPTR            ;Print the offending character
        .IOT CHTTYO,A           ;as part of the error message.
        MOVEI A,[ASCIZ /
/]
        PUSHJ P,OUTSTR
        JRST START1

;Read a signed decimal number out of the line, returning number in B
;and terminating character in A.
DECIN:  TRZ FL,NEGF!DIGF        ;No minus, no digit seen yet.
        MOVEI B,0
DECIN1: ILDB A,LINPTR           ;Fetch next character of line.
        CAIL A,"0
         CAILE A,"9
          JRST DECIN2           ;Jump if character not a digit.
        IMULI B,10.             ;Else accumulate this digit into the number.
        ADDI B,-"0(A)           ;Note that we convert the digit into its value.
                                ;("0 into the value 0, "1 into 1).
        TRO FL,DIGF             ;Set flag saying non-null number seen.
        JRST DECIN1

DECIN2: CAIN A,"-
         JRST DECIN3            ;Jump on minus sign.
        TRNN FL,DIGF            ;Anything else: if we saw a number,
         POPJ P,                ;negate it if it began with a minus sign.
DECIN4: TRZE FL,NEGF
         MOVN B,B
        POPJ P,

;Come here after reading a minus sign.
DECIN3: TRNE FL,DIGF            ;Does it follow a number?
         JRST DECIN4            ;Yes.  This must be a binary minus.
        TRC FL,NEGF             ;This must be unary minus.
                                ;Complement flag that number is negative.
        JRST DECIN1             ;(So that two minus signs cancel out).

;Print number in A, positive or negative, in decimal.
;Clobbers A and B.
DECOUT: JUMPGE A,DECOT1
        .IOT CHTTYO,["-]        ;If number is negative, print sign.
        CAMN A,[400000,,]       ;Smallest negative number is a pain:
         JRST DECOT2            ;its absolute value cannot fit in one word!
        MOVM A,A                ;Else get abs val of negative number and print.
DECOT1: IDIVI A,10.
        HRLM B,(P)              ;Save remainder in LH of stack word
                                ;whose RH contains our return address.
        SKIPE A                 ;If quotient is nonzero,
         PUSHJ P,DECOT1         ;print higher-order digits of number.
        HLRZ A,(P)              ;Get back this remainder (this digit).
        ADDI A,"0
        .IOT CHTTYO,A
        POPJ P,

;Print the abs value of the largest negative number.
DECOT2: MOVEI A,[ASCIZ /34359738368/]
        JRST OUTSTR

;Copy the GETLIN and OUTSTR subroutines here.

        END     START

NOTES:

  • 10.: This is a decimal number. You can tell, because it ends with a decimal point.
  • LINPTR: this location holds the byte pointer used for fetching characters out of the line. It is usually not worth while to keep this pointer in an accumulator if the parsing is being done over more than a very small piece of code.
  • XCT: Note how EVAL chooses an arithmetic instruction based on the arithmetic operator character, then reads the following argument, and then executes the instruction chosen earlier, performing the operation. This is also the first use you have seen of literals containing instructions.
  • ERR: this is an example of printing an error message. Error messages should always show the offending data, not just say "something was wrong".
  • DECIN: Note how flags in accumulator 0 (FL) are used to keep track of whether any digits have been seen, and whether a minus sign came before them. Accumulator 0 is most often used for such flags because it is the least useful accumulator for anything else (since it cannot be used as an index register).
  • DECOUT: This is a very famous program for printing a number. It works recursively because the first digits extracted as the remainders in successive divisions by the radix are the last digits to be printed. So the digits are produced and saved on the way down the recursion, and printed on the way up.
  • HRLM: We could save the remainder with PUSH P,B and restore it with POP P,A, but since the left half of each word saved by a PUSHJ is not really going to be used, we can save stack space by using those left halves to store the remainder. It is also faster.

Reading and Writing Files.

As a preface to this example, several things need to be explained. In the foregoing examples, only terminal I/O has been discussed. Here we introduce disk file input. One important thing to emphasize is the concept of device independence: most of the system calls for disk i/o are the same as those for say, magtape i/o. Naturally, different devices have different phyical characteristics; therefore, some differences between devices will be apparent. Despite these differences, a programmer really needs to learn only one set of basic concepts for i/o.

When doing i/o it is necessary to specify a physical device, a mode (input vs. output, character vs. word), and possibly a file name to select among "files" on a particular physical device.

Each job can has sixteen i/o channels available, each of which can be opened individually to do i/o. The same OPEN system call used to open a tty channel is also used to open i/o channels for other devices. OPEN also specifies the mode and filenames.

You have already seen the use of modes .UAI (unit ascii input) and .UAO (unit ascii output). Modes .UII and .UIO are "image" i/o instead of ascii i/o. They transfer whole words instead of characters, and are used for binary files.

There are two filenames, and also a directory name. These are specified as words of SIXBIT just like the device name.

Once the channel is open, the .IOT UUO is used to transfer the characters in or out, just as it is with the terminal. In fact, the above examples could be adapted to read and write input using disk files only by changing the two OPEN system calls. Alternatively, filename translations could be used to translate device TTY: to a disk file.

Writing output to a file does require one thing that writing output to the terminal does not need: you must "close" the channel when you are finished to make the file appear properly on disk. Closing a terminal i/o channel is also allowed but nobody bothers since it is not necessary. Closing is done with the .CLOSE UUO, which takes the channel number in its AC field just like .IOT.

Here is an example which copies the file SYS;SYSTEM MAIL (the announcements printed when DDT or PWORD starts up) to the file FOO BAR on your own directory.

        TITLE   FILE COPY
A=1

CHDSKI==1
CHDSKO==2

FCOPY:  .CALL [ SETZ ? SIXBIT/OPEN/
                [.UAI,,CHDSKI] ? [SIXBIT/DSK/]  ;Mode, channel and device name
                [SIXBIT /SYSTEM/] ? [SIXBIT/MAIL/]      ;Two filenames.
                400000,,[SIXBIT /SYS/]]                 ;Directory name.
         .LOSE %LSFIL
        .CALL [ SETZ ? SIXBIT/OPEN/
                [.UAO,,CHDSKO] ? [SIXBIT/DSK/]
                [SIXBIT /FOO/] ? 400000,,[SIXBIT/BAR/]] ;Note no directory name
!
                                ;The default (your working directory) is used.
         .LOSE %LSFIL
LOOP:   .IOT CHDSKI,A           ;Read next input character.
        JUMPL A,EOF             ;Negative => there is none, it's eof.
        .IOT CHDSKO,A           ;Else write char to output file.
        JRST LOOP

EOF:    .CLOSE CHDSKO,          ;Make output file appear.
        .CLOSE CHDSKI,          ;Release input file (to be clean).
        .LOGOUT 1,

        END FCOPY

NOTES:

  • This example is so simple that no stack is needed, and no tty channels.
  • When reading from a file instead of the terminal, it is possible to reach th e end of the file. In ascii mode (.UAI), this is signalled by a negative value returned by the .IOT. The right halfword of that value contains the character ^C, which is the standard end-of-file padding character on ITS. That is, ^C is used to fill out the last word of a file of characters if that last word is not entirely used up. In image mode, .IOT causes an error interrupt at end of file . Usually binary files are read many words at a time using SIOT (which will be explained soon) or block-mode .IOT; these do provide a way to detect end of fil e without getting an error.
  • .LOGOUT 1, is a convenient way to exit a program and kill the job. It kills the job if it is running under DDT (the usual condition) and also kills the job if it is disowned. When a program running under DDT does a .LOGOUT 1, DDT just prints an asterisk.

Parsing SIXBIT Words, and Filenames.

Here is a sample routine which accumulates a word of sixbit, returning it in B. Non-alphanumeric characters are terminators; the terminator encountered is returned in A.

We assume that GETCHR is a subroutine we can call which reads a character of input and returns it in A.

GETSIX: MOVEI B,0
        MOVE C,[440600,,B]      ;Byte pointer for storing into B.
GETSX1: PUSHJ P,GETCHR          ;Read next character into A.
        CAIN A,40
         JRST [ JUMPE B,GETSX1  ;Flush leading blanks
                POPJ P,]        ;but trailing blanks are terminators.
        CAIL A,"A+40
         CAILE A,"Z+40
          JRST .+2              ;Not lower case
           TRZ A,40             ;Make lower case into upper case
        CAIL A,"A
         CAILE A,"Z
          JRST .+2
           JRST GETSX2          ;Letters are ok in sixbit
        CAIN A,^Q               ;^Q means "quote": use the next char
         JRST [ PUSHJ P,GETCHR  ;even if it is usually a delimiter.
                JRST GETSX2]
        CAIL A,"0
         CAILE A,"9
          POPJ P,               ;Not a letter, not a digit.  This is delim.
GETSX2: SUBI A,40               ;Convert to sixbit
        TLNE C,770000           ;Skip if already got 6 characters.
         IDPB A,C               ;Otherwise we would clobber C here.
        JRST GETSX1

You don't need to write a filename parsing routine, because you can use the library SYSENG;RFN >. However, RFN is a good example to read.

Sample Routine to do Buffered Input.

So far, the i/o in the examples has always transferred a single character at a time. When a large file is to be read or written, it is worth while to go to the extra trouble of transferring many words or characters at a time. There ar e two ways of doing this. The old way is to open the i/o channel in "block" mode instead of "unit" mode: use mode .BAI, .BAO, .BII or .BIO instead of .UAI, .UAO , .UII or .UIO. Then the .IOT UUO itself transfers a block of consecutive words instead of a single word or character. The newer way is to open the channel in unit mode as usual, and use the system call SIOT to transfer any number of consecutive bytes. SIOT can be interspersed with individual .IOTs.

We assume that INCHAN has a file open in mode .UAI, unit ascii input. We use the SIOT system call to read many characters at a time into a buffer, and then get them out of the buffer one by one.

SIOT expects three arguments: a channel number, a byte pointer and a number of characters. The byte pointer argument should not be a literal, because the SIOT increments it past the characters that are transferred. The count is also modified; it is decremented for all the characters transferred (decremented down to zero if the transfer is completed). On input, if end of file is encountered before the requested number of characters is obtained, then the byte pointer and count indicate the characters actually transferred.

INBFR:  BLOCK INBFL             ;This is the buffer.  40 to 200 is
                                ;good for INBFL (160. to 640. characters).

INCNT:  0                       ;Number of characters left in buffer
                                ;not fetched yet.
INPTR:  0                       ;Byte pointer used for fetching characters

;Read another input character into A.
;Skip if successful.  No skip if EOF.
GETCHR: SOSL INCNT              ;Anything left in the buffer?
         JRST GETCH1
        PUSH P,A                ;No - must read another load.
        PUSH P,B
        MOVE A,[440700,,INBFR]
        MOVEM A,INPTR
        MOVEI B,INBFL*5
        ;; Do the input.  A says where to put it and B says how many chars.
        .CALL [ SETZ ? SIXBIT /SIOT/ ? %CLIMM,,INCHAN
                        A ? 400000,,B]
                                ;Note "immediate" argument:
                                ;%CLIMM,,INCHAN is the same as [INCHAN].
         .LOSE %LSFIL
        MOVNS B                 ;B is left with number of characters
        ADDI B,INBFL*5          ;We wanted but didn't get.
        MOVEM B,INCNT           ;Compute how many chars we did get.
        POP P,B
        POP P,A
        SOSG INCNT              ;If we got none, it's eof.
         POPJ P,
GETCH1: ILDB A,INPTR
        AOS (P)
        POPJ P,

Note that this GETCHR routine is completely equivalent to

GETCHR: .IOT INCHAN,A
        SKIPGE A
         AOS (P)
        POPJ P,

but the buffered one is much faster because it does not have to do a system call for each character. If your program is supposed to process characters quickly, use buffered input. If characters will be read only infrequently and a few at a time, use simple input.

Buffered Input, Ignoring Padding.

Sometimes it is desirable to ignore padding (^@ and ^C characters) at the end of a file, but to consider ^@ and ^C characters within the file to be significant. The convention usually used is that ^@ and ^C characters are only padding if they occur as the last few characters in the last word of the file. A ^L character in the last word followed only by ^C's or ^@'s is also to be ignored. Here is a routine which claims to have hit end of file when it reaches the padding.

This routine works by saving the last word of each buffer load to be processed at the front of the next buffer load. That is so that, when we discover end of it is guaranteed that we have not yet processed the last word of the file. So once we KNOW it is the last word, we can look through it for padding and discard what we find.

It is necessary to call the subroutine GETINI before reading the first character of input.

INBFR:  BLOCK INBFL             ;This is the buffer.  40 to 200 is
                                ;good for INBFL (160. to 640. characters).

INCNT:  0                       ;Number of characters left in buffer
                                ;not fetched yet.
INPTR:  0                       ;Byte pointer used for fetching characters

INAHED: 0                       ;Look-ahead word.
                                ;The last word of previous bufferful
                                ;saved for the next bufferful.
INEOF:  0                       ;-1 if this bufferful is the last.

;Read another input character into A.
;Skip if successful.  No skip if EOF.
GETCHR: SOSL INCNT              ;Anything left in the buffer?
         JRST GETCH1            ;Yes => just get it.
        SKIPE INEOF             ;If we discovered last time that there
         POPJ P,                ;is no more, it's eof now.
        PUSHJ P,GETBUF          ;Fill up the buffer again.
        JRST GETCHR

GETCH1: ILDB A,INPTR
        AOS (P)
        POPJ P,

;Call this to initialize the buffer, before reading the first character.
;This is to ignore the look-ahead word,
;which is garbage the first time around.
GETINI: SETZM INEOF
        SETZM INCNT
        PUSHJ P,GETCHR          ;So just read and throw away
        PUSHJ P,GETCHR          ;the supposed look-ahead chars.
        PUSHJ P,GETCHR
        PUSHJ P,GETCHR
        PUSHJ P,GETCHR
        POPJ P,

GETBUF: PUSH P,A
        PUSH P,B
        MOVE A,INAHED           ;Our previous look ahead word is now
        MOVEM A,INBFR           ;our first word of input.
        MOVE A,[440700,,INBFR]  ;That's where we should start fetching.
        MOVEM A,INPTR
        HRLI A,010700           ;The SIOT should start AFTER that word.
;Note that it is essential that we set up A with
;010700,,INBFR rather than 440700,,INBFR+1
;because of how GETCH4 decrements the byte pointer.
;We are being compatible with SIOT, which also returns
;a byte pointer of the form 010700 rather than 440700.
        MOVEI B,INBFL*5-5       ;from the file, but not that word.
        ;; Do the input.  A says where to put it and B says how many chars.
        .CALL [ SETZ ? SIXBIT /SIOT/ ? %CLIMM,,INCHAN
                        A ? 400000,,B]
         .LOSE %LSFIL
        JUMPE B,GETCH2          ;Didn't get all we asked for =>
         SETOM INEOF            ; this is the last we will get.
        MOVNS B                 ;B is left with number of characters
        ADDI B,INBFL*5          ;we wanted but didn't get.
        MOVEM B,INCNT           ;Compute how many chars we did get.
;We are now certainly at eof, and the last word of the file
;is now in the buffer.
GETCH4: ADD A,[070000,,]        ;Back up to last character.
        JUMPL A,GETCH3          ;When we get to left edge of word,
                                ;we have examined the entire last word,
                                ;so there is no more padding.
        LDB B,A
        CAIE B,^C               ;Any number of ^@ and ^C chars is padding.
         CAIN B,^@
          JRST [ SOS INCNT      ;So officially say it is not there.
                 JRST GETCH4]
        CAIN B,^L               ;A ^L followed by padding is padding
         SOS INCNT              ;but nothing before it is padding.
        JRST GETCH3

;If we did fill the buffer, we must save one word as look-ahead
;for next time.
GETCH2: MOVE A,INBFR+INBFL-1    ;Save the last word we got.
        MOVEM A,INAHED
        MOVEI A,INBFL*5-5       ;Don't include those 5 chars
        MOVEM A,INCNT           ;in the count of how many are in the bfr.
GETCH3: POP P,B
        POP P,A
        POPJ P,

Both of these examples are suited to reading input from a disk file. If you are reading input from the terminal, you probably want to do rubout processing for the user's sake. There is a library you can use for this; read the file SYSENG;RUBOUT >.

Debugging Programs with DDT

When you try your program for the first time, it won't work.

To find out why, you use the debugging features of DDT. DDT is completely documented (*Note DDT: (DDT).) but this is a summary of what sorts of things you can do with it.

DDT allows you to set a "breakpoint". Setting a breakpoint at an instruction means that when the program gets to that instruction it will stop (return to DDT). At this time you can examine any location in the program to see if everything is working right so far. If it is still working right, you can set another breakpoint, later on, and continue the program.

When you see that a variable contains a "wrong" value, DDT allows you to correct the value and continue, from the breakpoint or from someplace else. You can also change instructions in the program with DDT so that you can keep running the program and the problem will not happen again (but don't forget to make the correction in the source file as well!) DDT allows can print instructions and addresses using the symbols you define in the program, and it understands those symbols in your input as well.

You can also ask DDT to run your program one instruction at a time. This is often easier than setting breakpoints.

You don't have to do anything special to be able to use DDT on your program, because DDT is always available on ITS. It is the program which processed your command to run INFO. You probably don't want to set any breakpoints in INFO, but if you type C-Z now you could do just that.

Homework # 1 answer

        TITLE   IGPAY ATINLAY
A<-1                                    ;SYMBOLIC AC NAMES ARE DEFINED
B<-2
C<-3
D<-4
P<-17
PDLEN<-<-100                            ;LENGTH OF PUSH DOWN LIST
PDLIST: BLOCK   PDLEN                   ;STORAGE FOR PUSH DOWN LIST
BUFR:   BLOCK   30                      ;STORAGE FOR 79 CHARACTERS


START:  RESET
        MOVE    P,[IOWD PDLEN,PDLIST]
L:      OUTCHR  ["*"]                   ;PROMPT FOR INPUT
        MOVE    B,[POINT 7,BUFR]
L1:     PUSHJ   P,DOWORD
        CAIE    A,12                    ;DELIMITER SEEN?
        JRST    L1
        OUTSTR  [BYTE(7)15,12]
        JRST    L

DOWORD: MOVE    B,[POINT 7,BUFR]
        SETZM   BUFR
        PUSHJ   P,GETLTR
        JRST    EPOPJ                   ;NON LETTER
DOWRD1: PUSHJ   P,ISVOW                 ;IS IT A VOWEL?
        JRST    .+2
        JRST    DOWRD3                  ;YES.
        IDPB    A,B                     ;CONSONANT AT FRONT OF WORD
        PUSHJ   P,GETLTR
        TDZA    C,C                     ;"WORD" HAS ALL CONSONANTS
        JRST    DOWRD1
        IDPB    C,B                     ;STORE ZERO TO MAKE ASCIZ
        OUTSTR  BUFR
EPOPJ:  CAIE    A,12
        OUTCHR  A                       ;TYPE NON LETTER
        POPJ    P,

DOWRD2: OUTCHR  A                       ;HERE FOR A WORD THAT BEGINS W/VOWEL
        PUSHJ   P,GETLTR
        JRST    EPOPJ
        JRST    DOWRD2

DOWRD3: LDB     C,[POINT 7,BUFR,6]      ;GET FIRST CONSONANT IF ANY.
        JUMPE   C,DOWRD2                ;JUMP IF NO FIRST CONSONANT.
        MOVE    D,A                     ;COPY CASE OF FIRST VOWEL
        TRNN    C,40                    ;SKIP IF FIRST LETTER IS LOWER CASE
        TRZ     A,40                    ;MAKE FIRST VOWEL UPPER CASE.
DOWRD4: OUTCHR  A                       ;OUTPUT FIRST V IN SAME CASE AS FIRST C
ONS.
        PUSHJ   P,GETLTR
        JRST    .+2                     ;END OF WORD
        JRST    DOWRD4
        MOVEI   C,"A"
        IDPB    C,B
        MOVEI   C,"Y"
        IDPB    C,B
        MOVEI   C,0
        IDPB    C,B
        TRNN    D,40                    ;WAS FIRST VOWEL IN LOWER CASE?
        SKIPA   C,[JFCL]
        MOVE    C,[IORI D,40]           ;YES. FORCE REMAINDER TO LOWERCASE.
        MOVE    B,[POINT 7,BUFR]
DOWRD5: ILDB    D,B
        JUMPE   D,EPOPJ
        XCT     C
        OUTCHR  D
        JRST    DOWRD5
        
GETLTR: .IOT    CHTTYI,A        ;Read input character into A.
        CAIN    A,^M
         JRST   GETLTR
        CAIL    A,"A
         CAILE  A,"Z
          JRST  .+2
           JRST CPOPJ1
        CAIL    A,"A+40
         CAILE  A,"Z+40
          POPJ  P,
CPOPJ1: AOS     (P)                     ;SKIP RETURN, UNLESS LF.
        POPJ    P,

ISVOW:  IRPC ZZ,,[AEIOUY]
        CAIE    A,"ZZ
         CAIN   A,"ZZ+40
          JRST  CPOPJ1
TERMIN
        POPJ    P,

        END     START