src/eddt.mac

   1
   2
   3
   4
   5
   6 EDDT=3          ;THIS CAUSES A RELOCATABLE VERSION OF EXEC DDT WITH THE
   7                 ; PAPER TAPE I/O OPTION TO BE ASSEMBLED (AS OPPOSED TO
   8                 ; RELOCATABLE AND/OR ABSOLUTE VERSIONS OF USER DDT
   9                 ; AND/OR NON-PAPER TAPE I/O EXEC DDT, ALL OF WHICH CAN
  10                 ; BE ASSEMBLED FROM THE SAME SOURCE CODE WITH A
  11                 ; DIFFERENT DEFINITION OF "EDDT").
  12 \f
  13
  14 REPEAT 0,<
  15
  16         HOW TO ASSEMBLE DDT
  17
  18         THE SOURCE OF DDT WILL ASSEMBLE INTO SEVERAL DIFFERENT
  19         VERSIONS; THE ASSEMBLE IS CONTROLED BY THE VALUES
  20         ASSIGNED TO THE SYMBOL EDDT. THIS SYMBOL MUST BE
  21         DEFINED AS A SEPARATE FILE PRECEDING THE DDT SOURCE FILE.
  22         THE SYMBOL EDDT IS DECODED IN THE FOLLOWING MANNER:
  23         BIT 35 A ZERO:  ASSEMBLE USER MODE DDT
  24         BIT 35 A ONE:   ASSEMBLE AN EXECUTIVE MODE DDT
  25         BIT 34 A ZERO:  DO NOT ASSEMBLE THE PAPER TAPE
  26                         FEATURE INTO THE DDT
  27         BIT 34 A ONE:   THIS IS IGNORED FOR USER DDT.
  28                         FOR AN EXEC DDT, ASSEMBLE
  29                         THE PAPER TAPE FEATURE
  30         BITS 0-17:      IF THESE BITS ARE ALL ZERO THE
  31                         ASSEMBLY WILL BE RELOCATABLE
  32                         IF THEY ARE NON-ZERO, THE ASSEMBLY IS
  33                         ABSOLUTE STARTING AT THE VALUE IN BITS
  34                         0-17 (THE LEFT HALF)
  35
  36         EXAMPLE:
  37         1.) IF EDDT IS NOT DEFINED BY A PARAMETER ASSIGNMENT,
  38         DDT WILL ASSIGN EDDT=0 AND A USER MODE RELOCATABLE
  39         DDT WILL RESULT.
  40
  41         2.) EDDT=1; A RELOCATABLE EXEC DDT WITHOUT PAPER
  42         TAPE FEATURE WILL RESULT.
  43
  44         3.) EDDT=3; A RELOCATABLE EXEC DDT WITH PAPER
  45         TAPE FEATURE WILL RESULT
  46
  47         4.) EDDT=<XWD 4000,1>; AN ABSOLUTE DDT (STARTING
  48         ADRESS 4000) WITHOUT PAPER TAPE FEATURE WILL RESULT
  49
  50         5.) EDDT=<XWD 4000,3>; AN ABSOLUTE DDT
  51         (STARTING ADDRESS 4000) WITH ALL THE PAPER TAPE
  52         FEATURES WILL RESULT.
  53 >\r
  54
  55 \f
  56
  57
  58 IFNDEF EDDT,<EDDT=0>
  59
  60
  61
  62
  63 DEFINE XP (X.,Y.),<
  64 IF2,<X.=Y.
  65 INTERN X.
  66 NSYMS=NSYMS+2>>
  67 NSYMS=0         ;INITIAL SYMBOL COUNTER
  68
  69 LOC 74
  70 XWD DDTEND,DDT
  71 RELOC 0
  72
  73 IFN EDDT&<XWD -1,0>,<LOC <EDDT>B53>
  74
  75 IFN EDDT&1,<TITLE EDDT   V.005A  - EXEC MODE VERSION
  76         JOBREL=37
  77         JOBSYM=36
  78         ZLOW=40
  79         DDTX=DDT
  80         ENTRY DDTX>
  81
  82 IFE EDDT&1,<TITLE UDDT   V.005  - USER MODE DDT
  83         EXTERN JOBREL,JOBSYM,JOBSA
  84         NSYMS=NSYMS+6
  85         ZLOW=140>
  86 F=0             ;FLAGS
  87 P=1             ;PUSH DOWN
  88 R=2             ;POINTERS TO TABLES, CORE, ETC.
  89 S=3
  90 W=4             ;CONTAINS DISPATCH ADDRESS IN WORD ASSEMBLER
  91 T=5             ;TRANSFER DATA
  92 W1=6
  93 W2=7
  94 SCH=10          ;MODE CONTROL SWITCH FOR OUTPUT
  95 AR=11           ;MODE CONTROL SWITCH FOR OUTPUT
  96 ODF=12          ;MODE CONTROL SWITCH FOR OUTPUT - CURRENT RADIX
  97 A=R
  98 B=S
  99 C=W
 100
 101 PRS=4
 102 TTYY=120
 103 PTRR=104
 104 PTPP=100
 105
 106 LPDL=50         ;MAX LENGTH PUSH DOWN LIST
 107
 108 \fTIF=100000             ;TRUNCATE TO 18 BITS -  SET BY SPACE OR COMMA
 109 PTF=100         ; +, -, OR * HAS BEEN TYPED
 110 CTF=400
 111 SF=4            ;SYLLABLE FLAG
 112 QF=1            ;QUANTITY TYPED IN TO WORD ASSEMBLER
 113
 114 CF=40           ;  TYPED
 115 CCF=10000               ;  TYPED
 116 MF=2            ;MINUS SIGN TYPED IN
 117 LTF=20          ;LETTER TYPED IN TO CURRENT SYLLABLE
 118 ROF=10          ;REGISTER OPEN FLAG
 119 STF=4000
 120 FAF=1000                ; < TYPED
 121 SAF=2000                ; > TYPED
 122
 123 FPF=20000               ; . TYPED IN
 124 FEF=400000              ; E FLAG
 125
 126 MLF=200         ;*FLAG
 127 DVF=40000               ;DIVIDE FLAG
 128
 129 PID=0           ;=0 IF SYMBOL TABLE POINTER IS IN JOBSYM
 130 \f
 131 ;RIGHT HALF FLAGS
 132
 133 ITF=2   ;INSTRUCTION TYPED IF ITF=1
 134 OUTF=4  ;OUTPUT IF OUTF=1
 135 CF1=400         ;OUTPUT 1 REGISTER AS CONSTANT
 136 LF1=2000                ;OUTPUT 1 REGISTER AS FORCED SYMBOLIC OR CONSTANT
 137 Q2F=1           ;NUMBER TYPED AFTER ALT MODE
 138 SBF=20
 139 NAF=200         ;NEGATIVE ADDRESSES PERMISSABLE
 140 POWF=4000               ;ARGUMENT FOR EXPONENT COMING
 141 SLL=10000               ;STOP LOOKING FOR LOCALS
 142
 143 GLOBAL=040000           ;GLOBAL SYMBOL
 144 LOCAL=100000
 145 PNAME=740000            ;PROGRAM NAME
 146 DELI=200000             ;DELETE INPUT
 147 DELO=400000             ;DELETE OUTPUT
 148
 149 DDT:
 150 ENTRY DDT
 151 NSYMS=NSYMS+2
 152
 153
 154 RADIX 10
 155 NBP=8   ;NUMBER OF BREAKPOINTS
 156 DEFINE DBPNT (Z.)<XP $'Z.'B,B1ADR+3*Z.-3>
 157 ZZ=0
 158 REPEAT NBP,<DBPNT \<ZZ=ZZ+1>>
 159 RADIX 8
 160
 161
 162 XP $M,MSK
 163 XP $I,SAVPI
 164 XP DDTEND,DDTEND
 165 \f
 166
 167 IFN EDDT&1,<
 168
 169 XP PI,4B11
 170 XP PTP,100B11
 171 XP PTR,104B11
 172 XP CDR,114B11
 173 XP TTY,120B11
 174 XP LPT,124B11
 175 XP DC,200B11
 176 XP DIS,130B11
 177 XP PLT,140B11
 178 XP CR,150B11
 179 XP DSK,170B11
 180 XP DTC,210B11
 181 XP DTS,214B11
 182 XP DCSA,300B11
 183 XP DCSB,304B11
 184 XP DF,270B11
 185 XP MTC,220B11
 186 XP MTS,224B11
 187 XP MTM,230B11
 188 XP DLS,240B11
 189 XP TDC,320B11
 190 XP TDS,324B11
 191 XP TMC,340B11
 192 XP TMS,344B11>
 193
 194 XP JOV,2554B11
 195 XP JEN,2545B11
 196 XP HALT,2542B11
 197
 198
 199 LOW=DDT-NSYMS-1
 200
 201
 202
 203
 204
 205
 206
 207
 208
 209
 210 \f
 211
 212 DDT:    JSR SAVE
 213         PUSHJ P,REMOVB
 214         HLRZ T,ESTU
 215         SUB T,ESTU
 216         ADD T,@SYMP
 217         TRNE T,-1
 218         JRST IFIX
 219 DD1:    TLZ F,ROF               ;CLOSE ANY OPEN REGISTER
 220         PUSHJ P,CRF
 221 DD1.5:  MOVE T,[XWD SCHM,SCH]
 222         BLT T,ODF       ;LOAD ACS
 223 DD2:    CLEARM PRNC             ;PARENTHESES COUNT
 224         MOVEI P,PS
 225 LIS:    MOVE T,ESTU
 226         MOVEM T,ESTUT           ;INIT UNDEFINED SYM ASSEM
 227         TDZ F,[XWD 777777-ROF-STF,LF1+CF1+SBF+2+Q2F]
 228 LIS0:   TDZ F,[XWD 777777-ROF-STF-FAF-SAF,NAF]
 229         CLEARM,WRD
 230 LIS1:   CLEARM,FRASE
 231 LIS2:   MOVEI T,1
 232         MOVEM T,FRASE1
 233         TLZ F,MLF+DVF
 234 L1:     TLZ F,CF+CCF+SF+FPF             ;TURN OFF CONTROL, SYL, PERIOD FLAG
 235         CLEARM,SYL
 236 L1RPR:  CLEARM,SYM
 237         MOVEI T,6
 238         MOVEM T,TEM             ;INIT SYMBOL COUNTER
 239         CLEARM,DEN
 240         CLEARM,WRD2
 241
 242 L2:     PUSHJ P,TIN             ;PICK UP CHARACTER
 243         CAIL T,"A"+40           ;LOWER CASE A
 244         CAILE T,"Z"+40          ;LOWER CASE Z
 245         JRST .+2
 246         TRC T,40                ;CHANGE LOWER CASE TO UPPER CASE
 247         TLNE F,CF               ;CONTROL FLAG
 248         JRST L21
 249         CAIG T,"Z"              ;Z
 250         CAIGE T,"A"             ;A
 251         JRST .+2
 252         JRST LET
 253 L21:    MOVE R,T
 254         IDIVI R,3
 255         LDB W,BDISP(R+1)
 256         CAIGE W,MULT-DDT        ;FIRST EVAL ROUTINE
 257         JRST DDT(W)
 258 \f
 259 L211:   MOVE T,SYL
 260         TLZN F,LTF
 261         JRST POWER
 262         PUSHJ P,EVAL
 263         JRST UND1
 264 L4:     TLZE F,MF
 265         MOVN T,T
 266         TLNN F,SF
 267         CAIE W,LPRN-DDT
 268         JRST .+2
 269         JRST LPRN
 270
 271         EXCH T,FRASE1
 272         TLNN F,DVF
 273         IMULB T,FRASE1
 274         TLZE F,DVF
 275         IDIVB T,FRASE1
 276         CAIGE W,ASSEM-DDT
 277         JRST DDT(W)             ;MULTIPLY OR DIVIDE
 278         ADDB T,FRASE
 279         CAIGE W,SPACE-DDT
 280         JRST DDT(W)             ; + - @ ,
 281
 282         ADD T,WRD
 283         TLNE F,TIF              ;TRUNCATE INDICATOR FLAG
 284         HLL T,WRD               ;TRUNCATE
 285         MOVEM T,WRD
 286         TLNN F,QF
 287         MOVE T,LWT
 288         CLEARM,R
 289         MOVE W1,ESTUT
 290         CAMN W1,ESTU
 291         JRST L5
 292         CAILE W,CARR-DDT
 293         JRST ERR
 294 L5:     CAIG W,RPRN-DDT
 295         JRST DDT(W)
 296         PUSH P,KILRET
 297         SKIPN PRNC
 298         JRST DDT(W)
 299
 300 ERR:    MOVEI W1,"?"
 301         JRST WRONG1
 302 UNDEF:  MOVEI W1,"U"
 303         JRST WRONG1
 304 WRONG:  MOVE W1,[ASCII /XXX/]
 305 WRONG1: MOVEI P,PS
 306         PUSHJ P,TEXT
 307 IFN EDDT&1,<PUSHJ P,LISTEN
 308         JFCL>
 309 \fRET:   MOVEI P,PS
 310         PUSHJ P,LCT             ;COMMON RETURN FOR TAB;,JRST LIS
 311         JRST DD2
 312
 313 UND1:   MOVE R,ESTUT            ;UNDEFINED SYM ASSEMBLER
 314         HLRE S,ESTUT
 315         ASH S,-1                ;SETUP EVAL END TEST
 316         PUSHJ P,EVAL2
 317         CAIN W,ASSEM-DDT
 318         TLNN F,ROF
 319         JRST OPEVAL
 320         SKIPE PRNC
 321         JRST OPEVAL
 322         MOVEI T,"#"
 323         CAIE W,ASSEM-DDT
 324         PUSHJ P,TOUT
 325
 326         MOVN R,[XWD 2,2]
 327         ADDB R,ESTUT
 328         MOVE T,SYM
 329         TLO T,GLOBAL
 330         MOVEM T,(R)
 331         HRRZ T,LLOCO
 332         TLNE F,MF
 333         TLO T,400000
 334         MOVEM T,1(R)
 335         MOVEI T,0
 336         JRST L4
 337
 338 QUESTN: PUSHJ P,CRF             ;LIST UNDEFINED SYMBOLS
 339         MOVE R,ESTU
 340 QUEST1: JUMPGE R,DD1
 341         MOVE T, (R)
 342         SKIPA W1,ESTU
 343
 344 QUEST2: ADD W1,[XWD 2,2]
 345         CAME T,(W1)
 346         JRST QUEST2
 347
 348 QUEST3: CAME R,W1
 349         JRST QUEST4
 350         PUSHJ P,SPT
 351         PUSHJ P,CRF
 352 QUEST4: ADD R,[XWD 2,2]
 353         JRST QUEST1
 354 \f
 355 NUM:    ANDI T,17               ;T HOLDS CHARACTER
 356         TLNE F,CF+FPF
 357         JRST NM1
 358         MOVE W,SYL
 359         LSH W,3
 360         ADD W,T
 361         MOVEM W,SYL
 362         MOVE W,DEN
 363         IMULI W,12              ;CONVERT TO DECIMAL
 364         ADD W,T
 365         MOVEM W,DEN
 366 LE1:    AOJA T,LE1A
 367
 368 PERC:   MOVEI T,47+101-13       ;PERCENT SIGN
 369 LET:    TLC F,SF+FPF            ;EXPONENT IFF LTF'*FEF'*(T=105)*SF*FPF=1
 370         TLZN F,LTF+FEF+SF+FPF
 371         CAIE T,105              ; E
 372         TLOA F,LTF
 373         TLOA F,FEF
 374         JRST LET1
 375         TLZN F,MF
 376         SKIPA W1,SYL
 377         MOVN W1,SYL
 378         MOVEM W1,FSV
 379         CLEARM DEN
 380 LET1:   SUBI T,101-13           ;FORM RADIX 50 SYMBOL
 381 LE1A:   TLO F,SF+QF
 382 LE2:    MOVE W,SYM
 383         IMULI W,50              ;CONVERT TO RADIX 50
 384         ADD W,T
 385         SOSL,TEM                ;IGNORE CHARACS AFTER 6
 386         MOVEM W,SYM
 387         JRST L2
 388
 389 NUM1:   EXCH T,WRD2             ;FORM NUMBER AFTER $
 390         IMULI T,12
 391         ADDM T,WRD2
 392         TRO F,Q2F
 393         JRST L2
 394
 395 NM1:    TLNE F,CF
 396         JRST NUM1
 397         MOVEI W1,6              ;FORM FLOATING POINT NUMBER
 398         AOS NM1A
 399 NM1A:   MOVEI W2,0
 400         MOVSI R,201400
 401 NM1A1:  TRZE W2,1
 402         FMPR R,FT(W1)
 403         JUMPE W2,NM1B
 404         LSH W2,-1
 405         SOJG W1,NM1A1
 406 NM1B:   MOVSI W1,211000(T)
 407         FMPR    R,W1            ;COMPUTE VALUE OF NEW DIGIT
 408         FADRB   R,FH            ;ADD VALUE INTO FLOATING NO.
 409         MOVEM R,SYL
 410         AOJA T,LE1A
 411 \f
 412 POWER:  TLNN F,FEF
 413         JRST L4         ;NO EXPONENT
 414         CAIE W,PLUS
 415         CAIN W,MINUS
 416         TROE F,POWF
 417         TRZA F,POWF
 418         JRST (W)                ; E+-
 419
 420         MOVE W2,DEN
 421         CLEARM FRASE
 422         MOVEI W1,FT-1
 423         TLZE F,MF
 424         MOVEI W1,FT01
 425         SKIPA T,FSV
 426 POW2:   LSH W2,-1
 427         TRZE W2,1
 428         FMPR T,(W1)
 429         JUMPE W2,L4
 430         SOJA W1,POW2
 431 \f
 432
 433 PERIOD: MOVE T,LLOC
 434         TLNE F,SF               ;SYLLABLE STARTED
 435         MOVE T,DEN
 436         MOVEM T,SYL
 437         TLNE    F,FPF           ;HAS A PERIOD BEEN SEEN BEFORE?
 438         TLO     F,LTF           ;YES, TWO PERIODS MAKES A SYMBOL
 439         TLON F,FPF+SF+QF
 440         MOVEI T,0
 441         IDIVI T,400
 442         SKIPE T
 443         TLC T,243000
 444         TLC W1,233000
 445         FAD     T,[0]           ;NORMALIZE T AND W1
 446         FAD     W1,[0]
 447         FADR    T,W1
 448         MOVEM T,FH
 449         HLLZS NM1A
 450         MOVEI T,45              ;RADIX 50 PERIOD
 451         JRST LE2
 452
 453 QUAN:   SKIPA T,LWT             ;LAST QUANTITY TYPED
 454 PILOC:  MOVEI T, SAVPI
 455 QUAN1:  MOVEM T,SYL
 456 QUAN2:  TLO F,SF+QF             ;WRD,SYL STARTED
 457         TLZ F,CF+CCF
 458         JRST L2
 459
 460 CONTRO:                         ;SOME KIND OF ALTMODE
 461 IFN EDDT&1,<    MOVEI T,"$"     ;$
 462         PUSHJ P,TOUT            ;TYPE OUT $
 463 >
 464 DOLLAR: TLOE F,CF
 465         TLO F,CCF
 466         JRST L2
 467
 468 \f
 469 EVAL:   MOVE R,PRGM             ;LOOK UP SYMBOL
 470 EVAL0:  HRLOI W1,37777+DELI
 471         HLRE S,@SYMP
 472         ASH S,-1        ;SETUP END TEST
 473         JRST EVAL3
 474
 475 EVAL1:  ADD R,[XWD 2,2]
 476 EVAL2:  SKIPL R
 477         MOVE R,@SYMP
 478         AOJG S,CPOPJ            ;TRNASFER IF NO SYMBOL FOUND
 479 EVAL3:  MOVE T,(R)
 480         XOR T,SYM
 481         TLNN T,PNAME
 482         TLOA W1,LOCAL
 483         TDNE T,W1
 484         JRST EVAL1
 485         TLNN T,340000
 486         JRST EVAL1
 487         MOVE T,1(R)
 488 CPOPJ1: AOS (P)         ;FOUND SYMBOL, SKIP
 489 CPOPJ:  POPJ P,
 490
 491 ;BIT 40 - DELETE OUTPUT
 492 ; 20 - DELETE INPUT
 493 ; 10 - LOCAL
 494 ; 04 -GLOBAL
 495 ; NO BITS - PROGRAM NAME
 496
 497 TEXI:   PUSHJ P,TEXIN           ;INPUT TEXT
 498         MOVEM T,SYL
 499         MOVEI W1,5
 500         MOVEI T-1,0
 501         PUSHJ P,TEXIN
 502         CAIN T,33               ;NEW ALT MODE, ESCAPE
 503         JRST QUAN2
 504         TLNE F,CF
 505         JRST SIXBIN
 506         SKIPA
 507 TEXI2:  PUSHJ P,TEXIN
 508         CAMN T,SYL
 509         SOJA W1,TEXI3
 510         ROT T,-7
 511         LSHC T-1,7
 512         SOJA W1,TEXI2
 513
 514 TEXI3:  LSHC T-1,-43
 515         JUMPL W1,QUAN1
 516         LSH T,7
 517         SOJA W1,.-2
 518
 519 \fSIXBI1:        PUSHJ P,TEXIN    ; INPUT TEXT (SIXBIT)
 520 SIXBIN: CAMN T,SYL
 521         JRST SIXBI2
 522         ANDI T,77
 523         TRC T,40
 524         ROT T,-6
 525         LSHC T-1,6
 526         SOJA W1,SIXBI1
 527 SIXBI2: MOVE T,T-1
 528         JUMPL W1,QUAN1
 529         LSH T,6
 530         SOJA W1,.-2
 531
 532 KILL:   TLNN F,LTF              ;DELETE SYMBOLS
 533         JRST KILLA
 534         PUSHJ P,EVAL
 535         JRST KILL1
 536         MOVEI T,DELO/200000             ;DELETE OUTPUT
 537         TLNE F,CCF
 538         MOVEI T,DELI/200000             ;NO INPUT OR OUTPUT
 539         DPB T,[POINT 2,(R),1]   ;LEFT 2 BITS IN SYMBOL
 540 KILRET: JRST RET                ;USED AS A CONSTANT
 541
 542 KILLA:  TLNN F,QF
 543         TLNN F,CCF
 544         JRST ERR
 545         MOVE R,KILC
 546         MOVEM R,@SYMP           ;RESTORE INIT SYMS
 547         HRRZM R,ESTU
 548         MOVEM R,PRGM
 549         HRLZI T,DELO+DELI
 550         ANDCAM T,(R)            ;GET RID OF DELETE BITS IN INITIAL TABLE
 551         AOBJN R,.+1
 552         AOBJN R,.-2
 553         JRST RET
 554
 555 KILL1:  MOVE R,ESTU             ;REMOVE UNDEFINED SYMS
 556         JUMPGE R,UNDEF
 557 KILL2:  PUSHJ P,EVAL0
 558         JRST RET
 559         PUSHJ P,REMUN
 560         JRST KILL2
 561
 562 REMUN:  MOVE S,[XWD 2,2]        ;REMOVE ONE UNDEFINED SYMBOL
 563         ADDB S,ESTU
 564         MOVE W,-2(S)
 565         MOVEM W,(R)
 566         MOVE W,-1(S)
 567         MOVEM W,1(R)
 568         POPJ P,
 569
 570 \f
 571 TAG:    TLNN F,LTF   ; NO LETTERS IS ERROR
 572         JRST ERR   ; GO SAY ERROR
 573         TLNE F,FAF   ; DEFINE SYMBOLS
 574         JRST DEFIN              ;A<B:
 575         TLNE F,CF               ;DEFINE SYMBOL AS OPEN REGISTER
 576         JRST SETNAM
 577         MOVE W,LLOCO
 578         HRRZM W,DEFV
 579
 580 DEFIN:  PUSHJ P,EVAL
 581         JRST DEF1
 582         CAMGE R,KILC            ;INITIAL SYMBOL?
 583         JRST DEF2               ;NO, REDEFINE
 584         MOVEI T,DELI/200000     ;YES, DELETE AND DEFINE NEW ONE
 585         DPB T,[POINT 2,(R),1]   ;LEFT 2 BITS OF SYMBOL\r
 586 DEF1:   MOVN R,[XWD 2,2]
 587         ADDB R,@SYMP    ;MOVE UNDEFINED TABLE 2 REGISTERS
 588         HRRZ T,ESTU
 589         SUBI T,2
 590         HRL T,ESTU
 591         HRRM T,ESTU
 592         SKIPGE ESTU
 593         BLT T,-1(R)
 594 DEF2:   MOVE T,DEFV
 595         MOVEM T,1(R)            ;PUT IN NEW VALUE
 596         MOVSI T,GLOBAL
 597         IORB T,SYM
 598         MOVEM T,(R)             ;PUT IN NEW SYM AS GLOBAL
 599         MOVE R,ESTU
 600
 601 DEF3:   JUMPGE R,RET            ;PATCH IN VALUE FOR UNDEF SYM ENTRY
 602         MOVE T,SYM
 603         CAME T,(R)
 604         JRST DEF4
 605         MOVE S,DEFV
 606         SKIPGE, 1(R)
 607         MOVN S,S
 608         PUSH P,R
 609         MOVE R,1(R)
 610         PUSHJ P,FETCH
 611         JRST ERR
 612         ADD S,T
 613         HRRM S,T
 614         PUSHJ P,DEP
 615         POP P,R
 616         PUSHJ P,REMUN
 617 DEF4:   ADD R,[XWD 2,2]         ;REMOVE THE NOW DEFINED SYMBOL
 618         JRST DEF3
 619 \f
 620 SETNAM: MOVE R,@SYMP            ;SET PROGRAM NAME - DOLLAR COLON
 621 SET1:   MOVE W,R
 622 SET2:   JUMPGE R,UNDEF
 623         MOVE T,(R)
 624         ADD R,[XWD 2,2]
 625         TLNE T,PNAME
 626         JRST SET2
 627         CAME T,SYM
 628         JRST SET1
 629         MOVEM W,PRGM
 630         JRST RET
 631
 632 MULT:   TLOA F,PTF+MLF          ;*
 633 DIVD:   TLO F,DVF+PTF           ;SINGLE QUOTE
 634         JRST L1
 635
 636 ASSEM:  JRST PLUS               ;#
 637 MINUS:  TLO F,MF
 638 PLUS:   TLO F,PTF
 639         JRST LIS2
 640
 641 LPRN:   CAML P,[XWD LPDL-4,0]   ;LEFT PARENTHESIS
 642         JRST ERR
 643         PUSH P,F                ;RECURSE FOR OPEN PAREN
 644         PUSH P,WRD
 645         PUSH P,FRASE
 646         PUSH P,FRASE1
 647         AOS,PRNC
 648         JRST LIS
 649
 650 INDIRECT:       HRLZI W,20              ;@
 651         IORB W,WRD
 652         TLO F,QF
 653         JRST LIS2
 654
 655 ACCF:   MOVE R,T                ;COMMA
 656         HLLZS T
 657         LDB W1,[POINT 3,WRD,2]  ;CHECK FOR IO INSTRUCTION
 658         IDIVI W1,7
 659         LSH R,27(W1)
 660         ADD T,R
 661         ADDB T,WRD
 662         JRST SPACE+1
 663
 664 SPACE:  TLNE F,QF
 665         TLO F,TIF
 666 SPAC1:  TLZ F,MF+PTF
 667         JRST LIS1
 668 \f
 669 RPRN:   TLNN F,QF               ;)
 670         MOVEI T,0
 671         MOVS T,T
 672         SOSGE,PRNC
 673         JRST ERR
 674         POP P,FRASE1
 675         POP P,FRASE
 676         POP P,WRD
 677         POP P,F
 678         TLNE F,PTF
 679         TLNE F,SF
 680         JRST RPRN1
 681         MOVEM T,SYL
 682         TLO F,QF+SF
 683         JRST L1RPR
 684 RPRN1:  ADDB T,WRD
 685         TLO F,QF
 686         JRST L1RPR-1
 687 \f
 688 ;REGISTER EXAMINATION LOGIC
 689
 690 LINEF:  PUSHJ P,DEPRA   ;NEXT REGISTER
 691 IFE EDDT&1,<PUSHJ P,CRNRB
 692         JRST .+2>
 693 LI0:    PUSHJ P,CRF
 694         AOS T,LLOC
 695 LI1:    HRRZM T,LLOC
 696         HRRZM T,LLOCO
 697         PUSHJ P,PAD
 698         MOVEI T,"/"
 699         TLNE F,STF
 700         MOVEI T,"!"
 701         PUSHJ P,TOUT
 702 LI2:    TLZ F,ROF
 703         PUSHJ P,LCT
 704         MOVE R,LLOCO
 705         PUSHJ P,FETCH
 706         JRST ERR
 707         TLO F,ROF
 708         TLNE F,STF
 709         JRST DD2
 710         JRST CONSYM             ;RETURN IS A POPJ
 711
 712 VARRW:  PUSHJ P,DEPRA           ;^
 713         PUSHJ P,CRF
 714         SOS T,LLOC
 715         JRST LI1
 716
 717 CARR:   PUSHJ P,DEPRA           ;CLOSE REGISTER
 718         IFN EDDT&1,<JRST DD1>
 719         IFE EDDT&1,<    PUSHJ P,TIN
 720         CAIN T,15
 721         JRST .-2
 722         JRST DD1.5>
 723
 724 OCON:   TROA F,LF1+CF1          ;OPEN AS CONSTANT
 725 OSYM:   TRZ F,CF1               ;OPEN SYMBOLICALLY
 726         TROA F,LF1
 727 SUPTYO: TLOA F,STF              ;SUPPRESS TYPEOUT
 728 SLASH:  TLZ F,STF               ;TYPE OUT REGISTER
 729         TLNE F,QF
 730         HRRZM T,LLOC            ;QUANTITY TYPED
 731 SLAS1:  HRRZM T,LLOCO
 732         JRST LI2
 733
 734 ICON:   TLNN F,ROF      ;REGISTER OPENED OR ERR
 735         JRST ERR
 736         PUSHJ P,DEPRS
 737         JRST SLAS1
 738
 739 \f
 740 TAB:    PUSHJ P,DEPRS   ;OPEN REGISTER OF Q
 741         MOVEI T,-1(T)
 742         MOVEM T,LLOC
 743         HRROI T,700000  ;3 RUBOUTS
 744         PUSHJ P,TEXTT
 745         JRST LI0
 746
 747 DEPRA:  TLNE F,ROF              ;IF REGISTER IS BEING CHANGED
 748         TLNN F,QF               ;REMOVE ALL PREVIOUS UNDEFINED
 749         JRST DEPRS              ;SYMBOL REFERENCES TO IT
 750         MOVE R,ESTU
 751         MOVEM W1,ESTU
 752 DEPRA2: JUMPGE R,DEPRS
 753         HRRZ W,1(R)
 754         CAMN W,LLOCO
 755         PUSHJ P,REMUN
 756         ADD R,[XWD 2,2]
 757         JRST DEPRA2
 758
 759 EQUAL:  TROA F,LF1+CF1          ;=
 760 PSYM:   TRZ F,CF1               ;@
 761         TRO F,LF1
 762         PUSHJ P,CONSYM
 763         JRST RET
 764
 765 R50PNT: LSH T,-36       ;RADIX 50 SYMBOL PRINTER
 766         TRZ T,3
 767         PUSHJ P,TOC
 768         PUSHJ P,TSPC
 769         MOVEI W1,LWT    ;SETUP FOR SPT
 770         JRST SPT
 771
 772 SIXBP:  MOVNI W2,6              ;SIXBIT PRINTER
 773         MOVE W1,LWT
 774 SIXBP1: MOVEI T,0
 775         ROTC T,6
 776         ADDI T,40
 777         PUSHJ P,TOUT
 778         AOJL W2,SIXBP1
 779         POPJ P,
 780 \f
 781 ;MODE CONTROL SWITCHES
 782
 783 TEXO:   MOVEI R,TEXTT-HLFW      ;$T ASSUME 7 BIT ASCII
 784         MOVE T,WRD2
 785         CAIN T,6                ;CHECK FOR $6T
 786         MOVEI R,SIXBP-HLFW      ;SET MODE SWITCH FOR SIXBIT
 787         CAIN T,5                ;CHECK FOR $5T
 788         MOVEI R,R50PNT-HLFW     ;SET MODE SWITCH FOR RADIX 50
 789 HWRDS:  ADDI R,HLFW-TFLOT               ;H
 790 SFLOT:  ADDI R,TFLOT-PIN                ;F
 791 SYMBOL: ADDI R,PIN-FTOC         ;S
 792 CON:    ADDI R,FTOC             ;C
 793         HRRZM R,SCH
 794         JRST BASE1
 795
 796 RELA:   TRZE F,Q2F              ;CHANGE ADDRESS MODE TO RELATIE
 797         JRST BASECH
 798         MOVEI R,PADSO-TOC
 799 ABSA:   ADDI R,TOC              ;A
 800         HRRZM R,AR
 801         JRST BASE1
 802
 803 BASECH: MOVE T,WRD2             ;$NR  CHANGE OUTPUT RADIX TO N, N>1
 804         CAIGE T,2
 805         JRST ERR
 806         HRRZM T,ODF
 807 BASE1:  MOVS S,[XWD SCHM,SCH]
 808         TLNN F,CCF
 809         JRST LIS1
 810         BLT S,ODFM      ;WITH $$, MAKE MODES PERMANENT
 811         JRST RET
 812
 813 SEMIC:  MOVEM T,LWT             ;SEMICOLON TYPES IN CURRENT MODE
 814         JRST @SCH
 815 \f;GO AND EXECUTE LOGIC
 816
 817 GO:     HRLI T,254000             ;G
 818         TLOE F,QF
 819         JRST XEC0
 820         IFN EDDT&1,<    SKIPE T,STARTA> ;LOAD TAPE START ADDRESS
 821         IFE EDDT&1,<    HRR T,JOBSA>    ;GET STARTING ADDRESS
 822
 823 XEC:    TLNN F,QF               ;X
 824         JRST ,ERR
 825 XEC0:   MOVEM T,TEM
 826         PUSHJ P,CRF
 827         PUSHJ P,TTYLEV
 828         PUSHJ P,INSRTB
 829         JSP T,RESTORE
 830         XCT,TEM
 831 XEC1:   JRST DDT                ;USED  AT PROC0
 832         JSR,SAVE
 833         PUSHJ P,REMOVB
 834         PUSHJ P,CRF
 835         JRST DD1
 836
 837 \f;BREAK POINT LOGIC
 838 BP1:    REPEAT NBP,<    0               ;JSR TO HERE FOR BREAKPOINT
 839         JSA T, BCOM
 840         0               ;HOLDS INSTRUCTION WHILE BREAKPOINT IS IN PLACE
 841 >
 842
 843 B1INS=BP1+2
 844 BPN=.-3
 845 \f
 846 BCOM:   0
 847         POP T,LEAV              ;MOVE INSTRUCTION TO LEAV
 848         MOVEI T,B1SKP-B1INS+1(T)
 849         HRRM T,BCOM3            ;CONDITIONAL BREAK SETUP
 850         MOVEI T,B1CNT-B1SKP(T)
 851         HRRM T,BCOM2            ;PROCEDE COUNTER SETUP
 852         MOVE T,BP1-B1CNT(T)
 853 IFN EDDT&1,<    TLZ T,010000            ;TURN OFF USER MODE BIT>
 854         HLLM T,LEAV1            ;SAVE FLAGS FOR RESTORING
 855         EXCH T,BCOM
 856
 857 BCOM3:  SKIPE B1SKP             ;ADDR MOD TO LOOK AT COND. INST.
 858         XCT @.-1
 859 BCOM2:  SOSG B1CNT              ;ADDR MOD TO LOOK AT PROCEED COUNTER
 860         JRST BREAK
 861
 862         MOVEM T,AC0+T
 863         LDB T,[POINT 9,LEAV,8]  ;GET INSTRUCTION
 864         CAIL T,264      ;JSR
 865         CAILE T,266     ;JSA,JSP
 866         TRNN T,700      ;UUO
 867         JRST PROC1              ;MUST BE INTERPRETED
 868         CAIE T,260      ;PUSHJ
 869         CAIN T,256      ;XCT
 870         JRST PROC1              ;MUST BE INTERPRETED
 871         MOVE T,AC0+T
 872         JRST 2,@LEAV1           ;RESTORE FLAGS, GO TO LEAV
 873
 874 LEAV1:  XWD 0,LEAV
 875 \fBREAK: JSR SAVE                ;SAVE THE WORLD
 876         PUSHJ P,REMOVB          ;REMOVE BREAKPOINTS
 877         SOS T,BCOM3
 878         HRRZS T                 ;GET ADDR OF BREAKPOINT JUST HIT
 879         PUSHJ P,PADSO           ;PRINT ITS NAME- $NB
 880         MOVSI W1,(ASCII />/)            ;TYPE > FOR COND BREAK
 881         SKIPG @BCOM2            ;TEST PROCEED COUNTER
 882         MOVSI W1,(ASCII />>/)   ;TYPE >> FOR PROCEED COUNTER BREAK
 883         PUSHJ P,TEXT2
 884         MOVE T,BCOM
 885         HLLM T, SAVPI           ;SAVE PROCESSOR FLAGS
 886         MOVEI T,-1(T)
 887         PUSHJ P,PAD             ;TYPE PC AT BREAK
 888         HRRZ T,@BCOM3
 889         HRRM T,PROC0            ;SETUP ADDRESS OF BREAK
 890         HLRZ T,@BCOM3
 891         JUMPE T,BREAK1          ;TEST FOR REGISTER TO EXAMINE
 892         PUSHJ P,LCT             ;PRINT TAB
 893         HLRZ T,@BCOM3
 894         PUSHJ P,LI1             ;EXAMINE REGISTER C($NB)LEFT
 895 BREAK1: HRRZ R,BCOM3
 896         SUBI R,B1ADR
 897         IDIVI R,3               ;GET BREAKPOINT NUMBER-1 INTO R
 898         MOVEI S,1
 899         LSH S,(R)
 900         PUSHJ P,LISTEN          ;DONT PROCEED IF TTY KEY HIT
 901         TDNN S,AUTOPI           ;DONT PROCEED IF NOT AUTOMATIC
 902         JRST RET                ;DONT PROCEED
 903         JRST PROCD1
 904
 905 PROCEDE: TLNN F,QF              ;N$P    ;PROCEED AT A BREAKPOINT
 906         MOVEI T,1
 907         MOVEM T,@BCOM2
 908         HRRZ R,BCOM3
 909         PUSHJ P,AUTOP
 910 PROCD1: PUSHJ P,CRF
 911         PUSHJ P,TTYLEV
 912 PROC0:  HRRZI R,XEC1            ;MODIFIED TO ADDR OF BREAKPOINT
 913         PUSHJ P,FETCH
 914         JRST BPLUP1             ;ONLY GET HERE IF MEMORY SHRANK
 915         MOVEM T,LEAV
 916         PUSHJ P,INSRTB
 917         JRST PROC2
 918
 919 PROC1:  MOVE T,AC0+T
 920         JSR SAVE
 921         JFCL
 922 PROC2:  MOVEI W,100
 923         MOVEM W,TEM1            ;SETUP MAX LOOP COUNT
 924         JRST IXCT5
 925 \fIXCT4: IFE EDDT&1,<    SUBI T,041
 926         JUMPE T,BPLUP
 927         AOJGE T,IXCT6>                          ;DONT PROCEDE FOR INIT
 928                                 ;DONT INTERPRET FOR SYSTEM UUOS
 929         MOVEM R,40              ;INTERPRET FOR NON-SYSTEM UUOS
 930         MOVEI R,41
 931 IXCT:   SOSL TEM1
 932         PUSHJ P,FETCH
 933         JRST BPLUP              ;BREAKPOINT LOOPING OR FETCH FAILED
 934         MOVEM T,LEAV
 935 IXCT5:  IFN EDDT&1,<
 936         LDB T,[POINT 9,LEAV,8]  ;GET INSTRUCTION
 937         CAIN T,254              ;DON'T DO ANYTHING TO JRST IN EXEC MODE
 938         JRST IXCT6>
 939         HRLZI 17,AC0
 940         BLT 17,17
 941         MOVEI T,@LEAV
 942         DPB T,[POINT 23,LEAV,35]        ;STORE EFFECTIVE ADDRESS
 943         LDB W1,[POINT 4,LEAV,12]        ;PICK UP AC FIELD
 944         LDB T,[POINT 9,LEAV,8]          ;PICK UP INSTRUCTION FIELD
 945         MOVEI P,PS
 946         CAIN T,260
 947         JRST  IPUSHJ            ;INTERPRET PUSHJ
 948
 949         CAIN T,264
 950         JRST IJSR               ;INTERPRET JSR
 951         CAIN T,265
 952         JRST IJSP               ;INTERPRET JSP
 953         CAIN T,266
 954         JRST IJSA               ;INTERPRET JSA
 955         MOVE R,LEAV
 956         TRNN T,700
 957         JRST IXCT4              ;INTERPRET UUO
 958         CAIN T,256
 959         JRST IXCT               ;INTERPRET XCT
 960
 961 IXCT6:  JSP T,RESTORE
 962 LEAV:   0                       ;INSTRUCTION MODIFIED
 963         JRST @BCOM
 964         AOS BCOM
 965         JRST @BCOM
 966
 967 BPLUP:  PUSHJ P,REMOVB          ;BREAKPOINT PROCEED ERROR
 968 BPLUP1: JSR SAVE
 969         JFCL
 970         JRST ERR
 971 \f
 972 IPUSHJ: DPB W1,[POINT 4,CPUSHP,12]      ;STORE AC FIELD INTO A PUSH
 973         CLEARM,TEM3
 974         MOVE T,LEAV
 975         JRST RESTR1
 976
 977 IJSA:   MOVE T,BCOM             ;INTERPRET JSA
 978         HRL T,LEAV
 979         EXCH T,AC0(W1)
 980         JRST IJSR2
 981
 982 IJSR:   MOVE T,BCOM             ;INTERPRET JSR
 983         HLL T,SAVPI
 984 IJSR2:  MOVE R,LEAV
 985         PUSHJ P,DEP
 986         AOSA T,LEAV
 987 IJSR3:  MOVE T,LEAV
 988         JRST RESTORE
 989
 990 IJSP:   MOVE W,BCOM             ;INTERPRET JSP
 991         HLL T,SAVPI
 992         MOVEM W,AC0(W1)
 993         JRST IJSR3
 994
 995 ;INSERT BREAKPOINTS
 996
 997 INSRTB: MOVE S,[JSR BP1]
 998 INSRT1: SKIPE R,B1ADR-BP1(S)
 999         PUSHJ P,FETCH
1000         JRST INSRT3
1001         MOVEM T,B1INS-BP1(S)
1002         MOVE T,S
1003         PUSHJ P,DEP
1004 INSRT3: ADDI S,3
1005         CAMG S,[JSR BPN]
1006         JRST INSRT1
1007         POPJ P,
1008
1009 ;REMOVE BREAKPOINTS
1010
1011 REMOVB: MOVEI S,BNADR
1012 REMOV1: MOVE T,B1INS-B1ADR(S)
1013         SKIPE R,(S)
1014         PUSHJ P,DEP
1015 REMOV3: SUBI S,3
1016         CAIL S,B1ADR
1017         JRST REMOV1
1018         IFN EDDT&1,<JRST TTYRET>
1019         IFE EDDT&1,<POPJ P,>
1020
1021 ;IN EXEC MODE, SAVE UP TTY STATUS
1022 ;IN USER MODE, DONE BY SAVE
1023 \f
1024 ;ALL $B COMMANDS GET HERE IN FORM: <A>$<N>B
1025
1026
1027 BPS:    TLZE F,QF               ;HAS <A> BEEN TYPED?
1028         JRST BPS1               ;YES
1029         TRZE F,Q2F              ;NO, HAS <N> BEEN TYPED?
1030         JRST BPS2               ;YES
1031         MOVE T,[XWD B1ADR,B1ADR+1]      ;NO, COMMAND IS $B - CLEAR ALL BREAKPOINTS
1032         CLEARM B1ADR
1033         BLT T,AUTOPI            ;CLEAR OUT ALL BREAKPOINTS AND AUTO PROCEDE REGESTER
1034         JRST RET
1035
1036 BPS1:   TRZN F,Q2F              ;HAS <N> BEEN TYPED?
1037         JRST BPS3               ;NO
1038         MOVE R,T                ;YES, PROCESS THE COMMAND A$NB
1039         TRO F,2
1040 BPS2:   MOVE T,WRD2
1041         CAIL T,1
1042         CAILE T,NBP
1043         JRST ERR
1044         IMULI T,3
1045         ADDI T,B1ADR-3
1046         TRZN F,2
1047         JRST MASK2
1048         EXCH R,T
1049         JRST BPS5
1050
1051 BPS3:   MOVEI R,B1ADR           ;PROCESS THE COMMAND A$B
1052 BPS4:   HRRZ W,(R)
1053         CAIE W,(T)
1054         SKIPN (R)
1055         JRST BPS5
1056         ADDI R,3
1057         CAIG R,BNADR
1058         JRST BPS4
1059         JRST ERR
1060 BPS5:   MOVEM T,(R)
1061         CLEARM,1(R)
1062         CLEARM,2(R)
1063
1064 AUTOP:  SUBI R,B1ADR            ;AUTO PROCEDE SETUP SUBROUTINE
1065         IDIVI R,3
1066         MOVEI S,1
1067         LSH S,(R)
1068         ANDCAM S,AUTOPI
1069         TLNE F,CCF
1070         IORM S,AUTOPI
1071         POPJ P,
1072
1073 \f;FETCH AND DEPOSIT INTO MEMORY
1074
1075
1076 DEPRS:  MOVEM T,LWT             ;DEPOSIT REGISTER AND SAVE AS LWT
1077 DEPR:   MOVE R,LLOCO    ;QUAN TYPED IN REGIS EXAM
1078         TLZE F,ROF
1079         TLNN F,QF
1080         POPJ P,0
1081 DEP:    TRNN R,777760
1082         JRST DEP1
1083 IFE EDDT&1,<    HRRZ W,JOBREL
1084         CAIL W,(R)>
1085
1086         MOVEM T,0(R)
1087         POPJ P,0
1088 DEP1:   MOVEM T,AC0(R)
1089         POPJ P,0
1090
1091 FETCH:  IFE EDDT&1,<HRRZ T,JOBREL
1092         CAIGE T,(R)
1093         POPJ P,>
1094         TRNN R,777760
1095         SKIPA T,AC0(R)
1096         MOVE T,(R)
1097         JRST CPOPJ1
1098 \fFIRARG:        MOVEM T,DEFV
1099         TLO F,FAF
1100         JRST ULIM1
1101 ULIM:   TLO F,SAF
1102         HRRZM T,ULIMIT
1103 ULIM1:  TLNN F,QF
1104         JRST ERR
1105         JRST LIS0
1106
1107
1108 LOOK:   SKIPL R,PRGM    ;LOOK UP SYMBOL
1109         MOVE R,@SYMP
1110         HLRE S,@SYMP
1111         ASH S,-1        ;SETUP COUNT FOR LENGTH OF SYM TABLE
1112         TLZ F,400000
1113         HRLZI W2,DELO+DELI
1114         MOVEM T,TEM
1115
1116 LOOK1:  TDNE W2,(R)
1117         JRST LOOK3
1118         MOVE T,(R)
1119         TLNN T,PNAME    ;NAME
1120         TLOA W2,LOCAL
1121         SKIPA T,TEM
1122         JRST LOOK3
1123         MOVE W,1(R)
1124         XOR W,T
1125         JUMPL W,LOOK3
1126         SUB T,1(R)
1127         JUMPL T,LOOK3
1128         JUMPGE F,LOOK2
1129         MOVE W,1(R)
1130         SUB W,1(W1)
1131         JUMPLE W,LOOK3
1132 LOOK2:  HRR W1,R                ;POINTER BEST VALUE SO FAR
1133         TLO F,400000
1134         JUMPE T,SPT0
1135 LOOK3:  ADD R,[XWD 2,2]
1136         SKIPL R
1137         MOVE R, @SYMP
1138         AOJLE S,LOOK1   ;TERMINATING CONDITION
1139         MOVE T,TEM
1140         TLNE F,400000
1141         SUB T,1(W1)
1142         JRST CPOPJ1
1143 \f
1144 CONSYM: MOVEM T,LWT
1145 CONSM:  TRNN F,LF1
1146 CONS1:  JRST @SCH               ;PIN OR FTOC
1147         TRNE F,CF1
1148         JRST  FTOC
1149
1150 PIN:                            ;PRINT INSTRUCTION
1151         TLC T,700000
1152         TLCN T,700000
1153         JRST INOUT              ;IN-OUT INSTRUCTION OR NEG NUM
1154         AND T,[XWD 777000,0]
1155         JUMPE T,PI3
1156         PUSHJ P,OPTYPE
1157         MOVSI   T,777000
1158         AND     T,LWT
1159         TRNN F,ITF              ;HAS INSTRUCTION BEEN TYPED?
1160         PUSHJ P,LOOK            ;NO, LOOK IN SYMBOL TABLE
1161         TROA F,NAF              ;INSTRUCTION TYPED, ALOOW NEG ADDRESSES
1162         JRST HLFW               ;NOT FOUND, OUTPUT AS HALFWORDS
1163         PUSHJ P,TSPC
1164 PI3:    LDB T,[XWD 270400,LWT]  ;GET AC FIELD
1165         JUMPE T,PI4
1166         PUSHJ P,PAD
1167 PI3A:   MOVEI W1,","
1168 PI3B:   PUSHJ P,TEXT
1169 PI4:    MOVE W1,LWT
1170         MOVEI T,"@"
1171         TLNE W1,20              ;CHECK FOR INDIRECT BIT
1172         PUSHJ P,TOUT
1173 PI5:    HRRZ T,LWT
1174         LDB W1,[XWD 331100,LWT] ;INSTRUCTION BITS
1175         CAIL W1,240
1176         CAILE W1,247
1177         JRST PI8
1178         PUSHJ P,PADS3A
1179 PI7:    TRZ F,NAF
1180         LDB R,[XWD 220400,LWT]  ;INDEX REGISTER CHECK
1181         JUMPE R,PADS1           ;EXIT
1182         MOVEI T,"("
1183         PUSHJ P,TOUT
1184         MOVE T,R
1185 PI7.1:  PUSHJ P,PAD
1186         MOVEI T,")"
1187         JRST TOUT               ;EXIT
1188
1189 PI8:    PUSHJ P,PAD
1190         JRST PI7
1191
1192 \f
1193 HLFW:   MOVEI T,"("             ;PRINT AS HALF WORDS
1194         PUSHJ P,TOUT
1195         HLRZ T,LWT
1196         PUSHJ P,PI7.1
1197         HRRZ T,LWT
1198
1199 PAD:    ANDI T,777777           ;PRINT ADDRESS
1200         JRST @AR                ;PADSO OR PAD1
1201 PADSO:  JUMPE T,TOC2+1
1202         PUSHJ P,LOOK
1203 PADS1:  POPJ P,0
1204         MOVE W2,1(W1)
1205         CAIGE T,100
1206         CAIGE W2,60
1207         JRST PADS3
1208         MOVEM T,TEM
1209         JUMPGE F,PAD1
1210         PUSHJ P,SPT0
1211         MOVEI T,"+"
1212 PADS1A: PUSHJ P,TOUT
1213 PADS2:  HRRZ T,TEM
1214 PAD1:   JRST TOC                ;EXIT
1215
1216 PADS3:  MOVE T,TEM
1217 PADS3A: TRNE F,NAF
1218         CAIGE T,776000
1219         JRST TOC
1220 PADS3B: MOVNM T,TEM
1221 PADS4:  MOVEI T,"-"
1222         JRST PADS1A
1223
1224 INOUT:  TDC T,[XWD -1,400000]   ;IO INSTRUCTION OR NEG NUM
1225         TDCN T,[XWD -1,400000]
1226         JRST PADS3B             ;TYPE AS NEG NUM
1227         LDB R,[POINT 3,T,12]
1228         DPB R,[POINT 6,T,8]     ;MOVE IO BITS OVER FOR OP DECODER
1229         PUSHJ P,OPTYPE
1230         PUSHJ P,TSPC
1231         MOVSI T,077400
1232         AND T,LWT
1233         JUMPE T,PI4
1234         PUSHJ P,LOOK            ;LOOK FOR DEVICE NUMBER
1235         JRST PI3A
1236         MOVE T,TEM
1237         LSH T,-30
1238         PUSHJ P,TOC
1239         JRST PI3A
1240 \f
1241 MASK:   TLNE F,QF
1242         JRST MASK1
1243         MOVEI T,MSK
1244 MASK2:  MOVEI W,1
1245         MOVEM W,FRASE1
1246         JRST QUAN1
1247 MASK1:  MOVEM T,MSK
1248         JRST RET
1249
1250 EFFEC:  TLO F,LTF
1251         HRRZ T,T
1252 WORD:   MOVEI R,322000-326000   ;JUMPE-JUMPN
1253 NWORD:  ADDI R,326000+40*T      ;JUMPN T,
1254         HRLM R,SEAR2
1255
1256 SEARC:  TLZN F,QF
1257         JRST ERR
1258         SETCAM T,WRD
1259         MOVSI T,FRASE-DEN-1             ;PREVENT TYPE OUT OF DDT PARTS
1260         SETCMM FRASE(T)
1261         AOBJN T,.-1
1262         MOVE T,ULIMIT
1263         TLNE F,SAF
1264         TLO F,1
1265         PUSHJ P,SETUP1
1266         PUSHJ P,CRF
1267 SEAR1:  PUSHJ P,FETCH
1268         JRST SEAR2A
1269         TLNE F,LTF      ;CHECK FOR EFFECTIVE ADDRESS SEARCH
1270         JRST EFFEC0
1271         EQV T,WRD
1272         AND T,MSK
1273 SEAR2:  JUMPE T,SEAR3           ;OR JUMPN T
1274 SEAR2A: PUSHJ P,LISTEN  ;QUIT ON TELETYPE
1275         AOBJN R,SEAR1
1276         SETCMM LWT
1277         JRST DD1
1278 \fSEAR3: PUSHJ P,FETCH
1279         JRST ERR
1280         MOVEM T,LWT
1281         MOVEM R,TEM2
1282         MOVEM R,T
1283         HRRZM R,LLOC
1284         HRRZM R,LLOCO
1285         PUSHJ P,PAD
1286         MOVEI T,"/"
1287         PUSHJ P,TOUT
1288         PUSHJ P,LCT
1289         MOVE T,LWT
1290         PUSHJ P,CONSYM
1291         PUSHJ P,CRF
1292         SETCMM LWT
1293         SETCMM TEM
1294 SEAR4:  MOVE R,TEM2
1295         JRST  SEAR2A
1296
1297 EFFEC0: MOVEM R,TEM2
1298         MOVEI W,100
1299         MOVEM W,TEM
1300 EFFEC1: MOVE W,T
1301         LDB R,[POINT 4,T,17]    ;GET IR FIELD
1302         JUMPE R,EFFEC2
1303         HRRZ T,AC0(R)
1304         ADD T,W
1305 EFFEC2: HRR R,T
1306         TLNN W,20               ;INDIRECT BIT CHECK
1307         JRST EFFEC3
1308         SOSE,TEM
1309         PUSHJ P,FETCH
1310         JRST SEAR4
1311         JRST EFFEC1
1312 EFFEC3: MOVE R,TEM2
1313         EQV T,WRD
1314         ANDI T,777777
1315         JRST SEAR2
1316
1317 \f
1318 SETUP:  TLO F,20                ;ZERO
1319 SETUP1: ADDI T,1                ;YANK,VERIFY,SEARCHES
1320         TLNN F,QF
1321 SETUP2: MOVE T,@SYMP
1322         HRRZ T,T
1323         MOVEM T,ULIMIT
1324         HRRZ W,@SYMP
1325         CAMGE W,T
1326         TLNN F,20
1327 IFE EDDT&1,<    CAML T,JOBREL>
1328 IFN EDDT&1,<    JRST .+2>
1329
1330         JRST ERR
1331         HRRZ R,DEFV
1332         TLNN F,FAF
1333         MOVEI R,0
1334         CAML R,ULIMIT
1335         JRST ERR
1336         MOVEM R,DEFV
1337         MOVE W,R
1338         SUB W,ULIMIT
1339         HRLM W,R
1340         POPJ P,0
1341
1342 ZERO:   TLNN F,CCF
1343         JRST ERR
1344         PUSHJ P,SETUP
1345 ZERO1:  TRNE R,777760
1346         JRST ZERO2
1347         CLEARM,AC0(R)
1348         AOBJN R,ZERO1
1349         JRST DD1
1350 ZERO2:  HRRZ R, R
1351         CAIGE R,ZLOW
1352         MOVEI R,ZLOW            ;DON'T ZERO 20-ZLOW
1353         HRRZ S,T
1354         CAIL S, DDT
1355         MOVEI S, DDT
1356         CAMLE S,R
1357         JSP W,ZEROR
1358         HRRZ R,R
1359         CAIG R, DDTEND  ; DON'T ZERO OUT
1360         MOVEI R, DDTEND  ; DDT
1361         HRRZ S,T
1362         CAMLE S, R
1363         JSP W,ZEROR
1364         JRST DD1
1365
1366 ZEROR:  HRL R,R
1367         CLEARM,(R)
1368         ADDI  R, 1
1369         BLT R, -1(S)
1370         JRST (W)
1371
1372 \f
1373 FTOC:           ;NUMERIC OUTPUT SUBROUTINE
1374 TOC:    HRRZ W1,ODF
1375         CAIN W1,12
1376         JRST  TOC4
1377 TOCA:   LSHC T,-43
1378         LSH W1,-1               ;W1=T+1
1379 TOC1:   DIVI T,@ODF
1380         HRLM W1,0(P)
1381 TOC3:   JUMPE T,TOC2
1382         PUSHJ P,TOCA
1383 TOC2:   HLRZ T,0(P)
1384         ADDI T,"0"
1385 CJTOUT: JRST TOUT       ;DOES POPJ TO TOC2 OR EXIT
1386
1387 TOC4:   MOVM W1,T
1388         JUMPGE T,TOC5
1389         MOVEI T,"-"
1390         PUSHJ P,TOUT
1391 TOC5:   MOVEI T,0
1392         PUSHJ P,TOC1
1393 TOC6:   MOVEI T,"."
1394         JRST TOUT
1395
1396 ;SYMBOL OUTPUT SUBROUTINE
1397
1398 SPT0:   HRRZM W1,SPSAV          ;SAVE POINTER TO TYPED SYM
1399 SPT:    MOVE T,CJTOUT           ;RADIX 50 SYMBOL PRINT
1400 SPT4:   MOVEM T,SPTX            ;SETUP OUTPUT DESTINATION
1401         LDB T,[POINT 32,0(W1),35]       ;GET SYMBOL
1402 SPT1:   IDIVI T,50
1403         HRLM W1,0(P)
1404         JUMPE T,SPT2
1405         PUSHJ P,SPT1
1406 SPT2:   HLRZ T,0(P)
1407         JUMPE T,CPOPJ           ;FLUSH NULL CHARACTERS
1408         ADDI T,260-1
1409         CAILE T,271
1410         ADDI T,301-272
1411         CAILE T,332
1412         SUBI T,334-244
1413         CAIN T,243
1414 SPT3:   MOVEI T,256
1415 SPTX:   0               ;JRST TOUT, OR IDPB T,R FROM OPEVAL
1416         POPJ P,
1417
1418 SYMD:   MOVEI T,DELO/200000     ;$D ;DELETE LAST SYM & PRINT NEW
1419         HRRZ R,SPSAV            ;PICK UP POINTER TO LAST SYM
1420         JUMPE R,ERR
1421         DPB T,[POINT 2,(R),1]   ;STORE SEMI-DELETE BITS IN SYMBOL
1422         MOVE T,LWT
1423         JRST CONSYM             ;PRINT OUT NEXT BEST SYMBOL
1424 \f
1425 ;FLOATING POINT OUTPUT
1426
1427 TFLOT:  MOVE A,T
1428         JUMPG A, TFLOT1
1429         JUMPE A,FP1A
1430         MOVNS A
1431         MOVEI T,"-"
1432         PUSHJ P,TOUT
1433         TLZE A,400000
1434         JRST FP1A
1435 TFLOT1: MOVEI T,"#"  ; IF UNNORMALIZED FLOATING
1436         TLNN A, 400  ; POINT NUMBER, SO INDICATE
1437         PUSHJ P, TOUT ; WITH "#" BEFORE NUMBER
1438
1439 FP1:    MOVEI B,0
1440         CAMGE A,FT01
1441         JRST FP4
1442         CAML A,FT8
1443         AOJA B,FP4
1444 FP1A:   MOVEI C,0
1445
1446 FP3:    MULI A,400
1447         ASHC B,-243(A)
1448         MOVE A,B
1449         CLEARM,TEM1
1450         PUSHJ P,FP7
1451         PUSHJ P,TOC6            ;PRINT DECIMAL POINT
1452         MOVNI A,10
1453         ADD A,TEM1
1454         MOVE W1,C
1455 FP3A:   MOVE T,W1
1456         MULI T,12
1457         PUSHJ P,FP7B
1458         SKIPE,W1
1459         AOJL A,FP3A
1460         POPJ P,
1461
1462 FP4:    MOVNI C,6
1463         MOVEI W2,0
1464 FP4A:   ASH W2,1
1465         XCT,FCP(B)
1466         JRST FP4B
1467         FMPR A,@FCP+1(B)
1468         IORI W2,1
1469 FP4B:   AOJN C,FP4A
1470         PUSH P,FSGN(B)
1471         PUSHJ P,FP3
1472         POP P,W1
1473         MOVE A,W2
1474         PUSHJ P,TEXT
1475
1476 \fFP7:   JUMPE A,FP7A1
1477         IDIVI A,12
1478         AOS,TEM1
1479 FP7A:   HRLM B,(P)
1480         JUMPE A,FP7A1
1481         PUSHJ P,FP7
1482
1483 FP7A1:  HLRZ T,(P)
1484 FP7B:   ADDI T,260
1485         JRST TOUT
1486
1487         353473426555    ;1.0E32
1488         266434157116    ;1.0E16
1489 FT8:    233575360400    ;1.0E8
1490         216470400000    ;1.0E4
1491         207620000000    ;1.0E2
1492         204500000000    ;1.0E1
1493 FT:     201400000000    ;1.0E0
1494         026637304365    ;1.0E-32
1495         113715126246    ;1.0E-16
1496         146527461671    ;1.0E-8
1497         163643334273    ;1.0E-4
1498         172507534122    ;1.0E-2
1499 FT01:   175631463146    ;1.0E-1
1500 FT0=FT01+1
1501
1502 FCP:    CAMLE A, FT0(C)
1503         CAMGE A, FT(C)
1504         Z FT0(C)
1505
1506 FSGN:   ASCII .E-.
1507         ASCII .E+.
1508
1509 TEXTT:  MOVE W1,T
1510 TEXT:   TLNN W1,774000          ;LEFT JUSTIFIED UNLESS LEFT CHAR IS NULL
1511         LSH W1,35
1512 TEXT2:  MOVEI T,                ;7 BIT ASCII TEXT OUTPUT SUBROUTINE0
1513         LSHC T,7
1514         PUSHJ P,TOUT
1515         JUMPN W1,TEXT2
1516         POPJ P,
1517
1518
1519 \f
1520 KILC:   XWD -NSYMS,LOW
1521
1522 WRD:    0
1523 WRD2:   0
1524 PRNC:   0
1525
1526 FRASE:  0       ;DONT CHANGE ORDER, SEE  SEARC+3
1527 SYL:    0
1528 LWT:    0
1529 TEM2:   0
1530 FRASE1:
1531 TEM3:   0
1532 DEN:    0
1533
1534 PRGM:   0
1535 ESTU:   0
1536 ESTUT:  0
1537 FSV:    0
1538 FRACT:  0
1539 FPWR:   0
1540 FTERM:  0
1541 FH:     0
1542 SYM:    0
1543 SPSAV:  0       ;POINTER TO LAST SYMBOL TYPED
1544 DEFV:   0
1545 ULIMIT: 0
1546 LLOC:   0
1547 LLOCO:  0
1548 SYMP:   XWD PID,JOBSYM
1549 \f
1550 SAVPI:  0
1551         1177
1552 SAVTTY: 0
1553 IFN EDDT&1,<STARTA:     0>      ;START ADR FROM PTR
1554 MSK:    XWD -1,-1
1555 B1ADR:  0
1556 B1SKP:  0
1557 B1CNT:  0
1558
1559 REPEAT NBP*3-3, <       0>
1560
1561 BNADR=.-3
1562 AUTOPI: 0
1563
1564 AC0:    BLOCK 17
1565
1566 AC17:   0
1567
1568 SCHM:   EXP PIN         ;DO NOT CHANGE ORDER
1569 ARM:    EXP PADSO
1570 ODFM:   EXP 10
1571
1572 SARS:   0
1573 TEM:    0
1574 TEM1:   0
1575
1576 \f
1577 IFN EDDT&1&<EDDT>B36,<
1578
1579
1580 PSR:    TLNN F,ROF
1581         JRST ERR
1582         MOVEM T,LWT
1583         PUSHJ P,DEPRS
1584         HRRZM R,DEFV            ;R CONTAINS LLOCO
1585         MOVE T,R
1586         JRST PUN2
1587
1588 PUNCH:  TLC F,FAF+QF
1589         TLCE F,FAF+QF
1590         JRST ERR                ;ONE ARGUMENT MISSING
1591 PUN2:   ADDI T,1
1592         HRRZM T,TEM1
1593         SUB T,DEFV
1594         JUMPLE T,ERR
1595
1596 PUN1:   MOVEI T,4               ;PUNCH 4 FEED HOLES
1597         PUSHJ P,FEED
1598         TLNE F,CF               ;PUNCH NON-ZERO BLOCKS?
1599         JRST PUNZ               ;YES
1600         HRRZ R,DEFV
1601         IORI R,37
1602         ADDI R,1
1603         CAMLE R,TEM1
1604         MOVE R,TEM1
1605         EXCH R,DEFV
1606         MOVE T,R
1607         SUB T,DEFV
1608         HRL R,T
1609         JUMPGE R,RET            ;EXIT OR PUNCH
1610
1611 PBLK:   MOVE T,R
1612         SOS W,T         ;INIT CHECKSUM
1613         PUSHJ P,PWRD
1614 PBLK1:  PUSHJ P,FETCH
1615         JRST ERR
1616         ADD W,T
1617         PUSHJ P,PWRD
1618         AOBJN R,PBLK1
1619         MOVE T,W
1620         PUSHJ P,PWRD
1621         JRST PUN1
1622 \f
1623 ;PUNCH NON-ZERO BLOCKS
1624
1625 PUNZ0:  AOS DEFV                ;LOOK AT NEXT WORD
1626 PUNZ:   HRRZ W,DEFV             ;ENTER HERE - GET STARTING ADDRESS
1627         MOVE R,W
1628         SUB W,TEM1              ;CALCULATE NEGATIVE LENGTH
1629         HRL R,W                 ;SET UP AOBJN POINTER
1630         JUMPGE R,RET            ;FINISHED?
1631         CAMG R,[XWD -40,0]      ;BLOCK LONGER THAN 40?
1632         HRLI R,-40              ;YES, FIX IT UP
1633         MOVSI W1,400000         ;W1 NEGATIVE MEANS FLUSH 0 WORDS
1634 PUNZ2:  PUSHJ P,FETCH           ;GET WORD FROM MEMORY
1635         JRST ERR
1636         JUMPE T,[AOJA W1,PUNZ4] ;IF WORD IS 0, INDEX 0 WORD COUNTER
1637         MOVEI W1,0              ;CLEAR 0 WORD COUNTER
1638 PUNZ4:  JUMPL W1,PUNZ0          ;FLUSH 0 WORD, GET ANOTHER
1639         CAIL W1,3               ; NOSKIP FOR 3RD 0 WORD AFTER NON 0 WORD
1640         AOSA R                  ;ADVANCE R TO LAST ADR+1
1641         AOBJN R,PUNZ2
1642         ADD W1,DEFV             ;CALCULATE DEFV-R+W1=-WORD COUNT
1643         SUB W1,R
1644         HRLM W1,DEFV            ;PUT -WC IN LEFT HALF OF FA
1645         EXCH R,DEFV             ;SAVE ADR FOR NEXT BLOCK, GET POINTER
1646         JRST PBLK
1647
1648 >
1649 \fIFN EDDT&1&<EDDT>B36,<
1650
1651
1652 LOADER: TLNE F,QF
1653         JRST ERR
1654         MOVEI T,400
1655         PUSHJ P,FEED
1656         MOVE R,LOADE
1657 LOAD1:  MOVE T,0(R)
1658         PUSHJ P,PWRD
1659         AOBJN R,LOAD1
1660         MOVEI T,100
1661 LOAD2:  PUSHJ P,FEED
1662         JRST RET
1663
1664 BLKEND: TLNN F,QF               ;BLOCK END
1665         MOVE T,[JRST 4,DDT]
1666         TLO T,254000            ;JRST
1667         PUSH P,T
1668         MOVEI T,100
1669         PUSHJ P,FEED
1670         POP P,T
1671         PUSHJ P,PWRD
1672         PUSHJ P,PWRD    ;EXTRA WORD FOR READER TO STOP ON
1673         MOVEI T,500
1674         JRST LOAD2
1675
1676 PWRD:   MOVEI W1,6
1677 PWRD2:  ROT T,6
1678         CONSZ PTPP,20
1679         JRST .-1
1680         CONO PTPP,50
1681         DATAO PTPP,T
1682         SOJG W1,PWRD2
1683         POPJ P,0
1684
1685 FEED:   CONSZ PTPP,20
1686         JRST .-1
1687         CONO PTPP,10
1688         DATAO PTPP,FEED1
1689         SOJN T,FEED
1690 FEED1:  POPJ P,0        ;ADDRESS USED AS A CONSTANT
1691
1692 >
1693 \fIFN EDDT&1&<EDDT>B36,<
1694
1695
1696 VERIFY: TLO F,LTF
1697 CORE:   PUSHJ P,SETUP1          ;LOAD TAPES INTO CORE
1698         CONO PTRR,60
1699 CORE1:  CONSO PTRR,10
1700         JRST .-1
1701         DATAI PTRR,T
1702         CAME T,LOADE-1          ;JRST 1
1703         JRST CORE1
1704         PUSHJ P,CRF
1705         PUSHJ P,BLOCK
1706
1707 CORE2:  PUSHJ P,GETW
1708         CAML R,DEFV
1709         CAML R,ULIMIT
1710         JRST VER3
1711         TLNE F,LTF
1712         JRST VER2
1713         PUSHJ P,DEP
1714         JRST VER3
1715
1716 VER2:   MOVEM T,TEM2
1717         PUSHJ P,FETCH
1718         JRST ERR
1719         MOVEM T,TEM3
1720         XOR T,TEM2
1721         AND T,MSK
1722         JUMPE T,VER3
1723         PUSH P,S
1724         PUSH P,R
1725         HRRZ T,R
1726         PUSHJ P,PAD
1727         MOVEI T,257             ;SLASH
1728         PUSHJ P,TOUT
1729         PUSHJ P,LCT
1730         MOVE T,TEM3             ;CORE CONTENTS
1731         PUSHJ P,CONSYM
1732         PUSHJ P,LCT
1733         MOVE T,TEM2             ;TAPE CONTENTS
1734         PUSHJ P,CONSYM
1735         PUSHJ P,CRF
1736         POP P,R
1737         POP P,S
1738 VER3:   PUSHJ P,LISTEN
1739         AOJA R,CORE2
1740 RUNEND: PUSHJ P,BLOCK
1741         JRST .-1
1742
1743
1744 >
1745 \fIFN EDDT&1&<EDDT>B36,<
1746
1747
1748
1749 GETW:   JUMPL S,GETW1
1750         PUSHJ P,BLOCK
1751 GETW1:  MOVE T,1(S)
1752         AOBJP S,.+1
1753         POPJ P,0
1754
1755 BLOCKS: CONO PTRR,60            ;READ DATA BLOCKS
1756 BLOCK:  CONSO PTRR,10
1757         JRST .-1
1758         DATAI PTRR,W
1759         JUMPL W,BLK1
1760         MOVEM W,STARTA
1761         CONO PTRR,0             ;TURN OFF READER
1762         JRST DD1
1763 BLK1:   MOVEM W,W1              ;INIT CHECKSUM
1764         TLC W,777740
1765         TLCE W,777740
1766         JRST ERR                ;BLOCK TOO BIG
1767         ADDI W,1
1768         HRRZM W,R
1769         HRRI W,BUFF-1
1770         MOVEM W,S
1771 BLK2:   CONSO PTRR,10
1772         JRST .-1
1773         BLKI PTRR,W
1774         JRST BLK3
1775         ADD W1,0(W)
1776         JRST BLK2
1777 BLK3:   ADD W1,0(W)
1778         CONSO PTRR,10
1779         JRST .-1
1780         DATAI PTRR,W
1781         CAMN W,W1
1782         POPJ P,0
1783         CONO PTRR,0             ;CHECKSUM ERROR
1784         JRST 4,BLOCKS
1785
1786 ;R CONTAINS RIGHT HALF OF FIRST LINE
1787 ;S CONTAINS (-WC,BUFF-1)
1788
1789
1790 >
1791 \fIFN EDDT&1&<EDDT>B36,<
1792
1793
1794 LOADB:
1795
1796 PHASE 0                 ;RIM10B CHECKSUM LOADER
1797         XWD -16,0
1798 BEG:    CONO PTRR,60
1799         HRRI AA,RD+1
1800 RD:     CONSO PTRR,10
1801         JRST .-1
1802         DATAI PTRR,@TBL1-RD+1(AA)
1803         XCT     TBL1-RD+1(AA)
1804         XCT     TBL2-RD+1(AA)
1805 AA:     SOJA AA,
1806
1807 TBL1:   CAME CKSM,ADR
1808         ADD CKSM,1(ADR)
1809         SKIPL CKSM,ADR
1810
1811 TBL2:   JRST 4,BEG
1812         AOBJN ADR,RD
1813 ADR:    JRST BEG+1
1814 CKSM=ADR+1
1815
1816 DEPHASE
1817
1818 LOADE:  XWD LOADB-.,LOADB
1819 >
1820
1821 \f
1822
1823 SAVE:   0               ;SAVE THE ACS AND PI SYSTEM
1824         SKIPN SARS
1825         JRST SAV1
1826         AOS SAVE
1827         JRST SAV5
1828 SAV1:   IFN EDDT&1,<
1829         CONI PRS,SAVPI
1830         CONO PRS, @SAVPI+1>
1831         MOVEM 17,AC17
1832         HRRZI 17,AC0
1833         BLT 17,AC0+16
1834         MOVE T, SAVE
1835         HLLM T, SAVPI
1836 SAV5:   SETOM,SARS
1837         MOVEI P,PS
1838         IFE EDDT&1,<PUSHJ P,TTYRET>     ;IN USER MODE, GET INTO DDT MODE
1839         MOVEI F,0
1840         MOVE T,[XWD SCHM,SCH]
1841         BLT T,ODF               ;LOAD THE ACS WITH MODE SWITCHES
1842         JRST @SAVE
1843
1844 RESTORE: SETOM TEM3     ;RESTORE ACS AND PI SYSTEM
1845 RESTR1: HRRM T,SAVE
1846         MOVE T,SAVPI
1847         HLLM T, SAVE
1848 IFN EDDT&1,<
1849         AND T, SAVPI+1
1850         IORI T, 2000    ;TURN ON CHANNELS
1851         MOVEM T, SAVPI>
1852 RES1:   HRLZI 17,AC0
1853         BLT 17,17
1854         SETZM SARS
1855         SKIPL,TEM3
1856 CPUSHP: PUSH BCOM       ;PROGRAM MODIFIED AT IPUSHJ
1857 IFN EDDT&1,<    CONO PRS,@SAVPI>
1858         JRST 2,@SAVE
1859
1860 \f
1861 CRN:    MOVEI T,15              ;CARRIAGE RETURN
1862         JRST TOUT
1863
1864 IFE EDDT&1,<
1865 CRNRB:  PUSHJ P,CRN
1866         MOVEI T,177
1867         JRST TOUT>
1868
1869 CRF:    PUSHJ P,CRN
1870 LF:     MOVEI T,12              ;LINE FEED
1871         JRST TOUT
1872
1873 LCT:    IFN EDDT&1,<PUSHJ P,TSPC
1874         PUSHJ P,TSPC>
1875         IFE EDDT&1,<MOVEI T,11
1876         JRST TOUT>              ;TYPE A TAB
1877
1878 TSPC:   MOVEI T,40              ;SPACE
1879         JRST TOUT
1880 \fIFN EDDT&1,<   ;EXECUTIVE MODE TELETYPE I/O
1881
1882 TIN:    PUSHJ P,LISTEN          ;TELETYPE CHARACTER INPUT
1883          JRST .-1
1884         CAIE T,175
1885         CAIN T,176
1886         MOVEI T,33      ;CHANGE ALL ALT MODES TO NEW
1887         CAIN T,177      ;RUBOUT?
1888         JRST WRONG      ;YES, TYPE XXX
1889         TRNE T,140      ;DON'T ECHO CR,LF,ALT,TAB,BACK SPACE,ETC
1890 TOUT:   CAIG T,04       ;DON'T TYPE EOT OR LOWER CHARS
1891         POPJ P,
1892         HRLM T,(P)
1893         IMULI T,200401          ;GENERATE PARITY
1894         AND T,[11111111]
1895         IMUL T,[11111111]
1896         HLR T,(P)
1897         TLNE T,10
1898         TRC T,200               ;MAKE PARITY EVEN
1899         CONSZ TTYY,20
1900         JRST .-1
1901         DATAO TTYY,T
1902         ANDI T,177              ;FLUSH PARITY
1903         POPJ P,0
1904
1905 LISTEN: CONSO TTYY,40   ;LISTEN FOR TTY
1906         POPJ P,
1907         DATAI TTYY,T
1908         ANDI T,177
1909         JRST CPOPJ1
1910
1911 TTYRET: MOVEI  T,3410
1912 TTY1:   MOVEI W2,40000
1913         CONSZ TTYY,120
1914         SOJG W2,.-1
1915         CONI TTYY,SAVTTY
1916         DATAI TTYY,W2
1917         HRLM W2,SAVTTY
1918         CONO TTYY,(T)
1919         POPJ P,
1920 TTYLEV: MOVE T,SAVTTY
1921         TRZ T,160
1922         TRO T,3600
1923         TRNE T,10
1924         TRZ T,200
1925         JRST TTY1
1926
1927
1928 TEXIN:  PUSHJ P,TIN     ;INPUT SUBROUTINE FOR TEXT MODES
1929         TRNN T,140
1930         JRST TOUT       ;ECHO CHARACTERS (0-37) NOT ECHOED
1931         POPJ P,
1932 >
1933 \fIFE EDDT&1,<   ;USER MODE TELETYPE I/O
1934
1935
1936 TIN:    MOVE T,POUTBF           ;GET NEXT CHARACTER ROUTINE
1937         CAME T,[POINT 7,INBFF]
1938         PUSHJ P,FINOUT
1939         ILDB T,PINBFF
1940         CAIN T,175
1941         MOVEI T,33      ;CHANGE TO NEW ALT MODE
1942         CAIN    T,177   ;RUBOUT?
1943         JRST    WRONG   ;YES PRINT XXX
1944         JUMPN T,CPOPJ
1945         MOVE T,[POINT 7,INBFF]
1946         MOVEM T,PINBFF
1947         CALL T,[SIXBIT /DDTIN/]
1948         JRST TIN
1949
1950 TOUT:   JUMPE   T,CPOPJ ;OUT PUT A CHARACTER FLUSH NULLS
1951         IDPB T,POUTBF
1952         CAIE T,12
1953         POPJ P,
1954 FINOUT: MOVEI T,0
1955         IDPB T,POUTBF
1956         MOVE T,[POINT 7,INBFF]
1957         MOVEM T,PINBFF
1958         MOVEM T,POUTBF
1959         CALL T,[SIXBIT /DDTOUT/]
1960         CLEARM INBFF
1961         POPJ P,
1962
1963 PINBFF: POINT 7,INBFF
1964 POUTBF: POINT 7,INBFF
1965
1966 LISTEN=CPOPJ
1967 INBFF:  BLOCK 21
1968
1969 TTYRET: CALL [SIXBIT /DDTGT/]
1970         MOVE T,[POINT 7,INBFF]
1971         MOVEM T,POUTBF
1972         MOVEM T,PINBFF
1973         CLEARM INBFF
1974         POPJ P,
1975
1976 TTYLEV: PUSHJ P,FINOUT
1977         CALL [SIXBIT /DDTRL/]
1978         POPJ P,
1979
1980 TEXIN=TIN       ;USE NORMAL INPUT FOR TEXT WHEN IN USER MODE
1981 >
1982 \f
1983 BDISP:  POINT 12,DISP(R),11
1984         POINT 12,DISP(R),23
1985         POINT 12,DISP(R),35
1986
1987 DISP:
1988 DEFINE D (Z1,Z2,Z3)<XLIST
1989         EXP <Z1-DDT>*1B11+<Z2-DDT>*1B23+Z3-DDT
1990         LIST>
1991
1992 IFE EDDT&1&<EDDT>B36,<  PUNCH=ERR
1993         BLKEND=ERR
1994         LOADER=ERR
1995         VERIFY=ERR
1996         CORE=ERR>
1997
1998
1999
2000 D ERR,ERR,ERR
2001 D ERR,ERR,ERR
2002 D ERR,ERR,VARRW
2003 D TAB,LINEF,ERR
2004 D ERR,CARR,ERR
2005 D ERR,ERR,ERR
2006 D PUNCH,ERR,ERR
2007 D ERR,ERR,ERR
2008 D ERR,ERR,ERR
2009 D CONTROL,ERR,ERR
2010 D ERR,ERR,SPACE
2011 D SUPTYO,TEXI,ASSEM
2012 D DOLLAR,PERC,ERR
2013 D DIVD,LPRN,RPRN
2014 D MULT,PLUS,ACCF
2015 D MINUS,PERIOD,SLASH
2016 D NUM,NUM,NUM
2017 D NUM,NUM,NUM
2018 D NUM,NUM,NUM
2019 D NUM,TAG,SEMIC
2020 D FIRARG,EQUAL,ULIM
2021 D QUESTN,INDIRECT,ABSA
2022 D BPS,CON,SYMD
2023 D EFFEC,SFLOT,GO
2024 D HWRDS,PILOC,BLKEND
2025 D KILL,LOADER,MASK
2026 D NWORD,BITO,PROCEDE
2027 D QUAN,RELA,SYMBOL
2028 D TEXO,ERR,VERIFY
2029 D WORD,XEC,CORE
2030 D ZERO,OCON,ICON
2031 D OSYM,VARRW,PSYM
2032
2033 REPEAT 11,<D ERR,ERR,ERR>
2034
2035 D ERR,ERR,ERR
2036 D ERR,WRONG,DDT
2037 \f
2038 IFIX:   MOVE R,@SYMP            ;DIDDLE SYMBOL TABLE POINTERS
2039         HRRZM R,ESTU
2040         HLRZ T,@SYMP
2041         SUB T,@SYMP
2042         ADDI T,NSYMS
2043         MOVNS T
2044         HRRM T, KILC
2045         MOVE T, KILC
2046         MOVEM T, PRGM
2047         JRST DDT
2048
2049 BITO:   MOVEI   R,BITT  ;BYTE OUTPUT SUBROUTINE
2050         HRRZI   AR,TOC
2051         TRZN    F,Q2F
2052         JRST    ERR
2053         MOVE    T,WRD2
2054         MOVEM   T,SVBTS
2055         MOVEI   T,^D36
2056         IDIV    T,WRD2
2057         SKIPE   T+1
2058         ADDI    T,1
2059         MOVEM   T,SVBTS2
2060         HRRZ    SCH,R
2061         JRST    BASE1
2062 BITT:   MOVE    T,SVBTS2
2063         MOVEM   T,SVBT2
2064         MOVE    T+1,LWT
2065         MOVEM   T+1,SVBT3
2066 BITT2:  MOVEI   T,0
2067         MOVE    T+2,SVBTS
2068         LSHC    T,(T+2)
2069         MOVEM   T,LWT
2070         MOVEM   T+1,SVBT3
2071         CAIE    AR,PADSO
2072         PUSHJ   P,FTOC
2073         CAIE    AR,TOC
2074         PUSHJ   P,PIN
2075         SOSG    SVBT2
2076         POPJ    P,
2077         MOVEI   T,","
2078         PUSHJ   P,TOUT
2079         MOVE    T+1,SVBT3
2080         JRST    BITT2
2081 SVBTS:  0
2082 SVBTS2: 0
2083 SVBT3:  0
2084 SVBT2:  0
2085 \f
2086 ;DESCRIPTION OF OP DECODER FOR DDT:
2087 ;
2088 ;         THE ENTIRE INSTRUCTION SET FOR THE PDP-6 CAN BE COMPACTED INTO
2089 ;A SPACE MUCH SMALLER THAN ONE REGISTER FOR EVERY SYMBOL.  THIS OCCURS
2090 ;BECAUSE OF THE MACHINE ORGANIZATION AND INSTRUCTION MNEMONICS CHOSEN
2091 ;FOR THE PDP-6.  FOR EXAMPLE, IF BITS (0-2) OF AN INSTRUCTION EQUAL
2092 ;101(2) THE INSTRUCTION IS A HALF WORD INSTRUCTION AND AN "H" MAY
2093 ;BE ASSUMED. "T" MAY BE ASSUMED FOR ALL TEST INSTRUCTIONS (WHICH
2094 ;BEGIN WITH 110(2).
2095 ;
2096 ;       THE TABLE TBL IN DDT CONSISTS OF 9 BIT BYTES, 4 TO A WORD.
2097 ;THE NUMBERS IN THE BYTES HAVE THE FOLLOWING SIGNIFICANCE:
2098 ;0-37(8):       THIS IS A DISPATCH COMMAND FOR THE OP-DECODER INTERPRETER.
2099 ;       LET THE RIGHT MOST TWO BITS EQUAL N; LET THE NEXT 3 BITS
2100 ;       EQUAL P.
2101 ;
2102 ;       THE CONTENTS OF INST (INSTRUCTION) CONTAIN IN THE RIGHT
2103 ;       MOST NINE BITS THE BINARY FOR THE MACHINE INSTRUCTION.
2104 ;       P AND N REFER TO THE CONTENTS OF INST, AND THE OP DECODER
2105 ;       WILL PRODUCE AN ANSWER D GIVEN P, N, AND THE CONTENTS
2106 ;       OF INSTX N+1 GIVES THE NUMBER OF BITS IN INST; P GIVES THE
2107 ;       POSITION (FROM THE RIGHT EDGE) OF THE N+1 BITS.
2108 ;
2109 ;       EXAMPLE: P = 6
2110 ;                N = 2
2111 ;
2112 ;;      C(INST) = .010 101 100(2)
2113 ;
2114 ;       THE RESULT- D = 010(2) = 2(8)
2115 ;
2116 ;       D IS USED AS A DISPATCH ON THE NEXT BYTES IN THE TABLE.
2117 ;       IF D = 5, 5 BYTES IN THE TABLE (DON'T COUNT THE BYTES WHICH
2118 ;       PRINT TEXT, 41-72(8)) ARE SKIPPED OVER AND THE 6TH BYTE RESUMES
2119 ;       THE INTERPRETATION.
2120 ;
2121 ;40(8)  THIS IS A STOP CODE; WHEN THIS IS REACHED INTERPRETATION
2122 ;       IS FINISHED.
2123 \f
2124 ;41(8)-72(8)      THE ALPHABET IS ENCODED INTO THIS RANGE.
2125 ;               41- A
2126 ;               42- B
2127 ;               72- Z
2128 ;               WHEN A BYTE IN THIS RANGE IS REACHED, ITS CORRESPONDING
2129 ;               LETTER IS TYPED.
2130 ;
2131 ;73(8)-777(8)     THIS IS A TRANSFER BYTE.  IF THE BYTE IN THIS RANGE IS
2132 ;               CONSIDERED TO BE A, TRANSFER INTERPRETATION TO THE A-73(8)RD
2133 ;               BYTE IN THE TABLE.
2134 ;
2135 ;MAROS ASSEMBLE THE TABLE TBL:
2136 ; 1.   A NUMBER FOLLOWED BY ^ ASSEMBLES A DISPATCH BYTE.  THE FIRST
2137 ;      DIGIT IS THE POSITION; THE SECOND DIGIT IS THE SIZE.
2138 ; 2.   A POINT (.) ASSEMBLES A STOP CODE.
2139 ; 3.   A NAME FOLLOWED BY A SLASH ASSEMBLES A TRANSFER TO THE
2140 ;      SYMBOLICALLY NAMED BYTE.
2141 ; 4.   A STRING OF LETTERS TERMINATED BY A SPACE, COMMA, OR POINT,
2142 ;      ASSEMBLE INTO A STRING OF BYTES, EACH BYTE BEING ONE LETTER.
2143 ;
2144 ;EXAMPLE OF BINARY TO SYMBOLIC DECODING:
2145 ;      THE MACHINE CODE FOR JRST IAS 254
2146 ;          INST    0  1  0  1  0  1  1  0  0
2147 ;      THE INTERPRETER STARTS WITH THE FIRST BYTE IN THE TABLE (63^).
2148 ;      THE RESULT OF APPLYING THIS TO C(INST) GIVES 2.  SKIPPING OVER
2149 ;      2 BYTES IN THE TABLE AND INTERPRETING THE THIRD RESULTS IN
2150 ;      HAK/ BEING INTERPRETED.  AT HAK:, THERE IS A 33^.  APPLYING
2151 ;      THIS TO C(INST) RESULTS IN 5 NON PRINTING BYTES BEING SKIPPED
2152 ;      OVER:
2153 ;          1.  MV/
2154 ;               MOV      PRINTING TEXT
2155 ;          2.  MO/
2156 ;          3.  ML/
2157 ;          4.  DV/
2158 ;          5.  SH/
2159 ;
2160 ;H1/ IS THE NEXT BYTE INTERPRETER.  AT H1: 03^ IS FOUND SO
2161 ;4 BYTES ARE SKIPPED OVER:
2162 ;              EXC      PRINTING TEXT
2163 ;          1.  S3/
2164 ;              BL       PRINTING TEXT
2165 ;              T        PRINTING TEXT
2166 ;          2.  .
2167 ;          3.  AO/
2168 ;          4.  AOB/
2169 ;          THE NEXT LETTERS JRS ARE TYPED OUT.  THEN T/ IS FOUND.  AT
2170 ;T; A T IS TYPED OUT; THEN A "." IS FOUND AND EVERYTHING STOPS.
2171 ;
2172 ;          THE TABLE IS ALSO USED GOING FROM SYMBOLIC TO BINARY BUT A
2173 \f\f\f\f\f\fREPEAT 0,<
2174
2175 DEFINE REDEF (XX)<
2176 DEFINE INFO (AA,BB)<
2177 AA XX'BB>>
2178
2179
2180 DEFINE BYT9 (L)<
2181 XLIST
2182 REDEF %
2183  ZZ=0
2184  ZZZ=0
2185  ZZM=1
2186
2187  IRPC L,<
2188         Z="L"
2189         IFE Z-":",<INFO <>,<=CLOC>
2190                 IFNDEF FIR.,<FIR.=CLOC>
2191                 IFGE CLOC+73-1000-FIR.,<PRINTX OPTABLE TOO LONG>
2192                 Z=0>
2193         IFE Z-"/",<IF1 <OUTP 1>
2194                 IF2,<INFO OUTP,+73-FIR.>
2195                 Z=0>
2196  IFE Z-"^",<OUTP <ZZ&70/2+ZZ&7-1>
2197         Z=0>
2198  IFE <Z-",">*<Z-".">*<Z-40>,<IFN ZZZ,<
2199                                 REPEAT 5,<ZZ=ZZZ&77
2200                                         IFN ZZ,<OUTP ZZ>
2201                                         ZZZ=ZZZ/100>>
2202                                 IFE Z-".",<OUTP 40>
2203                                 Z=0>
2204  IFN Z,<INFO REDEF,L
2205         ZZ=ZZ*10+Z&7
2206         ZZZ=ZZZ+<Z-40>*ZZM
2207         ZZM=ZZM*100>
2208  IFE Z,<REDEF %
2209         ZZ=0
2210         ZZZ=0
2211         ZZM=1>>
2212 LIST>
2213
2214 DEFINE OUTP (A)<
2215         BINRY=BINRY*400+BINRY*400+A
2216         BINC=BINC-1
2217         IFE BINC,<EXP BINRY
2218                 BINRY=0
2219                 BINC=4>
2220         CLOC=CLOC+1>
2221
2222
2223 \f
2224 TBL:            ;OPDECODER BYTE TABLE
2225
2226 BINRY=0
2227 CLOC=0          ;SET BYTE LOCATION COUNTER TO 0
2228 BINC=4          ;INIT BYTES/WORD COUNTER
2229
2230 BYT9 <63^UUO/FLO/HAK/ACCP/BOOLE/H HWT/T ACBM/>
2231
2232 ;IO INSTRUCTIONS
2233 BYT9 <21^BD/CON,11^OI/S,01^Z/O/>
2234 BYT9 <BD:01^BLK,IO/DATA,IO:11^I/O/OI:01^O/I/>
2235
2236 ;UUOS
2237 BYT9 <UUO:51^.,32^U40/U50/U60/21^U703/11^USET/01^>
2238 BYT9 <LOOKU,P/ENTE,R/USET:USET,01^I/O/>
2239 BYT9 <U40:03^U47/INI T/.....,U47:CALL,01^.,I/>
2240 BYT9 <U60:21^U603/01^IN,BPUT/OUT,BPUT:11^BU,F:F.,PU,T/>
2241 BYT9 <U603:01^U6062/STAT,11^O:O.,Z:Z.,U6062:11^S,U62/G,U62:ETST,S/>
2242 ;BYTE AND FLOATING INSTRUCTIONS
2243
2244 BYT9 <FLO:51^BYTE/F 32^ AD A/SB A/MP A/DV A:>
2245 BYT9 <21^LMB/R,IMB/LMB:02^.,L:L.,M:M.,B:B.,BYTE:32^...,03^UF,PA/DF,N/>
2246 BYT9 <FS C/IB P:P.,I LD/LD:LD B/I DP/DP:DP B/>
2247
2248 ;FWT,FIXED POINT ARITH,MISC.
2249
2250 BYT9 <HAK:33^MV/MV:MOV MO/ML/DV/SH/H1/JP/>
2251 BYT9 <21^ADD IMB/SU BIMB:B IMB:02^.,I:I.,M/B/MO:22^>
2252 BYT9 <EIMS:E IMS/S IMS/N IMS/M IMS:02^.,I/M/S:S.,>
2253 BYT9 <ML:21^I ML1/ML1:MUL IMB/DV:21^I DV1/DV1:>
2254 BYT9 <DI DV2:V IMB/H1:03^EXC S3/BL T:T.,AO/AO:AOBJ,>
2255 BYT9 <AOB/JRS T/JFC L/XC T/CON S/AOB:01^P/N/>
2256 BYT9 <JP:03^PU/PU:PUSH PUS/PO/PO:POP POP/JS,R:R.,>
2257 BYT9 <JS P/JS PA:A.,JR PA/PUS:01^J:J..,POP:>
2258 BYT9 <01^.,J/SH:02^A S2/ROT S1/L S2:S S3:H S1/.,S1:21^.,C:C.,>
2259
2260 ;ARITH COMP,SKIP,JUMP
2261
2262 BYT9 <ACCP:42^CA CA1/SJ/A JS/S JS:O 31^>
2263 BYT9 <J COMP/S COMP/CA1:31^I COMP/M COMP/>
2264 BYT9 <SJ:31^JUM PSJ/SKI PSJ:P COMP:>
2265 BYT9 <03^.,L/E:E.,L E/PA/G E/N:N.,G.,>
2266
2267
2268 ;HALF WORDS
2269
2270 BYT9 <HWT:51^HW1/21^R HW2/L HW2:R HW3/HW1:>
2271 BYT9 <21^L HW4/R HW4:L HW3:32^IMS/Z IMS/O IMS/EIMS/>
2272
2273 ;TEST INSTRUCTIONS
2274
2275 BYT9 <ACBM:31^AC1/01^D AC2/S AC2/AC1:01^R AC2/L,>
2276 BYT9 <AC2:42^N EAN/Z EAN/C EAN/O EAN:12^.,E/PA/N/>
2277
2278 \f
2279 ;BOOLEAN
2280
2281 BYT9 <BOOLE:24^ST/AN:AND B2/AN/ST/AN/ST/>
2282 BYT9 <X OR:OR B2/I OR/AN/EQ DV2/ST/OR/ST/OR/OR/>
2283 BYT9 <ST:SET B2:24^Z IMB/IMB/CA:C TA/TM:M IMB/>
2284 BYT9 <CM:C TM/TA:A IMB/IMB/IMB/CB:C BIMB/IMB/CA/>
2285 BYT9 <CA/CM/CM/CB/O IMB/>
2286
2287 ;MORE UUO'S
2288 BYT9 <U50:03^OPE,N/....,RENAM,E/I,N/OU,T/>
2289 BYT9 <U703:02^CLOS,E/RELEA,S/MTAP,E/UGET,F/>
2290
2291 REPEAT BINC,<BINRY=BINRY*400+BINRY*400>
2292 IFN BINRY,<EXP BINRY>>
2293
2294
2295
2296 \fSUBTTL OP DECODER
2297
2298 IF1,
2299 <
2300
2301 DEFINE  .COLON  (A) <
2302 %'A==   CLOC
2303 FIR.==  CLOC
2304 DEFINE  .COLON  (AA) <
2305 %'AA==  CLOC
2306 IFGE    CLOC+73-1000-FIR., <PRINTX OPTABLE TOO LONG>>>
2307
2308 DEFINE  .SLASH  <
2309 CLOC=   CLOC+1 ;>
2310
2311 SYN     .SLASH, .ARROW
2312
2313 DEFINE  .COMMA  (A) <
2314 IFNB    <A>,    <.REP5 A>>
2315
2316 SYN     .COMMA, .SPACE
2317
2318 DEFINE  .POINT  (A) <
2319 IFNB    <A>,    <.REP5 A>
2320 CLOC=   CLOC+1>
2321
2322 DEFINE  .REP5   (A) <
2323 IRPC    A, <CLOC==CLOC+1>>
2324
2325 >
2326 \fIF2,
2327 <
2328
2329 DEFINE  .SLASH  (A) <
2330 OUTP    %'A+73-FIR.>
2331
2332 DEFINE  .ARROW  (A) <
2333 OUTP    A&70/2+A&7-1>
2334
2335 DEFINE  .COMMA  (A) <
2336 IFNB    <A>,    <.REP5 A>>
2337
2338 SYN     .COMMA, .SPACE
2339
2340 DEFINE  .POINT  (A) <
2341 IFNB    <A>,    <.REP5 A>
2342 OUTP    40>
2343
2344 DEFINE  .REP5   (A) <
2345 IRPC    A, <OUTP "A"-40>>
2346
2347 DEFINE OUTP (A)<
2348 BINRY== BINRY+<A>_<BINC==BINC-9>
2349 IFE BINC, <
2350                 +BINRY
2351 BINRY==0
2352 BINC==^D36>
2353 CLOC==CLOC+1>
2354
2355 >
2356 \fTBL:           ;OPDECODER BYTE TABLE
2357
2358 BINRY== 0
2359 CLOC==  0       ;SET BYTE LOCATION COUNTER TO 0
2360 BINC==  ^D36    ;INIT BYTES/WORD COUNTER
2361
2362 .ARROW  63
2363 .SLASH  UUO
2364 .SLASH  FLO
2365 .SLASH  HAK
2366 .SLASH  ACCP
2367 .SLASH  BOOLE
2368 .SPACE  H
2369 .SLASH  HWT
2370 .SPACE  T
2371 .SLASH  ACBM
2372
2373
2374 ;IO INSTRUCTIONS
2375
2376 .ARROW  21
2377 .SLASH  BD
2378 .COMMA  CON
2379 .ARROW  11
2380 .SLASH  OI
2381 .COMMA  S
2382 .ARROW  01
2383 .SLASH  Z
2384 .SLASH  O
2385
2386 .COLON  BD
2387 .ARROW  01
2388 .COMMA  BLK
2389 .SLASH  IO
2390 .COMMA  DATA
2391 .COLON  IO
2392 .ARROW  11
2393 .SLASH  I
2394 .SLASH  O
2395 .COLON  OI
2396 .ARROW  01
2397 .SLASH  O
2398 .SLASH  I
2399 \f;UUOS
2400
2401 .COLON  UUO
2402 .ARROW  51
2403 .POINT
2404 .COMMA
2405 .ARROW  32
2406 .SLASH  U40
2407 .SLASH  U50
2408 .SLASH  U60
2409 .ARROW  21
2410 .SLASH  U703
2411 .ARROW  11
2412 .SLASH  USET
2413 .ARROW  01
2414
2415 .COMMA  LOOKU
2416 .SLASH  P
2417 .COMMA  ENTE
2418 .SLASH  R
2419 .COLON  USET
2420 .COMMA  USET
2421 .ARROW  01
2422 .SLASH  I
2423 .SLASH  O
2424
2425 .COLON  U40
2426 .ARROW  03
2427 .SLASH  U47
2428 .SPACE  INI
2429 .SLASH  T
2430 .POINT
2431 .POINT
2432 .POINT
2433 .POINT
2434 .POINT
2435 .COMMA
2436 .COLON  U47
2437 .COMMA  CALL
2438 .ARROW  01
2439 .POINT
2440 .COMMA
2441 .SLASH  I
2442
2443 .COLON  U60
2444 .ARROW  21
2445 .SLASH  U603
2446 .ARROW  01
2447 .COMMA  IN
2448 .SLASH  BPUT
2449 .COMMA  OUT
2450 .COLON  BPUT
2451 .ARROW  11
2452 .COMMA  BU
2453 .COLON  F
2454 .POINT  F
2455 .COMMA
2456 .COMMA  PU
2457 .SLASH  T
2458
2459 .COLON  U603
2460 .ARROW  01
2461 .SLASH  U6062
2462 .COMMA  STAT
2463 .ARROW  11
2464 .COLON  O
2465 .POINT  O
2466 .COMMA
2467 .COLON  Z
2468 .POINT  Z
2469 .COMMA
2470 .COLON  U6062
2471 .ARROW  11
2472 .COMMA  S
2473 .SLASH  U62
2474 .COMMA  G
2475 .COLON  U62
2476 .COMMA  ETST
2477 .SLASH  S
2478 \f;BYTE AND FLOATING INSTRUCTIONS
2479
2480 .COLON  FLO
2481 .ARROW  51
2482 .SLASH  BYTE
2483 .SPACE  F
2484 .ARROW  32
2485 .SPACE
2486 .SPACE  AD
2487 .SLASH  A
2488 .SPACE  SB
2489 .SLASH  A
2490 .SPACE  MP
2491 .SLASH  A
2492 .SPACE  DV
2493 .COLON  A
2494 .ARROW  21
2495 .SLASH  LMB
2496 .COMMA  R
2497 .SLASH  IMB
2498 .COLON  LMB
2499 .ARROW  02
2500 .POINT
2501 .COMMA
2502 .COLON  L
2503 .POINT  L
2504 .COMMA
2505 .COLON  M
2506 .POINT  M
2507 .COMMA
2508 .COLON  B
2509 .POINT  B
2510 .COMMA
2511 .COLON  BYTE
2512 .ARROW  32
2513 .POINT
2514 .POINT
2515 .POINT
2516 .COMMA
2517 .ARROW  03
2518 .COMMA  UF
2519 .SLASH  PA
2520 .COMMA  DF
2521 .SLASH  N
2522
2523 .SPACE  FS
2524 .SLASH  C
2525 .SPACE  IB
2526 .COLON  P
2527 .POINT  P
2528 .COMMA
2529 .SPACE  I
2530 .SLASH  LD
2531 .COLON  LD
2532 .SPACE  LD
2533 .SLASH  B
2534 .SPACE  I
2535 .SLASH  DP
2536 .COLON  DP
2537 .SPACE  DP
2538 .SLASH  B
2539 \f;FWT,FIXED POINT ARITH,MISC
2540
2541 .COLON  HAK
2542 .ARROW  33
2543 .SLASH  MV
2544 .COLON  MV
2545 .SPACE  MOV
2546 .SLASH  MO
2547 .SLASH  ML
2548 .SLASH  DV
2549 .SLASH  SH
2550 .SLASH  H1
2551 .SLASH  JP
2552
2553 .ARROW  21
2554 .SPACE  ADD
2555 .SLASH  IMB
2556 .SPACE  SU
2557 .COLON  BIMB
2558 .SPACE  B
2559 .COLON  IMB
2560 .ARROW  02
2561 .POINT
2562 .COMMA
2563 .COLON  I
2564 .POINT  I
2565 .COMMA
2566 .SLASH  M
2567 .SLASH  B
2568 .COLON  MO
2569 .ARROW  22
2570
2571 .COLON  EIMS
2572 .SPACE  E
2573 .SLASH  IMS
2574 .SPACE  S
2575 .SLASH  IMS
2576 .SPACE  N
2577 .SLASH  IMS
2578 .SPACE  M
2579 .COLON  IMS
2580 .ARROW  02
2581 .POINT
2582 .COMMA
2583 .SLASH  I
2584 .SLASH  M
2585 .COLON  S
2586 .POINT  S
2587 .COMMA
2588
2589 .COLON  ML
2590 .ARROW  21
2591 .SPACE  I
2592 .SLASH  ML1
2593 .COLON  ML1
2594 .SPACE  MUL
2595 .SLASH  IMB
2596 .COLON  DV
2597 .ARROW  21
2598 .SPACE  I
2599 .SLASH  DV1
2600 .COLON  DV1
2601 .SPACE  DI
2602 .COLON  DV2
2603 .SPACE  V
2604 .SLASH  IMB
2605 .COLON  H1
2606 .ARROW  03
2607 .SPACE  EXC
2608 .SLASH  S3
2609 .SPACE  BL
2610 .COLON  T
2611 .POINT  T
2612 .COMMA
2613 .SLASH  AO
2614 .COLON  AO
2615 .COMMA  AOBJ
2616 .SLASH  AOB
2617 .SPACE  JRS
2618 .SLASH  T
2619 .SPACE  JFC
2620 .SLASH  L
2621 .SPACE  XC
2622 .SLASH  T
2623 .SPACE  CON
2624 .SLASH  S
2625 .COLON  AOB
2626 .ARROW  01
2627 .SLASH  P
2628 .SLASH  N
2629
2630 .COLON  JP
2631 .ARROW  03
2632 .SLASH  PU
2633 .COLON  PU
2634 .SPACE  PUSH
2635 .SLASH  PUS
2636 .SLASH  PO
2637 .COLON  PO
2638 .SPACE  POP
2639 .SLASH  POP
2640 .COMMA  JS
2641 .COLON  R
2642 .POINT  R
2643 .COMMA
2644
2645 .SPACE  JS
2646 .SLASH  P
2647 .SPACE  JS
2648 .COLON  PA
2649 .POINT  A
2650 .COMMA
2651 .SPACE  JR
2652 .SLASH  PA
2653 .COLON  PUS
2654 .ARROW  01
2655 .COLON  J
2656 .POINT  J
2657 .POINT
2658 .COMMA
2659 .COLON  POP
2660 .ARROW  01
2661 .POINT
2662 .COMMA
2663 .SLASH  J
2664 .COLON  SH
2665 .ARROW  02
2666 .SPACE  A
2667 .SLASH  S2
2668 .SPACE  ROT
2669 .SLASH  S1
2670 .SPACE  L
2671 .COLON  S2
2672 .SPACE  S
2673 .COLON  S3
2674 .SPACE  H
2675 .SLASH  S1
2676 .POINT
2677 .COMMA
2678 .COLON  S1
2679 .ARROW  21
2680 .POINT
2681 .COMMA
2682 .COLON  C
2683 .POINT  C
2684 .COMMA
2685 \f;ARITH COMP,SKIP,JUMP
2686
2687 .COLON  ACCP
2688 .ARROW  42
2689 .SPACE  CA
2690 .SLASH  CA1
2691 .SLASH  SJ
2692 .SPACE  A
2693 .SLASH  JS
2694 .SPACE  S
2695 .COLON  JS
2696 .SPACE  O
2697 .ARROW  31
2698
2699 .SPACE  J
2700 .SLASH  COMP
2701 .SPACE  S
2702 .SLASH  COMP
2703 .COLON  CA1
2704 .ARROW  31
2705 .SPACE  I
2706 .SLASH  COMP
2707 .SPACE  M
2708 .SLASH  COMP
2709
2710 .COLON  SJ
2711 .ARROW  31
2712 .SPACE  JUM
2713 .SLASH  PSJ
2714 .SPACE  SKI
2715 .COLON  PSJ
2716 .SPACE  P
2717 .COLON  COMP
2718 .ARROW  03
2719 .POINT
2720 .COMMA
2721 .SLASH  L
2722 .COLON  E
2723 .POINT  E
2724 .COMMA
2725 .SPACE  L
2726 .SLASH  E
2727 .SLASH  PA
2728 .SPACE  G
2729 .SLASH  E
2730 .COLON  N
2731 .POINT  N
2732 .COMMA
2733 .POINT  G
2734 .COMMA
2735 \f;HALF WORDS
2736
2737 .COLON  HWT
2738 .ARROW  51
2739 .SLASH  HW1
2740 .ARROW  21
2741 .SPACE  R
2742 .SLASH  HW2
2743 .SPACE  L
2744 .COLON  HW2
2745 .SPACE  R
2746 .SLASH  HW3
2747 .COLON  HW1
2748 .ARROW  21
2749 .SPACE  L
2750 .SLASH  HW4
2751 .SPACE  R
2752 .COLON  HW4
2753 .SPACE  L
2754 .COLON  HW3
2755 .ARROW  32
2756 .SLASH  IMS
2757 .SPACE  Z
2758 .SLASH  IMS
2759 .SPACE  O
2760 .SLASH  IMS
2761 .SLASH  EIMS
2762 \f;TEST INSTRUCTIONS
2763
2764 .COLON  ACBM
2765 .ARROW  31
2766 .SLASH  AC1
2767 .ARROW  01
2768 .SPACE  D
2769 .SLASH  AC2
2770 .SPACE  S
2771 .SLASH  AC2
2772 .COLON  AC1
2773 .ARROW  01
2774 .SPACE  R
2775 .SLASH  AC2
2776 .COMMA  L
2777 .COLON  AC2
2778 .ARROW  42
2779 .SPACE  N
2780 .SLASH  EAN
2781 .SPACE  Z
2782 .SLASH  EAN
2783 .SPACE  C
2784 .SLASH  EAN
2785 .SPACE  O
2786 .COLON  EAN
2787 .ARROW  12
2788 .POINT
2789 .COMMA
2790 .SLASH  E
2791 .SLASH  PA
2792 .SLASH  N
2793 \f;BOOLEAN
2794
2795 .COLON  BOOLE
2796 .ARROW  24
2797 .SLASH  ST
2798 .COLON  AN
2799 .SPACE  AND
2800 .SLASH  B2
2801 .SLASH  AN
2802 .SLASH  ST
2803 .SLASH  AN
2804 .SLASH  ST
2805
2806 .SPACE  X
2807 .COLON  OR
2808 .SPACE  OR
2809 .SLASH  B2
2810 .SPACE  I
2811 .SLASH  OR
2812 .SLASH  AN
2813 .SPACE  EQ
2814 .SLASH  DV2
2815 .SLASH  ST
2816 .SLASH  OR
2817 .SLASH  ST
2818 .SLASH  OR
2819 .SLASH  OR
2820
2821 .COLON  ST
2822 .SPACE  SET
2823 .COLON  B2
2824 .ARROW  24
2825 .SPACE  Z
2826 .SLASH  IMB
2827 .SLASH  IMB
2828 .COLON  CA
2829 .SPACE  C
2830 .SLASH  TA
2831 .COLON  TM
2832 .SPACE  M
2833 .SLASH  IMB
2834
2835 .COLON  CM
2836 .SPACE  C
2837 .SLASH  TM
2838 .COLON  TA
2839 .SPACE  A
2840 .SLASH  IMB
2841 .SLASH  IMB
2842 .SLASH  IMB
2843 .COLON  CB
2844 .SPACE  C
2845 .SLASH  BIMB
2846 .SLASH  IMB
2847 .SLASH  CA
2848
2849 .SLASH  CA
2850 .SLASH  CM
2851 .SLASH  CM
2852 .SLASH  CB
2853 .SPACE  O
2854 .SLASH  IMB
2855 \f;MORE UUO'S
2856
2857 .COLON  U50
2858 .ARROW  03
2859 .COMMA  OPE
2860 .SLASH  N
2861 .POINT
2862 .POINT
2863 .POINT
2864 .POINT
2865 .COMMA
2866 .COMMA  RENAM
2867 .SLASH  E
2868 .COMMA  I
2869 .SLASH  N
2870 .COMMA  OU
2871 .SLASH  T
2872
2873 .COLON  U703
2874 .ARROW  02
2875 .COMMA  CLOS
2876 .SLASH  E
2877 .COMMA  RELEA
2878 .SLASH  S
2879 .COMMA  MTAP
2880 .SLASH  E
2881 .COMMA  UGET
2882 .SLASH  F
2883 \fIF1,
2884 <
2885         BLOCK   <CLOC+3>/4
2886 >
2887
2888 IF2,
2889 <
2890 IFN     BINC-^D36,
2891 <
2892                 +BINRY
2893 >
2894 >
2895
2896
2897
2898 IFNDEF CLOC.,<CLOC.=CLOC>
2899 IFN CLOC.-CLOC,<PRINTX PHASE ERROR IN OPTABLE>
2900 \f
2901 PNTR:   EXP INST        ;POINTER TO BITS IN INST
2902 INST:   0               ;BINARY FOR INSTRUCTION
2903 CHP:    0               ;CHAR POINTER INTO TXT, TXT+1
2904 TXT:    BLOCK 2         ;STORE INPUT TEXT FOR OPEVAL
2905 SAVPDL: 0               ;SAVE PUSH DOWN LIST POINTER
2906
2907 BTAB:   POINT 9,TBL     ;TABLE USED TO GET NEXT BYTE POINTER
2908         POINT 9,TBL,8   ;FOR TRANSFER BYTE
2909         POINT 9,TBL,17
2910         POINT 9,TBL,26
2911
2912 OPEVAL: MOVE T,OPEV1            ;EVALUATE FOR AN OP CODE
2913         MOVEI W1,SYM
2914         MOVE R,[POINT 7,TXT]
2915         PUSHJ P,SPT4
2916         MOVEI T,0
2917 OPEV1:  IDPB T,R
2918         MOVEM P,SAVPDL
2919         TRZA F,OUTF
2920 OPTYPE: TRO F,OUTF              ;TYPE AN OPCODE SYMBOLICALLY
2921         LSH T,-33
2922         MOVEM T,INST            ;GET OPCODE INTO RIGHT 9 BITS
2923         MOVE T,[XWD 440700,TXT]
2924         MOVEM T,CHP             ;FOR OPEVAL,SETUP POINTER TO INPUT TEXT
2925 DEC:    TRZ F,ITF               ;CLEAR INSTRUCTION TYPED FLAG
2926         CLEARB R,W1
2927         MOVE W2,BTAB
2928 DC1:    ILDB T,W2               ;GET NEXT BYTE IN TBL
2929         CAILE T,40
2930         CAIL T,73
2931         SOJGE R,DC1             ;SKIP OVER # BYTES = C(R)
2932         JUMPG R,DC1             ;SKIP OVER ALPHA TEXT WITHOUT COUNTING
2933         SUBI T,40
2934         JUMPE T,DECX            ;TRANSFER ON ASTOP CODE
2935         JUMPG T,DC2
2936         DPB T,[XWD 340500,PNTR] ;SETUP R ON A DISPATCH BYTE
2937         TRZ T,-4
2938         AOS T
2939         DPB T,[XWD 300600,PNTR]
2940         TRNN F,OUTF
2941         JRST DC6                ;FOR OPEVAL ONLY
2942         LDB R,PNTR              ;GET # BYTES TO SKIP OVER
2943         JRST DC1
2944
2945 DC2:    HRREI T,-33(T)
2946         JUMPL T,DECT            ;TYPE OUT A LETTER
2947         MOVEI W1,FIR.(T)                ;BYTE IS A TRANSFER
2948         IDIVI W1,4
2949         MOVE W2,BTAB(W2)        ;CALCULATE POINTER TO NEXT BYTE
2950         ADDI W2,(W1)
2951         JRST DC1
2952
2953 \f
2954 DECT:   TRNE F,OUTF
2955         JRST DC8        ;TYPE OUT A LETTER
2956         ILDB W1,CHP     ;GET NEXT INPUT LETTER
2957         CAIE W1,133(T)  ;COMPARE WITH ASSUMED NEXT LETTER
2958         JRST NOMAT      ;DOESNT MATCH
2959         JRST DC1        ;MATCHES, TRY NEXT
2960
2961 DECX:   TRNE F,OUTF     ;STOP (CODE 40) HAS BEEN SEEN
2962         POPJ P,         ;IF FOR OUTPUT, RETURN
2963         ILDB W1,CHP     ;GET NEXT INPUT CHAR IF ANY
2964         JUMPE W1,DC7    ;DOES # OF CHARS MATCH
2965 NOMAT:  POP P,R         ;NO, BACK UP AND TRY SOME MORE
2966         POP P,W2
2967         POP P,PNTR
2968         POP P,CHP
2969 NOMAT1: AOS R           ;ASSUME NEXT NUMBER FOR BIN VALUE
2970         DPB R,PNTR      ;STUFF INTO ANSWER
2971         LDB R,PNTR
2972         JUMPN R,DC6AA   ;IF =0, BYTE WAS TOO BIG
2973         CAME P,SAVPDL
2974         JRST NOMAT      ;NOT AT TOP LEVEL
2975         JRST UNDEF      ;UNDEFINED, FINALLY
2976
2977 DC6:    MOVEI R,0       ;ASSUME 0 FOR INITIAL BINARY VALUE
2978         DPB R,PNTR
2979 DC6AA:  CAMN P,SAVPDL
2980         JRST DC6BB
2981         LDB T,-2(P)     ;OLD VALUE OF PNTR
2982         CAME T,(P)
2983         JRST NOMAT1
2984 DC6BB:  PUSH P,CHP
2985         PUSH P,PNTR
2986         PUSH P,W2
2987         PUSH P,R
2988         JRST DC1
2989
2990 DC7:    MOVE P,SAVPDL           ;RESTORE PUSH DOWN POINTER
2991         MOVE T,INST
2992         LSH T,33                ;PUSH BINARY INTO POSITION FOR OPEVAL
2993         LDB R,[POINT 3,T,8]
2994         TLC T,700000
2995         TLCN T,700000
2996         DPB R,[POINT 10,T,12]   ;ONLY DONE FOR IO INSTRUCTIONS
2997         JRST L4
2998
2999 DC8:    TRO F,ITF               ;SET INSTRUCTION TYPED FLAG
3000         MOVEI T,133(T)
3001         PUSHJ P,TOUT            ;OUTPUT A LETTER
3002         CLEARM SPSAV            ;SO $D WONT TRY TO DELETE OP CODES
3003         JRST DC1
3004 \fLIT
3005
3006
3007 IFN EDDT&1&<EDDT>B36,<BUFF:     BLOCK 40>
3008
3009 PS:     BLOCK LPDL
3010
3011 DDTEND=.
3012
3013 END
3014 \f