sw/os8/v3d/sources/extensions/dectapes/dectape1/futil.pa

   1 /FUTIL - FILE UTILITY - V07A
   2
   3 VERSION=07
   4 PATCH="A&77
   5
   6 /       OS/8 FILE UTILITY PROGRAM.  ALLOWS EXAMINATION AND
   7 /  MODIFICATION OF OS/8 MASS STORAGE DEVICES FROM THE CON-
   8 /  SOLE.  DUMPING OF BLOCKS, LISTING OF WORDS AND MODIFICA-
   9 /  TION OF WORDS CAN BE DONE IN 7 FORMATS: OCTAL; SIGNED AND
  10 /  UNSIGNED DECIMAL; UNPACKED, 6-BIT PACKED, XS240 PACKED AND
  11 /  OS/8 PACKED ASCII.  LISTING AND DUMPING CAN ALSO BE DONE
  12 /  IN 5 MORE FORMATS: BCD, BYTE (OCTAL CHARACTER), 2 PSEUDO-
  13 /  SYMBOLIC FORMATS [PDP-8 & FPP-12/8A], AND A COMBINATION
  14 /  FORMAT FOR DIRECTORY DUMPING. PROGRAM USES BOTH COMMAND
  15 /  WORDS AND COMMAND CHARACTERS (LIKE ODT) FOR DIRECTION.
  16
  17 /BY:    JIM CRAPUCHETTES
  18 /       MENLO COMPUTER ASSOCIATES, INC.
  19 /       (FORMERLY: FRELAN ASSOCIATES)
  20 /       P.O. BOX 298
  21 /       MENLO PARK, CALIF. 94025
  22 /
  23 /
  24 /VERSIONS 1 THRU 4 - "XTAPE" FOR THE XSYSTEM,
  25 /  LAST REVISION--APRIL 1970.
  26 /
  27 /VERSION 5 - OS/8 OPERATION, JULY 1972 THRU JUNE 1976
  28 /  "(...)", "C & 'CC AS NUMBERS, IOT DECODING, LIST
  29 /  & DUMP FORMATS, OUTPUT TO LPT:, FILE DATE & LOC
  30 /  IN DIRECTORY, "WORD MEMREF...", BCD OUTPUT,
  31 /  ADDITIONAL ODT OUTPUTS, "BYTE" OUTPUT.
  32 /VERSION 6 - EXPANSION OF OS/8 OPERATION, JUNE 1976:
  33 /  "FILLER" FOR "MODIFY", SEARCH LIMITS CHANGE, "WRITE"
  34 /  WITH AN ARGUMENT, FPP INSTRUCTION DECODING, CHAINING
  35 /  SUPPORT (FOR CCL CALLS), LOAD MODULE HANDLING AND
  36 /  "SHOW HEADER", MULTIPLE DEFAULT EXTENSIONS, ^R FOR
  37 /  RETYPE, SET REPLACES OPTION, NEW OUTPUT ROUTINE FOR
  38 /  "DIRECTORY" FORMAT, LINK OVERLAY HANDLING, ODT CHANGES,
  39 /  EXIT, SCAN, WRITE LOCKED OPERATION, SPEED UP SEARCHES,
  40 /  XS240 FORMATS
  41 /VERSION 6.17 - APR 1, 1977; BATCH OPERATION, COMMENT
  42 /VERSION 6.20 - MAY 16, 1977; NEW DATE, FULL FILE OUTPUT
  43 /   (SET/SHOW DDEV, OPEN ..., CLOSE), OPT ":" ON DEVICES.
  44 /VERSION 6.21 - JUN 4, 1977; NEW INPUT ROUTINE, TEMP STORAGE
  45 /VERSION 6.22 - JUL 13, 1977; CRTL-Q & -S, SCOPE MODE,
  46 /  IF/END COMMANDS, ALPHA DATE.
  47 /
  48 /PREVIOUS VERSIONS HAVE BEEN AVAILABLE THROUGH DECUS,
  49 /  DEC SUPPORT BEGINS WITH VERSION 7 - 20-JUL-77.
  50 \f/      SOME ROUTINES AND IDEAS USED IN THIS PROGRAM WERE
  51 /  DERIVED FROM EDIT-8 AND FOCAL, BY RICK MERRILL, DEC.
  52 /       THE ODT COMMAND SET IS NEARLY IDENTICAL TO THE OS/8
  53 /  ODT COMMAND SET EXCEPT THAT 15 BIT ADDRESSES ARE USED
  54 /  EVERYWHERE AND THERE ARE NO COMMANDS FOR PROGRAM EXECU-
  55 /  TION.
  56 /       THE DOUBLE PRECISION ARITHMETIC ROUTINES ARE A MUCH
  57 /  MODIFIED VERSION OF DECUS 8-115A.
  58
  59
  60 /  ASSEMBLY INFORMATION:
  61 /
  62 /  .R PAL8      [VERSION 9]
  63 /  *FUTIL<FUTIL/L/K/P=6400$
  64 /  .SA ... FUTIL
  65 /
  66 /       THE LISTING FILE REQUIRES ABOUT 725 BLOCKS, THE BIN-
  67 /  ARY FILE ABOUT 35 BLOCKS AND THE CREF LISTING FILE ABOUT
  68 /  960 BLOCKS.  CREFING REQUIRES EITHER "/M" OR "/X" FOR
  69 /  CREF V3.
  70
  71
  72 /MEMORY ALLOCATION:
  73 /
  74 /00000-06310    PROGRAM PROPER
  75 /06310-06577    ARGUMENT STRING BUFFER
  76 /06400-06777    --- ONCE ONLY CODE FOR CHAIN ---
  77 /06600-07177    DDEV HANDLER AREA, 2 PAGES
  78 /07200-07577    DEVICE HANDLER AREA, 2 PAGES
  79 /
  80 /10000-11777    USR AREA & ERROR MESSAGES (SWAPPED)
  81 /12000-12377    CCB/HEADER CODE, OPEN, CLOSE & OUTPUT
  82 /12600-15700    TEXT STRINGS, LISTS
  83 /15700-16377    STRING MASK, COMMAND BUFFERS, PDL
  84 /16400-16577    CCB BUFFER, 1 PAGE
  85 /16600-17177    DDEV BUFFER, 2 PAGES
  86 /17200-17577    I/O BUFFER, 2 PAGES
  87 \f/PAGE 0: POINTERS, CONSTANTS, VARIABLES, SWITCHES, ADDRESSES
  88
  89
  90 *0
  91
  92 OVLFLG, 0       /OVERLAY FLAG FOR SAVE FILES
  93
  94 DPSGN,  0
  95 LASTOP, 0
  96 THISOP, 0
  97
  98 ZBLOCK 3        /USED BY ODT
  99
 100 /VARIABLES & SWITCHES
 101 PDLPT,  0       /P.D.L. POINTER
 102 DPNT,   RUBO-1  /USED UNIVERSALLY (SCOPE INITIALIZATION)
 103 SPNT,   SCOPLS-1 /USED BY 'XSTRIN', 'XSMASK', 'READ', 'TERMT'
 104 SCANX1, BATLS-1 /USED BY 'SORTJ' (BATCH INITIALIZATION)
 105 SCANX2, 0       /USED BY 'XSTRIN'
 106 GETPNT, 0       /USED BY 'GET' & 'BKLOC'
 107 COMIR,  0       /USED FOR USER LINE INPUT
 108 COMOUT, COMB-1  /USED FOR USER LINE SCAN
 109 TYPSW,  0       /ODT COMMAND OCT-SYM SWITCH (0=OCT)
 110 ERMODE, 0       /ERROR MESSAGE MODE SWITCH (0=LONG)
 111
 112 TEMP,   0
 113 TEMP1,  0
 114 TEMP2,  0
 115 TEMP3,  0
 116 ACC1,   0       /24 BIT ACCUMULATORS
 117 ACC2,   0
 118 ACCX1,  0
 119 ACCX2,  0
 120
 121 NAM1=   ACC1    /DEFINITIONS FOR NAME BUFFER:
 122 NAM2=   ACC1+1  /  THESE LOCATIONS ARE USED FOR A
 123 NAM3=   ACC1+2  /  6 CHARACTER FILE (OR DEVICE)
 124 NAM4=   ACC1+3  /  NAME & A 2 CHAR EXTENSION.
 125
 126 OPER1,  0
 127 OPER2,  0
 128
 129 TEMPV1, 0       /24 BIT TEMPORARY STORAGE FOR
 130 TEMPV2, 0       / "SET TEMP ..." & "EVAL T"
 131
 132 CHAR,   0
 133 CNT,    0
 134 CNTR,   0
 135 CNTRA,  0
 136 NCNT,   0       /LINE POSITION COUNTER
 137 FCNT,   0       /FORMAT NUMBER (INIT TO PACKED ASCII)
 138 OUTPNT, PACOUT  /POINTER TO DEFAULT OUTPUT ROUTINE
 139 MODSW,  0       /MODES: NORMAL=0,MAPPED=+,OFFSET=-.
 140 CHARSW, 0       /CHARACTER PACK & UNPACK SWITCH
 141 CRSWT,  0       /= -1 IF GWORD TERMINATOR WAS A SPACE
 142 SHUT,   0       /= -1 IF SOMETHING OPEN
 143 MODIF,  0       /= -1 IF SOMETHING WAS MODIFIED
 144 ABSSW,  0       /ABSOLUTE OR RELATIVE LOCATION FOR SEARCHES
 145 DSWIT,  0       /DUMP SWITCH: "DUMP","LIST" & "SHOW ERR" -> 1
 146 DMODE,  0       /DUMP MODE: NONE=0,PART=1,ALL=4000
 147
 148 CBLK,   0       /= CURRENT BLOCK
 149         0       /DUMMY FOR "SHOW ABS"
 150 CAD,    0       /= CURRENT ADDRESS (0 -> 377)+IOBUF
 151 BLK,    0       /= "BLOCK"
 152 LOCH,   0
 153 LOCL,   0       /= "LOCATION" (DISPLACEMENT)
 154 UBLK,   0       /UPPER LIMIT FOR SEARCHES
 155 ULOCH,  1
 156 ULOCL,  7577
 157 LBLK,   0       /LOWER LIMIT FOR SEARCHES
 158 LLOCH,  0
 159 LLOCL,  200
 160 SBLK,   0       /"LOCATION" FOR "ODT" ROUTINES
 161 SLOCH,  0
 162 SLOCL,  0
 163
 164 OFFSET, 0       /OFFSET
 165 FILLER, 0       /FILLER CONSTANT FOR "MODIFY"
 166 MASK,   -1      /MASK FOR WORD SEARCH
 167 SMASKL, -1      /= -(LENGTH OF SMASK)
 168 RBLK1,  0       /START BLOCK OF FILE
 169 DEVAD,  7607    /DEVICE ENTRY ADDR (INIT TO "SYS")
 170 DEVNO,  1       /DEVICE NUMBER (INIT TO "SYS")
 171 USRAD,  7700    /USR ADDRESS, INITIALIZED TO OUT
 172                 /7700=MSGS IN; 0=NONE IN; 200=USR IN
 173
 174 /CONSTANTS
 175 M400,   -400
 176 M240,   -240
 177 M215,   -215
 178 M200,   -200
 179 M100,   -100
 180 M20,    -20
 181 M10,    -10
 182 M1,     -1
 183 N7,     7
 184 N15,    15
 185 N20,    20
 186 N77,    77
 187 N177,   177
 188 N200,   200
 189 N377,   377
 190 N7000,  7000
 191 N7400=  M400
 192
 193 /ADDRESSES
 194 READLN= JMS I .         /GET NEXT INPUT LINE, WITH
 195         READ            / SPECIAL TERMINATORS
 196 TYPSTI, TYPSTR
 197 TYPSI,  TYPES
 198 TYPECI, TYPEC
 199 TWOCI,  TWOCS
 200 CRLFI,  CRLF
 201 DIGIT=  JMS I .         /OUTPUT AN ASCII DIGIT
 202         DODIG
 203 SPACE1= JMS I .         /OUTPUT 1 SPACE OR ...
 204         DO1SP
 205 SPACE2= JMS I .         /OUTPUT 2 SPACES
 206         DO2SP
 207 CTRLI,  CTRL
 208 TWOT,   PACOUT
 209 TYPEI,  TYPE
 210 DECI,   DPRT
 211 OCTI,   OPRT
 212 DEC2I,  DEC2
 213 PDATEI, PDATE
 214 RTL6I,  RTL6
 215 RTR6I,  RTR6
 216 SOCTI,  OCTSET
 217 BKLOCI, BKLOC
 218 EVALI,  EVAL
 219
 220 PUSH=   JMS I .         /PUSH AC ON P.D.L.
 221         PUSHX
 222 POP=    JMS I .         /POP P.D.L. INTO AC
 223         POPX
 224 CALUSR= JMS I .         /DO USR FUNCTION
 225         USEUSR
 226 TADIDP= JMS I .         /"TAD I DPNT" IN FIELD 1
 227         TIDPNT
 228 TADICAD=  JMS I .       /"TAD I CAD" IN FIELD 1
 229         TICAD
 230 DCAICAD=  JMS I .       /"DCA I CAD" IN FIELD 1
 231         DICAD
 232
 233 GWORDI, GWORD
 234 GARGI,  GARGS
 235 ARGI,   ARG
 236 GETI,   GET
 237 ODGETI, ODGET
 238 GETNI,  GETN
 239 SSKIPI, SSKIP
 240 LIMITI, LIMITS
 241 INCI,   INC
 242 SORTI,  SORTJ
 243 ENDCI,  ENDC
 244 RECRLF, MAIN1-1
 245 RESTAR, MAIN1
 246
 247 ERROR=  JMS I .
 248         XERROR
 249
 250 COMST,  COMB-1
 251 TEMPST, TEMPL-1
 252 MASKBS, SMASKB-1
 253
 254
 255 PAGE
 256 \f/PROGRAM MAIN LOOP AND DRIVER.  COLLECTS CHARACTERS
 257 /INTO COMMAND BUFFER UNTIL END IS REACHED.
 258
 259         DCA USRAD       /CLEAR ON RESTART (NOTHING IN)!
 260         TLS             /RAISE TELETYPE FLAG
 261         DCA SHUT        /NOTHING IS OPEN
 262         JMS I CRLFI     /OUTPUT CR-LF.
 263 MAIN1,  JMS I SOCTI     /SET INPUT TO OCTAL; EXEC 'COMMENT'
 264         DCA DSWIT       /RESET DUMP OUTPUT SWITCH
 265         TAD COMST       /INIT COMMAND BUFFER.
 266         DCA COMIR
 267         TAD (PDLB+1     /INIT PUSH-DOWN-LIST
 268         DCA PDLPT
 269 MAIN2,  READLN          /GET A LINE FROM INPUT.
 270           CCHARL-1      /CR LF ; ! / ALT-
 271           COPSL-CCHARL  / MODES ETC...
 272         JMP MAIN1       /BUFFER WAS EMPTIED.
 273
 274
 275 /ROUTINE TO HANDLE CARRIAGE RETURN.
 276 CRCR,   JMS I ENDCI     /PUT A CR IN BUFFER
 277           JMP CRCRC     /ONLY A CR IN BUFFER
 278         JMS I GWORDI    /GET COMMAND WORD
 279           JMP CRCRN     /BUFFER BEGINS WITH A #
 280         ISZ CRSWT       /WORD ENDED BY A CR?
 281         JMP CRCR1       /YES, ONLY A FEW ARE OK
 282         JMS I SORTI     /NO, LOOK UP COMMAND
 283           CWORDL-1
 284           WOPSL-CWORDL
 285 ERCB,   ERROR           /NOT A LEGAL COMMAND
 286 /
 287 CRCR1,  JMS I SORTI     /"WRITE","REWIND","EXIT" & "COMMENT"
 288           CWORL2-1
 289           WOPSLL-CWORL2
 290 ERCA,   ERROR           /SOMETHING NOT LEGAL
 291 /
 292 CRCRN,  JMS CLOSE       /CLOSE THE OPEN LOCATION IF OPEN
 293 CRCRC,  DCA SHUT        / MARK LOCATION CLOSED
 294         JMP MAIN1
 295
 296 /ROUTINE TO HANDLE SLASH
 297 SLASH,  JMS I ENDCI     /END BUFFER WITH A CR
 298           JMP SLA1      /OPEN LAST, CR ONLY
 299         JMS WCHEK       /DOES LINE START W. A WORD?
 300         JMS I LIMITI    /NO, GET ARG--
 301           SBLK          / & SLOCH & SLOCL
 302 SLA1,   SPACE1          /OUTPUT SPACE
 303 SLO1,   JMS ODTOUT      /GET THE WORD & OUTPUT
 304 SLO2,   SPACE1          /FOLLOWED BY 2 SPACES
 305         SPACE1          /(FOR ";"--OUTPUT ONLY 1 SPACE AND
 306         JMS I ODGETI    / THEN FORCE ACTION & IGNORE VALUE)
 307         STA
 308         JMP CRCRC       /GO MARK LOCATION OPEN
 309
 310 /ROUTINE TO HANDLE ALT MODE & ESCAPE KEYS
 311 ALTMOD, TAD OUTPNT      /USE OUTPUT ROUTINE 'SET' BY
 312         JMP ALTM1       / 'FORMAT' OPTION.
 313
 314 /ROUTINE TO CLOSE A LOCATION, OUTPUT ITS (NEW) CONTENTS IN A
 315 /  SPECIFIED FORMAT AND THEN RE-OPEN.  THE ROUTINE HANDLES:
 316 /  # (BCD), $ (OS/8 ASCII), % (BYTE OCTAL), & (XS240 ASCII),
 317 /  : (SIGNED DECIMAL), < (OCTAL), = (UNSIGNED DECIMAL),
 318 /  > (PDP SYMBOLIC), @ (DATE), [ (ASCII), \ (FPP SYMBOLIC),
 319 /  ] (PACKED ASCII) AND ? (DIRECTORY).
 320 /
 321 OMODES, TAD SCANX1      /'SORTJ' POINTER TO CHAR LIST
 322         TAD (OTABLE-1-CCHARL
 323         DCA DPNT        /POINT INTO ADDR TABLE,
 324         TADIDP          / GET OUTPUT ROUTINE ADDR,
 325 ALTM1,  DCA OMODPT      / & SET POINTER TO ROUTINE.
 326         JMS ECLOSE      /CLOSE THIS LOCATION
 327         SPACE1          /OUTPUT SPACE
 328         DCA CHARSW      /RESET UNPACK SWITCH
 329         JMS I ODGETI    /GET WORD
 330         JMS I OMODPT    /OUTPUT IN DESIRED FORMAT
 331         JMP SLO2        /AND GO REOPEN.
 332 OMODPT, 0
 333
 334 /ROUTINE TO HANDLE BACKARROW.
 335 BACKAR, JMS ECLOSE      /CLOSE THIS LOCATION
 336         TADICAD         /GET THE CONTENTS,
 337         JMP UPARR1      /AND USE THEM AS THE ADDR
 338
 339 /ROUTINE TO HANDLE UPARROW.
 340 UPARR,  JMS ECLOSE      /CLOSE THIS LOCATION
 341         TADICAD         /IS THIS A 'PAGE 0' REF.?
 342         AND N200
 343         SZA CLA
 344         TAD SLOCL       /YES, USE PAGE BITS
 345         AND M200        / MASK PAGE OR 0 TO PAGE #
 346         DCA SLOCL       / & SAVE IT
 347         TADICAD         /GET THE CONTENTS,
 348         AND N177        /AND USE THE ADDRESS BITS.
 349         TAD SLOCL       / ALONG WITH PAGE BITS
 350 UPARR1, DCA SLOCL       /THIS IS 12 BIT ADDR
 351         JMP EXCL2       /NOW GO FINISH
 352 \f/ROUTINE TO HANDLE SEMICOLON, LINE FEED & EXCLAMATION.
 353
 354 SEMIC,  DCA I READLN-4400       /SET NO-OUTPUT SWITCH
 355 LFLF,   STA             /LINE-FEED - CLOSE,INCREMENT,OUTPUT
 356 EXCL,   DCA OMODPT      /EXCLAMATION - CLOSE,DECREMENT,OUTPUT
 357         JMS ECLOSE      /CLOSE THIS LOCATION
 358         IAC
 359         DCA ACC1        /SET UP D.P. INCREMENT
 360         DCA ACC2
 361 EXCL1,  DCA DPSGN       /(FOR SAFETY)
 362         ISZ OMODPT      /INCREMENT OR DECREMENT?
 363         JMS DPNEG       / DECREMENT, NEGATE VALUE
 364         CLL
 365         TAD ACC1
 366         TAD SLOCL       /UPDATE LOCATION TO 15 BITS
 367         DCA SLOCL
 368         RAL
 369         TAD ACC2
 370         TAD SLOCH
 371         AND N7          / (BUT ONLY 15 BITS)
 372         DCA SLOCH
 373         TAD I READLN-4400       / ANY OUTPUT?
 374         SNA CLA
 375         JMP SLO2+1      /  NO, WAS ";" DO ONE SPACE
 376 EXCL2,  JMS I CRLFI     /GIVE CR/LF FOR NEXT LINE
 377         JMS I BKLOCI    /OUTPUT ADDRESS
 378           SBLK-1
 379         JMS I TWOCI     /OUTPUT "\ "
 380           3440
 381         JMP SLO1        /NOW GO OPEN NEXT LOCATION
 382
 383 /ROUTINE TO HANDLE PLUS & MINUS.
 384 PLUS,   STA             /"+", SET SWITCH
 385 MINUS,  DCA OMODPT      /"-", CLEAR SWITCH
 386         JMS I ENDCI     /END BUFFER, TEST
 387           JMP EXCL2     /NO ARG, DO SAME AGAIN
 388         JMS WCHEK       /LINE START WITH A COMMAND?
 389         JMS I ARGI      /NO, GET AN ARG
 390         JMP EXCL1       /UPDATE LOC & GO OPEN
 391
 392
 393 ECLOSE, 0       /SUB. TO CLOSE THE LOCATION IF ARG.
 394         JMS I ENDCI     /END BUFFER WITH A CR.
 395           JMP I ECLOSE  /ONLY A CR IN BUFFER, DONE
 396         JMS WCHEK       /DOES LINE START W. A WORD?
 397         JMS CLOSE       /ARG IN BUFFER, USE IT
 398         JMP I ECLOSE    /DONE
 399
 400 CLOSE,  0       /SUBROUTINE TO CLOSE A LOCATION
 401         JMS I ARGI      /GET ONE ARG
 402         ISZ SHUT        /ANYTHING OPEN?
 403         JMP I CLOSE     /NO, RETURN
 404         JMS I ODGETI    /YES, SET UP THINGS RIGHT
 405         STA
 406         DCA MODIF       /SET MODIFY FLAG
 407         TAD ACC1        /USE "LOC" AS DATA
 408         DCAICAD         /STORE IT
 409         JMP I CLOSE
 410
 411
 412 PAGE
 413 \f/ROUTINE TO 'EVALUATE' A SIGNED DOUBLE PRECISION ARITHMETIC
 414 /  EXPRESSION & OUTPUT THE RESULTS IN OCTAL & D.P. SIGNED
 415 /  DECIMAL.
 416 XVAL,   JMS I EVALI     /GO EVALUATE
 417         SKP             /TERMINATED BY A CR
 418 ERCC,   ERROR           / SORRY!--TOO MANY ")"S
 419         JMS I TWOCI     /"= "
 420           7540
 421         TAD ACC2
 422         JMS I OCTI      /OUTPUT HIGH ORDER IN OCTAL
 423         TAD ACC1
 424         JMS I OCTI      /OUTPUT LOW ORDER IN OCTAL
 425         TAD ACCX1       /SAVE REMAINDER FOR LATER
 426         DCA COMIR
 427         TAD ACCX2
 428         DCA COMOUT
 429         TAD (-7
 430         DCA XERROR      /MUST DEVELOP 7 DIGITS
 431         JMS I TWOCI     /OUTPUT " ("
 432           4050
 433         TAD ACC2        /IS DPAC NEG?
 434         SMA CLA
 435         JMP DLOOP1-1    /NO, OUTPUT " "
 436         JMS DPNEG       /YES, MAKE IT POSITIVE
 437         TAD N15         / AND OUTPUT "-".
 438         SPACE1
 439 DLOOP1, TAD (12         /RESET DIVISOR TO 10(10)
 440         DCA OPER1
 441         DCA OPER2
 442         JMS DDIV        /GO DIVIDE DPAC BY 10(10)
 443         TAD ACCX1       / GET REMAINDER
 444         PUSH            /PUT IT ON PUSH-DOWN-LIST
 445         ISZ XERROR      /DONE YET?
 446         JMP DLOOP1
 447         TAD COMOUT      /YES, RESTORE REMAINDER
 448         DCA ACCX2
 449         TAD COMIR
 450         DCA ACCX1
 451         TAD (-7
 452         DCA XERROR      /NOW SET UP TO OUTPUT 7 DIGITS
 453 DLOOP2, POP             / IN REVERSE ORDER!
 454         DIGIT           /MAKE REMAIN A DIGIT
 455         ISZ XERROR      /DONE?
 456         JMP DLOOP2
 457         JMS I TYPECI    /YES, OUTPUT ")"
 458           ")
 459         JMP I RECRLF    / AND CR/LF
 460
 461
 462 /ERROR ROUTINE
 463 XERROR, 0
 464         CLA             /CLEAR POSSIBLE JUNK FROM AC
 465         DCA DSWIT       /RESET IN CASE DUMP MODE
 466         CDF 0
 467         JMS I TYPECI    /OUTPUT "?"
 468           "?
 469         TAD (ERLIST-1   /INIT LIST POINTER
 470         DCA DPNT
 471         DCA TEMP        /SET CODE TO 0
 472 XERR1,  ISZ TEMP        /BUMP ERROR CODE
 473         TADIDP          /GET AN ADDRESS
 474         SNA
 475         JMP XERR2       /(FOR DEBUGGING)
 476         CMA             /= -(ADDR+1)
 477         TAD XERROR      /DOES IT MATCH THE CALL?
 478         SZA CLA
 479         JMP XERR1       /NO
 480 XERR2,  TAD TEMP        /YES, OUTPUT ERROR CODE
 481         JMS I DEC2I     /  AS 2 DECIMAL DIGITS
 482         JMS I TYPSI     /NOW OUTPUT " AT "
 483           MS17
 484         TAD (-COMB+1    /CALCULATE POSITION IN
 485         TAD COMOUT      / COMMAND BUFFER,
 486         JMS I DEC2I     / & OUTPUT AS 2 DIGITS.
 487         TAD ERMODE      /LONG/SHORT MESSAGES? [NOTE: THIS ->
 488 XERR3,  SZA CLA         / "7600" (A CLA) IF 'USROUT' ERROR!]
 489         JMP XERR4       /SHORT, GO DO CR/LF
 490         JMS USROUT      /LONG, BE SURE MESSAGES ARE IN
 491         SPACE2          /OUTPUT 2 SPACES
 492         TAD TEMP        /CODE = ADDRESS-1 OF ADDRESS
 493         DCA DPNT        / OF MESSAGE
 494         TADIDP          /GET MESSAGE ADDR
 495         JMS I TYPSTI    / OUTPUT MESSAGE
 496 XERR4,  JMS I CRLFI     /OUTPUT A CR,LF PAIR
 497         JMP I .+1       /***    CIF BAT         /BATCH OPER.
 498           MAIN1         /***    JMP I N7000     /'BATABT'!
 499
 500
 501 USEUSR, 0       /USR CALLER SUBROUTINE (FROM EITHER FIELD!)
 502         DCA USRSAV      /SAVE CONTENTS OF AC
 503         RDF
 504         TAD UCDF0       /SET UP RETURN FIELD (FOR 2ND USR CALL)
 505         DCA USRCDF
 506 UCDF0,  CDF 0           /SET TO HERE FOR 1ST CALL
 507         TAD USRAD       /IS USR IN OR OUT?
 508         SMA SZA CLA
 509         JMP USRIN       /IN, GO TO IT
 510         CIF 10
 511         JMS I M100      /OUT, DO "USRIN" FUNCTION
 512           10
 513         TAD N200
 514         DCA USRAD       / & SO INDICATE
 515 USRIN,  CDF CIF 10
 516         TAD USEUSR      /MOVE RETURN ADDRESS TO THE
 517         DCA I N200      / USR ENTRY POINT
 518 USRCDF, CDF             /SET UP D.F. FOR RETURN
 519         TAD USRSAV      /RESTORE AC CONTENTS
 520         JMP I (201      / & FAKE A CALL TO IT
 521 USRSAV,
 522
 523 USROUT, 0       /SUBROUTINE TO REMOVE USR BY RECALLING
 524 ERC15,  TAD USRAD       / ERROR MESSAGES FROM SCRATCH
 525         SPA CLA         / BLOCKS ON SYS.
 526         JMP I USROUT    /JUST EXIT IF PRESENT...
 527         TAD M100
 528         DCA USRAD       /SET USR TO "OUT"
 529         JMS I (7607     /READ IN THE MESSAGES
 530           610           / 6 PAGES TO FIELD 1
 531           0             / STARTING AT LOC 10000
 532           27            / FROM SCRATCH BLKS
 533           SKP CLA       /!!! ERROR !!!
 534         JMP I USROUT    /OK, JUST EXIT
 535         TAD M200
 536         DCA XERR3       /NO MORE MESSAGES ON ERROR!
 537         TAD ERC16
 538         DCA ERC15       /AND NO MORE "SHOW ERROR"!
 539 ERC16,  ERROR           /TELL THE HORRIBLE STORY!
 540
 541
 542 PAGE
 543 \f/ROUTINE TO EXECUTE THE BLOCK 'SCAN' COMMAND
 544 XSCAN,  JMS I GARGI     /GET ARGS CONVERTED
 545         TAD (SCANER     / & SET UP FOR SCANNING
 546         JMP XDUM0
 547
 548 /ROUTINE TO EXECUTE THE BLOCK 'DUMP' COMMAND
 549 XDUMP,  TAD MODSW       /MAPPED MODE?
 550         SMA SZA CLA
 551 ERC14,  ERROR           /YES, DUMP IS MEANINGLESS!
 552         JMS XDLCOM      /DO COMMON STUFF
 553         TAD (LLIST      / & SET UP FOR DUMPING
 554 XDUM0,  DCA XGFORM      /SET OUTPUT ROUTINE--DUMP/SCAN
 555 XDUM1,  ISZ DPNT        /SKIP FIRST WORD
 556         ISZ DPNT        /SKIP A WORD
 557         TAD I DPNT      /GET NEXT START BLOCK.
 558         JMS BLKTST
 559         TAD I DPNT      /GET NEXT -(# BLOCKS)
 560         DCA TEMP1
 561 XDUM2,  JMS I CTRLI     /TEST HERE FOR 'SCAN' TERMINATE
 562         DCA LOCL        /SET LOC TO 0
 563         DCA LOCH
 564         TAD M400        /SET TO -400(8) [1 BLOCK]
 565         JMS I XGFORM    /DUMP OR SCAN A BLOCK
 566         ISZ BLK         /INCREMENT BLOCK NUMBER
 567         ISZ TEMP1       /DONE?
 568         JMP XDUM2       /NO, DO NEXT BLOCK
 569         ISZ TEMP        /YES, ARE ALL ARGS DONE?
 570         JMP XDUM1       /NO, DO NEXT
 571         JMP XLIS2       /YES, DONE--RESET SWITCH
 572
 573 /ROUTINE TO EXECUTE THE LOCATION 'LIST' COMMAND
 574 XLIST0, JMS XDLCOM      /DO COMMON STUFF
 575 XLIS1,  TAD I DPNT      /GET BLOCK #
 576         JMS BLKTST      /TEST & SET BLK
 577         TAD I DPNT      /GET & SET LOCATION
 578         DCA LOCH
 579         TAD I DPNT
 580         DCA LOCL
 581         TAD I DPNT      /GET -(# WORDS)
 582         JMS LLIST       /NOW GO DO IT
 583         ISZ TEMP        /ARE ALL ARGS USED?
 584         JMP XLIS1       /NO, CONTINUE
 585 XLIS2,  DCA DSWIT       /RESET DUMP SWITCH
 586         JMP I RECRLF    / DO CR/LF & CONTINUE
 587
 588 /COMMON SUBROUTINE FOR 'XDUMP'&'XLIST0'
 589 XDLCOM, 0
 590         TAD OUTPNT      /INITIALIZE DEFAULTS
 591         DCA LISTPT
 592         TAD OUTSW
 593         DCA LOUTSW
 594         JMS XGFORM      /GET FORMAT, IF ANY
 595         NOP             /RETURN FOR NO FORMAT
 596         JMS I GARGI     /GET ARGS
 597         ISZ DSWIT       /SET DUMP SWITCH
 598         JMP I XDLCOM
 599
 600 /SUBROUTINE TO OUTPUT -[C(AC)] WORDS FROM THE DEVICE
 601 /BEGINNING AT BLK.LOC IN THE SPECIFIED FORMAT
 602 LLIST,  0
 603         DCA CNTRA       /SET UP -# WORDS TO LIST
 604         DCA CHARSW      /RESET UNPACK SWITCH
 605 LLIS1,  JMS I CRLFI
 606         TAD LOCL
 607         AND N7          /SET UP # ON THIS LINE
 608         DCA CNTR
 609         TAD LOUTSW      /IF CHARACTER OUTPUT,
 610         SNA CLA
 611         TAD M10         / DOUBLE # WORDS/LINE
 612         TAD CNTR
 613         TAD M10
 614         DCA CNTR
 615         JMS I BKLOCI    /OUTPUT LOCATION
 616           BLK-1
 617         JMS I TYPSI     /OUTPUT ":   "
 618           MS13
 619 LLIS2,  JMS I GETI      /GET A WORD
 620           JMP LLIS3     /FILE MODE, NO SUCH ADDR..
 621         JMS I LISTPT    /OUTPUT IT
 622         TAD LOUTSW      /TEST MODE SWITCH
 623         SPA
 624         JMP LLIS5       /"SYMBOLIC", CR/LF NOW
 625         SZA CLA         /CHARACTERS, NO SPACES
 626         SPACE2          /NUMBERS, TWO SPACES
 627 LLIS3,  JMS I INCI      /INCREMENT LOC
 628         ISZ CNTRA       /ALL WORDS DONE?
 629         JMP LLIS4       /NO
 630         JMS I CRLFI
 631         JMP I LLIST     /YES, RETURN
 632 /
 633 LLIS4,  ISZ CNTR        /ALL DONE WITH THIS LINE?
 634         JMP LLIS2       /NOT YET
 635         JMP LLIS1       /YES, OUTPUT CR/LF & CONTINUE
 636 /
 637 LLIS5,  STA
 638         DCA CNTR        /FORCE A CR/LF
 639         JMP LLIS3
 640 LISTPT, 0
 641 LOUTSW, 0
 642
 643
 644 /SUBROUTINE TO GET A FORMAT FOR 'XFORM' & 'XDLCOM'
 645 XGFORM, 0
 646         JMS I GWORDI    /GET A WORD
 647           JMP I XGFORM  /NOT FOLLOWED BY A WORD
 648         JMS I SORTI     /LOOK UP WORD
 649           FORML-1
 650           FOPSL-FORML
 651 ERCD,   ERROR           /WORD NOT RECOGNIZED
 652 /
 653 XFSYM,  STL RAR         /"SYMBOLIC"; SWITCH NEG
 654 XFNUM,  IAC             /NUMERIC; SWITCH POS
 655 XFCHR,  DCA LOUTSW      /CHARACTER; SWITCH 0
 656         TAD SCANX1      /'SORTJ' POINTER TO CHAR
 657         TAD (-FORML     /CALCULATE FORMAT #
 658         CLL RAR         /(DIVIDE BY 2)
 659         DCA TEMP1       / & SAVE IT.
 660         TAD TEMP1
 661         TAD (FTABLE-1
 662         DCA DPNT
 663         TADIDP
 664         DCA LISTPT      /SET UP OUTPUT POINTER
 665         ISZ XGFORM      /BUMP RETURN ADDRESS
 666         JMP I XGFORM
 667
 668 /ROUTINE TO 'SET' THE 'FORMAT' OPTION
 669 XFORM,  JMS XGFORM      /GET FORMAT WORD
 670 ERCE,   ERROR           /NUMBER?!  SORRY ABOUT THAT!
 671         TAD LOUTSW      /OK, SET UP DEFAULTS:
 672         DCA OUTSW       /  SWITCH,
 673         TAD LISTPT
 674         DCA OUTPNT      /  ROUTINE POINTER,
 675         TAD TEMP1
 676         DCA FCNT        /  & FORMAT #
 677         JMP XSETN
 678 OUTSW,  0       /MODE:0=NOTHING,+=SPACES,-=CR/LF
 679
 680
 681 PAGE
 682 \f/ROUTINE TO EXECUTE THE 'OPEN' COMMAND.
 683 XOPEN,  STA             /"." LEGAL IN FILE NAME
 684         JMS GNAME       /GET FILE NAME FOR OUTPUT
 685         CIF 10
 686         JMP XOPEN1      /NOW GO TO FIELD 1 TO HANDLE
 687
 688
 689 /ROUTINE TO EXECUTE THE 'CLOSE' COMMAND.
 690 XCLOSE, CDF CIF 10
 691         JMP XCLOS1      /ALL CODE IS IN FIELD 1
 692
 693
 694 /ROUTINE TO EXECUTE THE 'FILE' COMMAND.
 695 XFIERR, TAD TEMP1       /MADE ALL POSSIBLE ATTEMPTS
 696         SMA CLA         / AT EXTENSION RETRIES?
 697         JMP XFIOUT      / YES, ALL TRIES DONE!
 698         ISZ DPSGN       /THIS WILL SKIP ON 1ST FAIL
 699         ISZ TEMP1       /THIS WILL SKIP ON 2ND FAIL
 700         TAD (1404       / 2ND TRY--USE "LD" EXTEN
 701         DCA NAM4        / 3RD TRY--USE NULL EXTEN
 702         JMP XFICHN+2    /  3RD TRY IS FINAL FAILURE
 703 /
 704 XFIOUT, JMS PNAME       /OUTPUT FILE NAME &
 705         JMS I TYPSI     /"LOOKUP FAILED"
 706           MS15
 707 /
 708 XFILEN, JMS I CRLFI     /OUTPUT CR/LF
 709         ISZ CRSWT       /WAS LAST ENDED BY A CR?
 710         JMP I RESTAR    /YES, DONE
 711 XFILE,  STA             /"." LEGAL IN FILE NAME
 712         JMS GNAME       /GET NEXT FILE NAME
 713 XFICHN, STA
 714         DCA DPSGN       /SET TRY AGAIN SWITCH
 715         TAD (NAM1       /INIT POINTER TO NAME
 716         DCA FSTBLK
 717         TAD DEVNO       /GET DEVICE #
 718         CALUSR
 719           2             /LOOKUP
 720 FSTBLK,   0     /NAME PNTR, BECOMES ST BLK
 721 FBKLEN,   0     / BECOMES -(FILE LENGTH)
 722         JMP XFIERR      /LOOKUP FAILED
 723         TAD FSTBLK
 724         DCA RBLK1       /SET UP PAGE 0 ST BLK
 725         CDF 10
 726         DCA I (CCBB     / & RESET CCBB
 727         TAD I (1404     /GET # ADD'L INFO WORDS
 728         DCA GDEV2       / (NEGATIVE) & SAVE IT
 729         TAD GDEV2
 730         TAD I (17       /POINT TO FIRST OF THEM
 731         DCA GDEV3       / (THE DATE, IF PRESENT)
 732         TAD I N7        /GET THE NUMBER OF THE
 733         AND N7          / DIRECTORY SEGMENT IN
 734         DCA CNTR        / CORE & SAVE IT.
 735         TAD GDEV2       /WAS # OF ADD'L WRDS = 0?
 736         SZA CLA
 737         TAD I GDEV3     / NO, GET THE DATE WORD
 738         CDF 0
 739         DCA GDEV1       /STORE DATE OR 0 (NO DATE)
 740         JMS PNAME       /OUTPUT FILE NAME
 741         TAD FSTBLK
 742         JMS I OCTI      /OUTPUT ST. BLK. IN OCTAL
 743         JMS I TYPECI
 744           "-
 745         TAD FBKLEN      /CALCULATE LAST BLK #
 746         CMA
 747         TAD FSTBLK
 748         JMS I OCTI      / & OUTPUT IN OCTAL
 749         SPACE2          /OUTPUT 2 SPACES
 750         TAD FBKLEN
 751         CIA
 752         JMS I OCTI      /OUTPUT LENGTH IN OCTAL
 753         JMS I TWOCI     /" ("
 754           4050
 755         TAD FBKLEN
 756         CIA
 757         JMS I DECI      / & AGAIN IN DECIMAL
 758         JMS I TYPSI     /")  "
 759           MS33
 760         TAD CNTR        /GET SEGMENT #
 761         JMS I RTL6I     / & PUT IN BITS 3-5
 762         JMS I TWOCI     / TO OUTPUT IT & "."
 763           6056
 764         TAD GDEV3       /GET ADDR OF 1ST ADD'L WRD
 765         TAD (-1400-4    / FOR OFFSET OF NAME START
 766         JMS OCT3        /OUTPUT LOCATION IN SEG
 767         SPACE2          / & TWO SPACES
 768         TAD GDEV1       /GET DATE WORD
 769         SZA             /IS IT = 0?
 770         JMS I PDATEI    /NO, OUTPUT DATE
 771         JMP XFILEN      /NOW OUTPUT CR/LF & CONTINUE
 772
 773
 774 /ROUTINE TO 'SET' THE 'DEVICE' OPTION
 775 XDEV,   JMS GDEVICE     /GET & FETCH DEVICE HANDLER
 776           DEVHAN+1      / (2 PAGE HANDLER IS OK)
 777         DCA DEVAD       /SET UP HANDLER ADDRESS
 778         TAD GDEV2       /SAVE DEVICE #
 779         DCA DEVNO
 780         DCA RBLK1       / & NO FILE KNOWN
 781         DCA SHUT        / & NOTHING OPENED
 782         DCA MODIF       / & NOTHING MODIFIED
 783         TAD NAM1
 784         CIF 10
 785         JMP XDEVM       /GO FINISH SETUP IN FIELD 1
 786
 787
 788 /ROUTINE TO 'SET' THE 'DDEV' OPTION
 789 XDDEV,  JMS GDEVICE     /GET & FETCH DEVICE HANDLER
 790           DMPHAN+1      / (2 PAGE HANDLER IS OK)
 791         CIF 10
 792         JMP XDDEV1      /GO TO FIELD 1 TO FINISH SETUP
 793
 794 GDEVICE,0       /SUBROUTINE TO GET DEVICE NAME & FETCH HANDLER
 795         JMS GNAME       /GET DEV NAME ("." ILLEGAL)
 796         TAD NAM1        /MOVE NAME TO CALL
 797         DCA GDEV1
 798         TAD NAM2
 799         DCA GDEV2
 800         TAD I GDEVICE   /GET HANDLER SPACE ADDRESS
 801         ISZ GDEVICE
 802         DCA GDEV3
 803         CALUSR
 804           1             /FETCH HANDLER
 805 GDEV1,    0
 806 GDEV2,    0
 807 GDEV3,    0
 808 ERCY,   ERROR           /NO SUCH HANDLER
 809         TAD GDEV3       /RETURN HANDLER ADDRESS
 810         JMP I GDEVICE
 811
 812
 813 PAGE
 814 \f/ROUTINE TO EXECUTE THE 'SHOW' COMMAND
 815 XSHBLK, JMS I TYPSI     /"BLOCK = "
 816           MS32
 817         TAD RBLK1       /OUTPUT BLOCK IN OCTAL
 818 XSTYPE, JMS I OCTI
 819 XSHCR,  JMS I CRLFI     /GIVE A CR & LF
 820         DCA DSWIT       /BE SURE SWITCH IS RESET
 821         ISZ CRSWT       /LAST WORD ENDED BY CR?
 822         JMP I RESTAR    /YES, DONE
 823 XSHOW,  JMS I GWORDI    /GET A WORD
 824           JMP ERCG      /NUMBERS NOT RECOGNIZED
 825         JMS I SORTI     /LOOK IT UP
 826           SHOWL-1
 827           SHOWOP-SHOWL
 828 ERCG,   ERROR           /NOT FOLLOWED BY LEGAL WORD
 829
 830 XSHVER, JMS I TYPSI     /"VERSION = <VERSION><PATCH>"
 831           MSVER
 832         JMP XSHCR
 833
 834 XSHMSK, JMS I TYPSI     /"MASK = "
 835           MS02
 836         TAD MASK
 837         JMP XSTYPE
 838
 839 XSHOFF, JMS I TYPSI     /"OFFSET = "
 840           MS09
 841         TAD OFFSET
 842         CIA
 843         JMP XSTYPE
 844
 845 XSHFIL, JMS I TYPSI     /"FILLER = "
 846           MS37
 847         TAD FILLER
 848         JMP XSTYPE
 849
 850 XSHODL, JMS I TYPSI     /"ODT  LOC = "
 851           MS12
 852         JMS I BKLOCI    /OUTPUT IT
 853           SBLK-1
 854         JMP XSHBKS
 855
 856 XSHREL, JMS I TYPSI     /"REL. LOC = "
 857           MS20
 858         JMS I BKLOCI    / & OUTPUT IT
 859           BLK-1
 860         JMP XSHBKS
 861
 862 XSHABS, JMS I TYPSI     /"ABS. LOC = "
 863           MS03
 864         TAD CAD         /OUTPUT LOCATION IN BLOCK
 865         TAD (-IOBUF
 866         DCA CAD
 867         JMS I BKLOCI
 868           CBLK-1
 869 XSHBKS, TAD MODIF       /HAS BLOCK BEEN MODIFIED?
 870         SMA CLA
 871         JMP XSHCR       / NO, SAY NOTHING!
 872         JMS I TYPSI     /  YES, SAY " MOD"
 873           MSMOD
 874         JMP XSHCR
 875
 876 XSHUPP, JMS I TYPSI     /"UPPER = "
 877           MS04
 878         JMS I BKLOCI    /OUTPUT IN BLOCK.LOC FORM
 879           UBLK-1
 880         JMP XSHCR
 881
 882 XSHLOW, JMS I TYPSI     /"LOWER = "
 883           MS05
 884         JMS I BKLOCI
 885           LBLK-1
 886         JMP XSHCR
 887
 888 XSHFMT, JMS I TYPSI     /"FORMAT = "
 889           MS06
 890         TAD FCNT
 891         TAD (FMTLS-1    /SET UP FOR CORRECT TITLE
 892 XSHFM,  DCA DPNT
 893         TADIDP          /GET MESSAGE ADDRESS
 894         JMS I TYPSTI    /OUTPUT DESCRIPTOR
 895         JMP XSHCR
 896
 897 XSHMOD, JMS I TYPSI     /"MODE = "
 898           MS10
 899         TAD MODSW       /GET CORRECT MESSAGE
 900         TAD (MODELS-1   /(OFFSET INTO TABLE)
 901         JMP XSHFM       /GET ADDRESS & OUTPUT
 902
 903 XSHOUT, JMS I TYPSI     /"OUTPUT = "
 904           MS30
 905         TAD TYPSW       /SET UP MESSAGE ADDRESS
 906         TAD (OUTLS-1    /(OFFSET INTO TABLE)
 907         JMP XSHFM
 908
 909 XSHSMS, JMS I TYPSI     /"SMASK = "
 910           MS07
 911         TAD SMASKL
 912         DCA TEMP        /-# TO OUTPUT
 913         TAD MASKBS
 914         DCA DPNT        /SET UP TO OUTPUT
 915         TAD M10         /SET LINE LENGTH
 916         DCA TEMP1
 917         JMP XSHSM2
 918 XSHSM1, JMS I TWOCI     /OUTPUT ", "
 919           5440
 920         ISZ TEMP1       /ENOUGH ON THIS LINE?
 921         JMP XSHSM2      /NO, OK
 922         JMS I CRLFI     /YES, OUTPUT CR-LF
 923         SPACE2          / & 2 SPACES
 924         STA             /MAKE LINE 1 LONGER
 925         JMP XSHSM1-3    /AND RESET LENGTH
 926 /
 927 XSHSM2, TADIDP          /GET NEXT VALUE
 928         JMS I OCTI      / & OUTPUT IT
 929         ISZ TEMP        /ENOUGH?
 930         JMP XSHSM1
 931         JMP XSHCR       /OK, GET NEXT WORD
 932
 933 XSHDEV, JMS I TYPSI     /"DEVICE = XXXX"
 934           MSDEV
 935         JMS I TWOCI     /NOW OUTPUT " ("
 936           4050
 937         TAD DEVNO       /GET THE DEVICE #
 938         JMS I DEC2I     / & OUTPUT AS 2 DIGITS
 939         JMS I TYPECI    /FINALLY OUTPUT ")"
 940           ")
 941         JMP XSHCR
 942
 943 XSHDDEV,JMS I TYPSI     /"DDEV = XXXX"
 944           MSDDEV
 945         JMP XSHCR
 946
 947
 948 FPRNT,  0       /PRINT FIELD DIGIT FROM BITS 6-8
 949         RTR             /MOVE TO BITS 9-11
 950         RAR
 951         AND N7          /MASK TO 1 DIGIT
 952         DIGIT           / & OUTPUT IN ASCII
 953         JMP I FPRNT
 954
 955
 956 PAGE
 957 \f/CONTINUATION OF 'SHOW' COMMAND
 958
 959 /SHOW 'CCB' HANDLER
 960 XSHCCB, CDF CIF 10
 961         JMS GCCB        /SET UP CCB FOR FILE
 962         DCA DPSGN       / & SET UP SEGMENTS
 963         JMS I TYPSI     /"CCB:"
 964           MS11
 965         JMS CCHDST      /DO SETUP, OUTPUT START
 966         JMS I TYPSI     /", JSW = "
 967           MS19
 968         JMS NXTOCT      /OUTPUT J.S.W. IN OCTAL
 969         JMS I CRLFI
 970         JMS I TYPSI     /"  CORE SEGS:   "
 971           MS14
 972 XSHCC1, TAD (-4
 973         DCA CNTR        /-#/LINE
 974 XSHCC2, TADIDP          /GET ORIGIN WORD
 975         DCA TEMP1
 976         TADIDP          / & COUNT WORD
 977         DCA TEMP2
 978         TAD TEMP2       /GO OUTPUT START FIELD
 979         JMS FPRNT
 980         TAD TEMP1       / & START ADDR
 981         JMS I OCTI
 982         JMS I TYPECI    / & A "-"
 983           "-
 984         TAD TEMP2       /OUTPUT FIELD AGAIN
 985         JMS FPRNT
 986         TAD TEMP2       / PAGE COUNT -> PAGES
 987         CLL RAL
 988         AND M200        /MASK OFF FIELD DATA
 989         TAD TEMP1       /ADD ORIGIN ADDR
 990         TAD M1          / & SUBTRACT 1 FOR END
 991         JMS I OCTI      /OUTPUT END ADDR IN OCTAL
 992         ISZ DPSGN       /DONE?
 993         JMP XSHCC4      /NO
 994         TAD OVLFLG      /YES, OVERLAYS? (LINK OUTPUT)
 995         SNA
 996         JMP XSHCR       / NO, DONE
 997         DCA DPNT        / YES, RESET POINTER
 998         JMP XSHHD1      /  & CONTINUE
 999 /
1000 XSHCC4, JMS I TWOCI     /OUTPUT SEPARATOR
1001           5440
1002         ISZ CNTR        /DONE ON THIS LINE?
1003         JMP XSHCC2      /NO
1004         JMS I CRLFI     /YES
1005         SPACE2          /ADD 2 SPACES
1006         STA             /AND 1 MORE ITEM PER LINE
1007         JMP XSHCC1
1008
1009 /SHOW 'HEADER' HANDLER
1010 XSHHDR, CDF CIF 10
1011         JMS GHDR        /SET UP HEADER FOR MODULE
1012         JMS I TYPSI     /"HEADER:"
1013           MS38
1014         JMS CCHDST      /DO SETUP, OUTPUT START
1015         JMS I TYPSI     /", NEXT WORD = "
1016           MS39
1017         TADIDP          /GET FIELD DIGIT
1018         DIGIT           / & OUTPUT
1019         JMS NXTOCT      /FOLLOWED BY ADDRESS
1020         JMS I TYPSI     /", LOAD VER = "
1021           MS40
1022         JMS NXTOCT      / & OUTPUT VERSION
1023         TADIDP          /GET E.P. FLAG
1024         SNA CLA
1025         JMP XSHHD1      / NO E.P.
1026         JMS I TYPSI     /", EP REQ'D"
1027           MS41
1028 XSHHD1, JMS I CRLFI     /TO THE NEXT LINE
1029         JMS I TYPSI     /"  OVLYS START...
1030           MS42
1031 XSHHD2, TADIDP          /GET NUMBER OF OVERLAYS
1032         SNA             / FOR THIS LEVEL
1033         JMP XSHCR       / 0 = END, DONE
1034         DCA TEMP1       /SAVE IT
1035         JMS I CRLFI     /OUTPUT A CR/LF
1036         SPACE2          / AND 4 SPACES
1037         SPACE2
1038         TAD TEMP1
1039         JMS I DEC2I     /# OVLYS IN DECIMAL
1040         SPACE2
1041         TADIDP          /GET MEMORY START WORD
1042         DCA TEMP2
1043         TAD TEMP2
1044         JMS FPRNT       /OUTPUT START FIELD
1045         TAD TEMP2
1046         AND M400        / & DOUBLE-PAGE
1047         JMS I OCTI
1048         SPACE2
1049         JMS NXTOCT      /OUTPUT RELATIVE BLOCK
1050         SPACE2
1051         JMS NXTOCT      /OUTPUT OVERLAY LENGTH
1052         JMP XSHHD2      /AND DO ANOTHER ROUND!
1053
1054 /SHOW 'ERRORS' HANDLER
1055 XSHERR, JMS USROUT      /BE SURE MESSAGES ARE IN
1056         ISZ DSWIT       /SET DUMP SWITCH
1057         JMS I TYPSI     /"ERRORS:  FUTIL VERSION ..."
1058           MSERR
1059         JMS I CRLFI
1060         CLA IAC
1061         DCA DPNT        /SET POINTER & CODE
1062 XSHER1, JMS I CRLFI     /DO ANOTHER CR/LF
1063         TAD DPNT        /TEST FOR LAST REAL MESSAGE
1064         TAD (-EMSEND    /(NOT DEBUG MESSAGE!)
1065         SNA CLA
1066         JMP XSHCR
1067         TAD DPNT        /OUTPUT ERROR CODE
1068         JMS I DEC2I     / AS 2 DIGITS
1069         JMS I TYPSI     /THEN " =  "
1070           MS01
1071         TADIDP          /GET ADDR OF MESSAGE AND
1072         JMS I TYPSTI    / OUTPUT IT
1073         JMP XSHER1
1074
1075
1076 CCHDST, 0
1077         JMS I CRLFI
1078         JMS I TYPSI     /"  SA = "
1079           MS18
1080         TAD (CCBB
1081         DCA DPNT        /SET UP POINTER TO DATA
1082         TADIDP          /GET 2ND WORD FROM CCB/HDR
1083         JMS FPRNT       /IT HAS START FIELD SO OUTPUT
1084         JMS NXTOCT      / FOLLOWED BY START ADDR
1085         JMP I CCHDST
1086
1087
1088 PAGE
1089 \f/ROUTINE TO EXECUTE THE 'SET' COMMAND
1090 XSETN,  ISZ CRSWT       /WAS LAST INFO ENDED BY CR?
1091         JMP I RESTAR    /YES, DONE
1092 XSET,   JMS I GWORDI    /GET OPTION WORD
1093           JMP XSET1     /NO NUMBERS PLEASE!
1094         ISZ CRSWT       /WAS WORD ENDED BY A CR?
1095 ERCK,   ERROR           /YES, ILLEGAL HERE
1096         JMS I SORTI     /LOOK UP WORD
1097           SETLST-1
1098           SETJMP-SETLST
1099 XSET1,  ERROR           /WHAT???
1100
1101
1102 /ROUTINE TO 'SET' THE 'DMODE' (DUMP MODE)
1103 XDMODE, JMS I GWORDI    /GET A WORD
1104           JMP ERC11     /NO NUMBERS HERE!
1105         JMS I SORTI     /LOOK IT UP
1106           XDMLST-1
1107           XDMOPS-XDMLST
1108 ERC11,  ERROR           /NO LIKEE!!
1109 /
1110         CLL STA RAR     /4000: 'ALL' (ECHO TO TTY & FILE)
1111 XDMODS, IAC             /   1: 'PART' (ONLY DUMP,LIST,ETC)
1112         DCA DMODE       /   0: 'NONE' (TTY ONLY)
1113         JMP XSETN
1114
1115
1116 /ROUTINE TO 'SET' THE 'OUTPUT' OPTION
1117 XOUTS,  JMS I GWORDI    /GET OPTION WORD
1118           JMP ERCL      / # IN THE BUFFER
1119         JMS I SORTI     /LOOK IT UP
1120           XOLST-1
1121           XOOPS-XOLST
1122 ERCL,   ERROR           /NOT FOLLOWED BY LEGAL WORD
1123 /
1124         CLL STA RAL     /-1: 'FPP' (SYMBOLIC)
1125 XOUTS1, IAC             /+1: 'PDP' (SYMBOLIC)
1126         DCA TYPSW       / 0: 'OCTAL'
1127         JMP XSETN
1128
1129
1130 /ROUTINE TO 'SET' THE 'MASK' OPTION
1131 XMASK,  JMS I ARGI      /GET ONE ARG
1132         TAD ACC1        /GET 'LOC'
1133         DCA MASK        / & SET MASK
1134         JMP XSETN
1135
1136
1137 /ROUTINE TO 'SET' THE 'OFFSET' OPTION
1138 XOFFS,  JMS I ARGI      /GET ONE ARG
1139         TAD ACC1        /GET #
1140         CIA
1141         DCA OFFSET      /SET IT
1142         JMP XSETN
1143
1144
1145 /ROUTINE TO 'SET' THE 'ERROR' (MODE) OPTION
1146 XEMODE, JMS I GWORDI    /GET WORD
1147           JMP ERCZ      /NO NUMBERS ALLOWED!!!
1148         JMS I SORTI     /LOOK IT UP
1149           XELST-1
1150           XEOPS-XELST
1151 ERCZ,   ERROR           /ILLEGAL SOMETHING
1152 /
1153 XEMOD1, IAC             /'SHORT'
1154         DCA ERMODE      /'LONG'
1155         JMP XSETN
1156
1157
1158 /ROUTINE TO 'SET' THE 'UPPER' LIMITS OPTION
1159 XUPP,   JMS I LIMITI    /UPPER, GET ARGS
1160           UBLK
1161         JMP XSETN
1162
1163 /ROUTINE TO 'SET' THE 'LOWER' LIMITS OPTION
1164 XLOW,   JMS I LIMITI    /LOWER, GET ARGS
1165           LBLK
1166         JMP XSETN
1167
1168 /ROUTINE TO 'SET' THE 'MODE' OPTION
1169 XMODE,  JMS I GWORDI    /GET OPTION WORD
1170           JMP ERCJ      /NUMBER IN BUFFER, BAIL OUT
1171         JMS I SORTI     /LOOK IT UP
1172           MODLST-1
1173           MODOPS-MODLST
1174 ERCJ,   ERROR           /NOT RECOGNIZED
1175 /
1176         CLL STA RTL     /-1: OFFSET
1177 XMODS,  IAC             /+2: LOAD (MODULE)
1178         IAC             /+1: SAVE (FILE)
1179         DCA MODSW       / 0: NORMAL
1180         JMP XSETN
1181
1182 /ROUTINE TO 'SET' THE 'FILLER' OPTION
1183 XFILL,  JMS I ARGI      /GET ONE ARG
1184         TAD ACC1
1185         DCA FILLER      / & SET AS FILLER
1186         JMP XSETN
1187
1188 /ROUTINE TO 'SET' THE 'TEMP' STORAGE
1189 XTEMP,  JMS I ARGI      /GET THE 24 BIT ARG (EXPRESSION!)
1190         TAD ACC1        /NOW SAVE THE 24 BITS FOR LATER
1191         DCA TEMPV1
1192         TAD ACC2        /GET IT BACK WITH "EVAL T"
1193         DCA TEMPV2      / (OR IN AN EXPRESSION)
1194         JMP XSETN
1195
1196
1197 /ROUTINE TO EXECUTE THE 'IF' COMMAND
1198 XIF,    JMS I EVALI     /EVALUATE THE EXPRESSION
1199           SKP           / TERMIN = CR, OK
1200         JMP ERCC        / TOO MANY PARENS
1201         TAD ACC1        /TEST THE 24-BIT VALUE FOR ZERO
1202         SNA
1203         TAD ACC2
1204         SNA CLA
1205         JMP I RESTAR    /OK, JUST CONTINUE
1206 XIFSKP, TAD COMST       /NOT ZERO, BEGIN SKIPPING FOR
1207         DCA COMIR       / LINE STARTING WITH "END"
1208         READLN          /GET A LINE FROM THE INPUT
1209           TYPEM-1       / WITH THESE TERMINATORS
1210           IFSKPO-TYPEM
1211         JMP XIFSKP      /BUFFER EMPTIED
1212 /
1213 XIFCR,  JMS I ENDCI     /CR FOUND, TIDY THINGS UP
1214           JMP XIFSKP    / CR ONLY
1215         JMS I GWORDI    /GET 1ST WORD ON LINE
1216           JMP XIFSKP    / NO WORD
1217         TAD (-0516      /IS THE WORD "EN..."?
1218         SZA CLA
1219         JMP XIFSKP      / NO, KEEP LOOKING!
1220         JMP I RESTAR    /YES! BEGIN EXECUTION AGAIN!
1221
1222
1223 /ROUTINE TO OUTPUT LOCATION THAT SATISFIED ONE
1224 /OF THE SEARCH COMMANDS.  IF ABSSW=0, OUTPUT
1225 /AS RELATIVE LOCATION.
1226 ABKLOC, 0
1227         TAD ABSSW       /IS IT 0?
1228         SZA CLA
1229         JMP ABK2        /NO, OUTPUT AS ABSOLUTE
1230         JMS I BKLOCI    /OUTPUT LOCATION
1231           BLK-1
1232 ABK1,   JMS I TWOCI     /OUTPUT ": "
1233           7240
1234         JMS I TWOT
1235         JMP I ABKLOC
1236 /
1237 ABK2,   TAD LOCL        /MAKE ABSOLUTE
1238         AND N377
1239         DCA CAD
1240         JMS I BKLOCI    /NOW OUTPUT IT
1241           CBLK-1
1242         JMP ABK1
1243
1244 TWOCS,  0       /OUTPUT 2-CHARACTER ARG
1245         TAD I TWOCS     /GET ARG
1246         ISZ TWOCS       /SKIP IT
1247         JMS I TWOT      /OUTPUT IT
1248         JMP I TWOCS
1249
1250 NXTOCT, 0
1251         TADIDP          /GET NEXT WORD FROM BLOCK
1252         JMS I OCTI      / & OUTPUT IN OCTAL
1253         JMP I NXTOCT
1254
1255
1256 PAGE
1257 \f/ROUTINE TO EXECUTE THE 'WORD' SEARCH COMMAND
1258 XWORD,  JMS SSET        /INITIALIZE SEARCH
1259         TAD CNOP        /SET UP FOR NORMAL,
1260         DCA CNOP+1
1261         TAD M10         / EQUAL SEARCH
1262 XWOR2,  TAD (SNA CLA    /"UNEQUAL" WORD SEARCH
1263         DCA XWORC
1264 XWOR1,  JMS I GWORDI    /GET POSSIBLE WORD
1265           JMP XWOR3     /NUMBERS IN BUFFER
1266         ISZ CRSWT       /WAS IT ENDED BY A CR?
1267 ERCI,   ERROR           /YES, VELLY SOLLY!
1268         JMS I SORTI     /LOOK UP COMMAND: UN, ME,
1269           XWORCL-1      / AB, FR, TO
1270           XWOROP-XWORCL
1271 ERCH,   ERROR           /COMMAND NOT RECOGNIZED
1272 /
1273 XWOR7,  TAD XWOR4+1     /"MEMREF", ONLY MEMORY-
1274         DCA CNOP+1      / REFERENCE OP-CODES CAN
1275         JMP XWOR1       / EVER BE OUTPUT.
1276 /
1277 XWOR3,  JMS I ARGI      /GET AN ARG
1278         TAD ACC1        /GET THE VALUE
1279         AND MASK
1280         CIA
1281         DCA CNT         /LOOK FOR THIS WORD
1282         JMS LSETUP      /SET UP COUNT OF WORDS TO DO
1283 XWOR4,  JMS I GETI      /GET A WORD
1284           JMP XWOR5     /FILE MODE, NO SUCH ADDRESS
1285         AND MASK
1286         TAD CNT
1287 XWORC,  HLT             /WILL BE "SZA CLA" OR "SNA CLA"
1288         JMP XWOR5       /DID NOT MATCH
1289         JMS OPRTST      /TEST FOR OP-CODES 6 & 7
1290 CNOP,   NOP             / 7--OPR
1291         NOP             / 6--IOT;"NOP" OR "JMP XWOR5"
1292         JMS ABKLOC      /DID MATCH, OUTPUT LOC
1293         JMS I GETI      /GET THAT WORD
1294           JMP ERCP      / OH I HOPE NOT!!!
1295         JMS I OCTI      /AND OUTPUT IT IN OCTAL
1296         JMS I CRLFI
1297 XWOR5,  JMS LCHEK       /DONE YET?
1298         JMP XWOR4       /NO
1299
1300 /SUBROUTINE TO INITIALIZE THE SEARCH COMMANDS
1301 SSET,   0
1302         DCA ABSSW       /RESET ABSOLUTE SWITCH
1303         TAD LBLK        /SET UP START BLK & LOC
1304         DCA BLK
1305         TAD LLOCH
1306         DCA LOCH
1307         TAD LLOCL
1308         DCA LOCL
1309         TAD UBLK        /SET UP END BLK & LOC
1310         DCA EBLK
1311         TAD ULOCH
1312         DCA ELOCH
1313         TAD ULOCL
1314         DCA ELOCL
1315         JMP I SSET
1316
1317 /COMMON OPTIONS FOR 'WORD' AND 'STRING' SEARCHES
1318
1319 XWSABS, STA
1320         DCA ABSSW       /'ABSOLUTE'--SET SWITCH
1321         JMP XWSRET
1322 /
1323 XWSFRM, JMS I LIMITI    /'FROM'--GET LOWER LIMITS
1324           BLK
1325         JMP XWSRET
1326 /
1327 XWSTO,  TAD UBLK        /'TO'--SET UP IF NEEDED
1328         DCA EBLK
1329         JMS I LIMITI    / & GET UPPER LIMITS
1330           EBLK
1331 XWSRET, STA CLL RAL     /= -2, CALCULATE RETURN ADDRESS AS
1332         TAD I GWORDI    / LAST CALL TO "GWORD" TO ALLOW
1333         DCA LCHEK       / THESE TO BE COMMON TO BOTH
1334         JMP I LCHEK     / 'WORD' AND 'STRING' SEARCHES.
1335 EBLK,   0
1336 ELOCH,  0
1337 ELOCL,  0
1338
1339
1340 LSETUP, 0       /SET SEARCH WORD-COUNTERS **** SEE NOTE ****
1341         DCA ACC1        /INITIALIZE THESE TO 0
1342         DCA ACC2
1343         TAD MODSW       /IN A MAPPED MODE?
1344         SMA SZA CLA
1345         JMP LSETL       / YES, IGNORE BLOCK PARTS
1346         TAD BLK         / NO, SET UP FOR 24 BIT
1347         DCA ACC1
1348         TAD EBLK        /  BLK-EBLK
1349         DCA OPER1
1350         DCA OPER2
1351         JMS DSUB        /DO THE SUBTRACTION
1352         TAD (400        /NOW SET UP MULTIPLY BY 400
1353         DCA OPER1
1354         DCA OPER2
1355         JMS DMUL        /GIVES: (BLK-EBLK)*400
1356 LSETL,  CLL IAC
1357         TAD ELOCL
1358         DCA OPER1       /NOW SET UP ELOC+1
1359         RAL
1360         TAD ELOCH
1361         DCA OPER2
1362         JMS DSUB        /AND SUBTRACT IT
1363         TAD LOCL        /NOW ADD LOC TO GIVE:
1364         DCA OPER1       / (BLK-EBLK)*400+(LOC-ELOC-1)
1365         TAD LOCH        / WHICH IS 24-BIT COUNT OF
1366         DCA OPER2       / WORDS TO SEARCH.
1367         JMS DADD
1368         TAD ACC2        /IF NOT NEGATIVE, ALREADY TOO
1369         SMA CLA
1370         JMP I RECRLF    / FAR, SO JUST QUIT NOW!
1371         JMP I LSETUP
1372
1373 /**** NOTE: COUNT LEFT SET UP IN ACC1 & ACC2 ****
1374
1375 LCHEK,  0       /CHECK IF SEARCH RANGE EXHAUSTED
1376         JMS I INCI      /INCREMENT LOC
1377         ISZ ACC1        /COUNT WORDS TO DO
1378         JMP I LCHEK
1379         ISZ ACC2        / (24-BIT)
1380         JMP I LCHEK
1381         JMP I RECRLF    /DO CR/LF & STOP!
1382
1383
1384 TIDPNT, 0       /"TAD I DPNT" IN FIELD 1
1385         CDF 10
1386         TAD I DPNT
1387         CDF 0
1388         JMP I TIDPNT
1389
1390
1391 ASCII,  0       /ASCII OUTPUT FORMAT FROM DEVICE
1392         AND N177        /MAKE CHARS INTO "STANDARD"
1393         TAD N200        / FORM: 7 BITS + PARITY ON
1394         JMS I TYPEI     / TO CAUSE CORRECT PRINTING
1395         JMP I ASCII
1396
1397
1398 PAGE
1399 \f/ROUTINE TO 'REWIND' THE DEVICE
1400 XREWIN, CDF 10
1401         TAD USRAD       /RESET DIRECTORY SEGMENT KEY
1402         SMA CLA
1403         DCA I N7        / IN USR IF IT IS IN MEMORY.
1404         CDF 0
1405         JMS I DEVAD     /CALL HANDLER
1406           0110          /READ, 1 PAGE, FIELD 1
1407           PDLB          /DUMMY BUFFER (ZAP P.D.L.)
1408           1             /BLK 1
1409           JMP RERROR    /READ ERROR!
1410         JMP I RESTAR
1411
1412 /READ ERROR--TEST TYPE & OUTPUT MESSAGE
1413
1414 RERROR, SPA CLA         /BIT 0 = 1 IF FATAL
1415 ERC00,  ERROR           /FATAL
1416 ERC01,  ERROR           /NON-FATAL
1417
1418
1419 /ROUTINE TO EXECUTE THE 'STRING' SEARCH COMMAND
1420 XSTRIN, JMS SSET        /INITIALIZE
1421         TAD (STJMP-STCDF /RESET MASKING SWITCH
1422 XSTR0,  TAD XREWIN      / OR SET MASKING SWITCH
1423         DCA SMSKSW
1424         JMS I GWORDI    /GET POSSIBLE WORD
1425           JMP XSTR1     /NUMBERS ONLY
1426         ISZ CRSWT       /FOLLOWED BY A CR?
1427         JMP ERCI        / YES, KICK OUT*****
1428         JMS I SORTI     /LOOK UP OPTION: MA,
1429           STRLST-1      / AB, FR, TO
1430           STROPS-STRLST
1431         JMP ERCH        /NO LIKEE!
1432 /
1433 XSTR1,  JMS I GARGI     /GET ARGS - THEN REPACK INTO BUFFER
1434         TAD TEMP        / MASKING THEM IF SPECIFIED
1435         DCA CNTR        /SET UP LENGTH
1436         TAD TEMPST
1437         DCA SCANX2      /STORING DONE IN NEG. FORM
1438         JMP XSTR2+2     /GO SET UP MASK
1439 /
1440 XSTR2,  ISZ TEMP3       /MASK END?
1441         JMP XSTR3
1442         TAD MASKBS      /YES, RESET MASK
1443         DCA SPNT
1444         TAD SMASKL      /SET UP LENGTH
1445         DCA TEMP3
1446 XSTR3,  ISZ DPNT        /SKIP 2 EXTRA WORDS
1447         ISZ DPNT
1448         TAD I DPNT      /GET A WORD
1449         JMS STRMSK      /TEST & MASK
1450         CIA             /NEGATE
1451         DCA I SCANX2    /STORE
1452         ISZ DPNT        /BUMP POINTER
1453         ISZ CNTR        /DONE?
1454         JMP XSTR2
1455         JMS LSETUP      /YES, SET UP COUNT OF WORDS
1456 XSTR4,  TAD TEMPST      /SET UP FOR SEARCH:
1457         DCA DPNT        /  STRING,
1458         TAD TEMP
1459         DCA CNTR        /  & STRING LENGTH.
1460         TAD LOCL
1461         DCA XLOCL       /SAVE CURRENT LOCATION
1462         TAD LOCH
1463         DCA XLOCH
1464         TAD BLK
1465         DCA XBLK
1466         TAD ACC1        / & COUNT FOR RESET
1467         DCA OPER1
1468         TAD ACC2
1469         DCA OPER2
1470         JMP XSTR6       /NOW SET UP MASK
1471 /
1472 XSTR5,  JMS LCHEK       /DONE?
1473         ISZ TEMP3       /NO, AT MASK END?
1474         JMP XSTR7
1475 XSTR6,  TAD MASKBS      / YES, RESET MASK
1476         DCA SPNT
1477         TAD SMASKL
1478         DCA TEMP3
1479 XSTR7,  JMS I GETI      /GET NEXT WORD
1480           JMP XSTR10    /MAPPED MODE, NO SUCH ADDRESS
1481         JMS STRMSK      /TEST & MASK
1482         TAD I DPNT      /COMPARE?
1483         SZA CLA
1484         JMP XSTR10      /NO, GO RESET & CONTINUE
1485         ISZ CNTR        /MATCHED ENOUGH?
1486         JMP XSTR5       /NOT YET
1487         JMS XRSET       /YES, RESET LOCATION & COUNT
1488         TAD TEMP        /AND LENGTH
1489         DCA CNTR
1490 XSTR8,  TAD M10
1491         DCA ACCX1       /  -(#/LINE)
1492         JMS ABKLOC      /OUTPUT THIS LOCATION
1493 XSTR9,  JMS I GETI      /GET A WORD
1494           JMP ERCP      /BAD,BAD,BAD!!!
1495         JMS I OCTI      /AND OUTPUT IN OCTAL
1496         JMS I INCI      /INCREMENT LOC
1497         ISZ CNTR        /DONE?
1498         JMP XSTR11      /NO, CONTINUE
1499         JMS I CRLFI     /YES, OUTPUT CR/LF
1500 XSTR10, JMS XRSET       /RESET LOCATION & COUNT
1501         JMS LCHEK       /DONE?
1502         JMP XSTR4       /NO, LOC INC'D, TRY NEXT
1503 /
1504 XSTR11, SPACE2          /OUTPUT "  "
1505         ISZ ACCX1       /DONE ON THIS LINE?
1506         JMP XSTR9       /NO, NOT YET
1507         JMS I CRLFI     /YES
1508         JMP XSTR8
1509
1510 XRSET,  0       /RESET BLK & LOC FROM XBLK & XLOC
1511         TAD XLOCL       /LOC
1512         DCA LOCL
1513         TAD XLOCH
1514         DCA LOCH
1515         TAD XBLK        /BLK
1516         DCA BLK
1517         TAD OPER1       /WORDS LEFT TO SEARCH
1518         DCA ACC1
1519         TAD OPER2
1520         DCA ACC2
1521         JMP I XRSET
1522
1523 STRMSK, 0       /STRING MASKING  *** NEXT WORD MODIFIED ***
1524 SMSKSW, CDF 10          /"CDF 10" OR "JMP I STRMSK"
1525         AND I SPNT      /OK, MASK IN FIELD 1
1526         CDF 0
1527         JMP I STRMSK
1528 STJMP=  JMP I STRMSK
1529 STCDF=  CDF 10
1530
1531 XBLK,   0
1532 XLOCH,  0
1533 XLOCL,  0
1534
1535
1536 PAGE
1537 \f/ROUTINE TO EXECUTE THE BLOCK 'WRITE' COMMAND
1538 XWRARG, JMS I ARGI      /GET ONE ARG
1539         TAD ACC1        /USE IT AS THE BLOCK
1540         SKP
1541 XWRITE, TAD WBLK        /SET BLOCK
1542         DCA XWBLK
1543         JMS I DEVAD     /CALL HANDLER
1544           4210          /WRITE, 2 PAGES, FIELD 1
1545           IOBUF
1546 XWBLK,    0             /[** COUNTER FOR MODIFY **]
1547           JMP WERROR    /WRITE ERROR
1548         DCA MODIF       /CLEAR SOMETHING-CHANGED FLAG
1549         JMP I RESTAR
1550
1551 /WRITE ERROR--TEST TYPE & OUTPUT MESSAGE
1552
1553 WERROR, SPA CLA         /BIT 0 = 1 IF FATAL
1554 ERC02,  ERROR           /FATAL
1555 ERC03,  ERROR           /NON-FATAL
1556
1557
1558 /ROUTINE TO EXECUTE THE 'MODIFY' COMMAND
1559 XMODIF, JMS I GWORDI    /GET FORMAT WORD IF ONE
1560           JMP XMODEF    /NONE, GET DEFAULT
1561         DCA MODTMP      /SAVE FOR LATER
1562         ISZ CRSWT       /TERMINATED BY A CR?
1563         JMP ERCO        / YES, SAVE USER FROM HIMSELF!
1564         TAD MODTMP      /TEST FORMAT FOR RECOGNITION
1565         JMS I SORTI
1566           MODIFL-1
1567           MODADS-MODIFL
1568 ERCO,   ERROR           / I THEENK YOU USE BAD WORD!
1569 /
1570 /NO FORMAT DESCRIPTOR GIVEN, USE DEFAULT
1571 XMODEF, TAD FCNT        /USE CURRENT FORMAT,
1572         TAD (MODDLS-1   / WITH A LITTLE DIFFERENCE
1573         DCA DPNT
1574         TADIDP          /GET THE ONE TO USE
1575         DCA MODTMP      / AND SAVE IT
1576 /
1577 XMOD0,  JMS I GARGI     /OK, NOW GET ARGS
1578         TAD TEMP        /MOVE COUNT TO A SAFE PLACE
1579         DCA XWBLK
1580 XMOD1,  TAD I DPNT      /GET BLOCK #
1581         JMS BLKTST      /TEST & SET BLK
1582         TAD I DPNT      /GET LOC
1583         DCA LOCH
1584         TAD I DPNT
1585         DCA LOCL
1586         TAD I DPNT      /GET -(# LOCS)
1587         DCA CNTR
1588 XMOD2,  TAD COMST       /INIT COMM. BUFF. FOR MODS
1589         DCA COMIR
1590         DCA CHARSW      /RESET HALF SWITCH
1591         JMS I SOCTI     /INITIALIZE INPUT TO OCTAL
1592         JMS I BKLOCI    /OUTPUT START LOC
1593           BLK-1
1594         JMS I TWOCI     /AND ": "
1595           7240
1596         READLN          /GET A LINE (TEST: RUBOUT, ^U & ^R)
1597           TYPEM-1       /IGNORE LF'S
1598           MCHARO-TYPEM
1599         JMP XMOD2       /BUFFER EMPTIED!
1600
1601
1602 /CR TYPED, END
1603 XMODCR, JMS I ENDCI     /END BUFFER WITH A CR.
1604           JMP XMOD2     /ONLY A CR IN BUFFER-RETRY!
1605         TAD MODTMP      /NOW LOOK UP FORMAT
1606         JMS I SORTI
1607           MODIFL-1
1608           MODIFO-MODIFL
1609 ERCP,   ERROR           /ILLEGAL (EXTRA BAD IF HERE)
1610
1611 XMODDN, ISZ XWBLK       /RETURN HERE, ALL ARGS DONE?
1612         JMP XMOD1       /NO
1613         JMP I RESTAR    /YES
1614 MODTMP, 0
1615
1616 XGET,   0       /SUB. TO SET CURRENT LOC & FLAG
1617         JMS I GETI      /SET LOCATION
1618 ERC07,    ERROR         /MAPPED MODE, NO SUCH ADDRESS
1619         STA
1620         DCA MODIF       /SET FLAG
1621         JMP I XGET
1622
1623 /NUMERIC FORMATS HERE
1624 XNUM0,  JMS I SORTI     /TEST TERMINATOR
1625           GETLST-1-1    /SPACE, COMMA, CR
1626           NUMOPS-GETLST+1
1627         JMP ERCQ        /ILLEGAL TERMIN
1628 /
1629 XNUM1,  JMS I GETNI     /COMMA, SKIP IT
1630         JMS I SSKIPI    / SPACE, IGNORE IT
1631 XNUM2,  JMS EXPRIN      /GET NEXT ARG--EXPRESSION
1632         JMS XGET        /SET UP LOCATION
1633         TAD ACC1
1634         DCAICAD         / & STORE VALUE
1635         JMS I INCI      /INCREMENT LOCATION
1636         ISZ CNTR        /ALL MODS DONE?
1637         JMP XNUM0       /NO, TEST TERMIN
1638         JMP XMODDN      /YES, TEST NEXT SET
1639 /
1640 XNUM3,  TAD CNTR        /DONE?
1641         SNA CLA
1642         JMP XMODDN      /YES
1643         JMS XGET        /NO, SET UP LOC
1644         TAD FILLER
1645         DCAICAD         /AND FILL WITH 'FILLER'
1646         JMS I INCI      /INCREMENT LOC
1647         ISZ CNTR        /DONE?
1648         JMP XNUM3       /NO
1649         JMP XMODDN      /YES
1650
1651 /ASCII FORMAT HERE
1652         JMS CGET        /GET A CHAR & CHECK FOR CR
1653 XASC1,  JMS XGET        /SET UP LOC & SET FLAG
1654         TAD CHAR
1655         DCAICAD         /STORE THIS CHAR
1656         JMS I INCI      /INCREMENT LOC
1657         ISZ CNTR        /MODS DONE?
1658         JMP XASC1-1     /NO
1659         JMP XMODDN      /YES
1660
1661 CGET,   0       /GET NEXT CHAR.  IF CR, MODS DONE
1662         JMS CGTEST      /GET & TEST NEXT
1663           JMP XNUM3     /CR, FILL REST WITH 'FILLER'
1664         JMP I CGET
1665
1666 CGTEST, 0       /SUB. TO GET A CHAR & CHECK FOR CR
1667         JMS I GETNI     /GET NEXT CHARACTER
1668         TAD CHAR        /IS IT A CR?
1669         TAD M215
1670         SZA CLA
1671         ISZ CGTEST      /RETURN TO CALL+2 IF NOT
1672         JMP I CGTEST
1673
1674
1675 DO1SP,  0       /OUTPUT " " + AC
1676         JMS I TYPECI
1677           "
1678         JMP I DO1SP     /ANOTHER TUFFIE
1679
1680 DO2SP,  0       /OUTPUT "  " + AC (PACKED ASCII)
1681         JMS I TWOCI
1682           4040
1683         JMP I DO2SP     /FAST & SWEET!
1684
1685
1686 PAGE
1687 \f/ROUTINE TO EXECUTE THE 'SMASK' (STRING MASK) COMMAND
1688 XSMASK, JMS I GARGI     /GET ARGS
1689         TAD TEMP
1690         DCA SMASKL      /SAVE -(MASK LENGTH)
1691         TAD MASKBS      /SET UP TO STORE WORDS
1692         DCA SPNT
1693 XSMAS1, ISZ DPNT        /SKIP 2 WORDS
1694         ISZ DPNT
1695         TAD I DPNT      /GET & STORE ONE
1696         CDF 10
1697         DCA I SPNT
1698         CDF 0
1699         ISZ DPNT        /SKIP 1 MORE
1700         ISZ TEMP        /DONE ?
1701         JMP XSMAS1      /NO
1702         JMP I RESTAR
1703
1704
1705 /XS240 PACKED ASCII FORMAT HERE
1706 XXS20,  TAD M240        /SET OFFSET
1707 /PACKED ASCII FORMAT HERE
1708 XPAC0,  DCA PNAME       /CLEAR OFFSET
1709 XPAC1,  TAD M240        /IS CHAR < 240?
1710         TAD CHAR
1711         SMA CLA
1712         JMP XPAC2       /NO, JUST PACK CHAR
1713         CMA
1714         JMS PACK        /YES, PACK A FLAG (77) FIRST
1715 XPAC2,  TAD CHAR        /NOW GO PACK CHAR
1716         TAD PNAME       /(WITH DESIRED OFFSET)
1717         JMS PACK
1718         JMS  CGET       /NOW GET & TEST NEXT
1719         JMP XPAC1       / OK, CONTINUE
1720
1721 /OS/8 ASCII HERE
1722 XOPS1,  TAD LOCL        /TEST START & COUNT FOR EVEN
1723         RAR             /(LOW BIT TO LINK &
1724         CLA             / CLEAR AC)
1725         TAD CNTR
1726         RAR             /(LOW TO LINK, LINK TO AC0)
1727         SZL SPA CLA     /BOTH L=0 & AC0=0 FOR OK
1728 ERC04,  ERROR           /START OR COUNT NOT EVEN
1729 XOPS2,  TAD CHARSW      /GET SWITCH
1730         ISZ CHARSW      / & BUMP IT
1731         CLL RAR         /ROTATE AC 11 INTO LINK
1732         SZL SNA CLA     /CHARACTER 3?
1733         JMP XOPS5       /NO, CHAR 1 OR CHAR 2
1734         STA
1735         TAD CAD         /YES, BACK UP POINTER
1736         DCA CAD
1737         STA CLL RAL     / & SET LOOP COUNT TO -2
1738         DCA CHARSW
1739 XOPS3,  TAD CHAR        /GET REST OF CHAR
1740         CLL RTL         /4 BITS LEFT
1741         RTL
1742         DCA CHAR        /SAVE IT
1743         TAD CHAR        /NOW MERGE 4 BITS WITH
1744         AND N7400       / A PREVIOUS CHAR
1745         TADICAD
1746         DCAICAD         /4 BITS OF 3RD + 1ST OR 2ND
1747         ISZ CAD         /BUMP POINTER
1748         ISZ CHARSW      /DONE?
1749         JMP XOPS3
1750         TAD CNTR        /YES, DONE ALL MODS?
1751         SNA CLA
1752         JMP XMODDN      /YES, TEST FOR DONE
1753 XOPS4,  JMS  CGET       /GET & TEST NEXT CHAR
1754         JMP XOPS2       /OK, DO NEXT
1755 /
1756 XOPS5,  JMS  XGET       /SET UP CURRENT LOC
1757         TAD CHAR
1758         DCAICAD         /AND STORE CHARACTER
1759         JMS I INCI      /INCREMENT LOC
1760         ISZ CNTR        /BUMP COUNTER FOR LATER
1761         JMP XOPS4       / SO IGNORE SKIP NOW
1762         JMP XOPS4
1763
1764 PACK,   0       /SUB. TO PACK CHARACTERS
1765         AND N77         /USE ONLY 6 BITS
1766         ISZ CHARSW      /CHECK HALF
1767         JMP PACK1
1768         TADICAD         /RIGHT HALF, ADD TO LEFT
1769         DCAICAD
1770         TAD CNTR        /ALL MODS DONE?
1771         SZA CLA
1772         JMP I PACK      /NO
1773         JMP XMODDN      /YES
1774 /
1775 PACK1,  JMS I RTL6I     /LEFT HALF, ROTATE INTO IT
1776         DCA CHARSW      /SAVE IT
1777         JMS  XGET       /SET UP CURRENT LOC
1778         TAD CHARSW
1779         DCAICAD         /STORE WORD
1780         JMS I INCI      /INCREMENT LOC
1781         ISZ CNTR        /BUMP COUNTER FOR LATER
1782         NOP             / SO DON'T SKIP NOW
1783         STA
1784         DCA CHARSW      /RESET SWITCH
1785         JMP I PACK
1786
1787
1788 PNAME,  0       /PRINT A FILE NAME, PADDED W. SPACES
1789         TAD NAM1
1790         JMS I TWOT      / OUTPUT UP TO
1791         TAD NAM2
1792         JMS I TWOT      / 6 CHARACTERS
1793         TAD NAM3
1794         JMS I TWOT      / OF FILE NAME,
1795         JMS I TYPECI    / A "."
1796           ".
1797         TAD NAM4        / & UP TO 2 CHARS
1798         JMS I TWOT      / OF EXTENSION.
1799 PNAME1, SPACE1          /OUTPUT A " "
1800         TAD NCNT        /11(10) CHARS ON LINE YET?
1801         TAD (-13
1802         SPA CLA
1803         JMP PNAME1      /NO, OUTPUT ANOTHER SPACE
1804         JMP I PNAME
1805
1806
1807 /SUBROUTINE TO GET A NUMERIC ARGUMENT FROM THE
1808 /  COMMAND BUFFER AND RETURN IT TO THE 3 WORDS
1809 /  POINTED TO BY CALL+1.  THE FIRST WORD (BLOCK
1810 /  NUMBER) IS NOT CHANGED IF NO BLOCK PART WAS
1811 /  GIVEN IN THE COMMAND.
1812
1813 LIMITS, 0
1814         TAD I LIMITS    /GET ADDRESS OF 3 WORDS
1815         ISZ LIMITS
1816         DCA PNAME       / & SAVE IT
1817         JMS I ARGI      /GET COMMAND DATA
1818         TAD TEMP1       /GET BLOCK NUMBER PART
1819         ISZ TEMP1       /WAS A BLOCK PART SPEC'D?
1820         DCA I PNAME     / YES, STORE IT
1821         CLA             /(CLEAR IN CASE NOT!)
1822         ISZ PNAME       /BUMP POINTER
1823         TAD ACC2
1824         AND N7
1825         DCA I PNAME     /STORE HIGH 3 BITS
1826         ISZ PNAME
1827         TAD ACC1
1828         DCA I PNAME     / & LOW 12 BITS OF ADDR.
1829         JMP I LIMITS
1830
1831
1832 PAGE
1833 \f/SUBROUTINE TO 'GET' A WORD FROM THE DEVICE.
1834 /
1835 /  THE ACTUAL WORD ON THE DEVICE THAT IS ACCESSED
1836 /  IS DEPENDENT ON THE MODE SWITCH, AS FOLLOWS:
1837 /
1838 /  MODE         ACTION
1839 /
1840 /  0 = NORMAL   THE HIGH 7 BITS OF THE 15 BIT ADDRESS
1841 /               ARE ADDED TO THE SPECIFIED BLOCK #
1842 /               TO GET THE ACTUAL BLOCK & THE LOW 8
1843 /               BITS OF THE 15 BIT ADDR ARE USED TO
1844 /               SPECIFY THE WORD WITHIN THE BLOCK.
1845 /
1846 / -1 = OFFSET   THE 12 BIT "OFFSET" (WHICH IS NEGATED)
1847 /               IS ADDED TO THE LOW 12 BITS OF THE
1848 /               ADDRESS, AND THEN THE NEW ADDRESS IS
1849 /               HANDLED AS ABOVE.
1850 /               THIS MODE IS USED PRIMARILY WHEN
1851 /               WORKING WITH THE OPERATING SYSTEM
1852 /               WITH OVERLAYS WHOSE REAL START BLOCK
1853 /               AND LOCATION WITHIN A FIELD ARE KNOWN.
1854 /               BY SETTING THE "OFFSET" TO THE START
1855 /               ADDRESS OF THE OVERLAY, ITS REAL
1856 /               ADDRESSES CAN BE USED AND THE PROPER
1857 /               LOCATIONS WILL BE ACCESSED.
1858 /
1859 / +1 = SAVE     THIS MODE IS USED WITH CORE IMAGE
1860 /               "SAVE" FILES ONLY.  THE FILE'S CCB
1861 /               (CORE CONTROL BLOCK) IS USED TO
1862 /               DETERMINE THE REAL LOCATION ON THE
1863 /               DEVICE OF THE SPECIFIED 15 BIT ADDR-
1864 /               ESS.  THE START BLOCK OF THE FILE
1865 /               IS USED, AND ANY SPECIFIED "BLOCK"
1866 /               PART IS USED TO SPECIFY THE OVERLAY
1867 /               WANTED AT THAT ADDRESS.  FOR FILES
1868 /               WITHOUT OVERLAYS (GENERATED BY THE
1869 /               MONITOR "SAVE" COMMAND), THIS PART
1870 /               MUST BE ZERO (0) OR NO MATCH WILL
1871 /               OCCUR.  FOR FILES WITH OVERLAYS
1872 /               (GENERATED BY THE PROGRAM "LINK"),
1873 /               A LEGAL OVERLAY AT THE SPECIFIED
1874 /               ADDRESS MUST BE SPECIFIED FOR A
1875 /               MATCH TO OCCUR.  THIS MODE CAN ONLY
1876 /               BE USED AFTER A "FILE" COMMAND.
1877 /
1878 / +2 = LOAD     THIS MODE IS USED WITH OS/8 FORTRAN
1879 /               IV LOAD MODULES.  THE FILE'S HEADER
1880 /               BLOCK IS USED TO DETERMINE THE REAL
1881 /               LOCATION ON THE DEVICE OF THE SPECI-
1882 /               FIED 15 BIT ADDRESS AND THE "BLOCK"
1883 /               PART IS USED TO SPECIFY THE OVERLAY
1884 /               WANTED AT THAT ADDRESS.  THIS MODE CAN
1885 /               ONLY BE USED AFTER A "FILE" COMMAND.
1886
1887
1888 /CALLING SEQUENCE:
1889 /
1890 /       JMS I GETI
1891 /         RETURN1       /MODE=MAPPED, NO SUCH ADDRESS
1892 /       NORMAL RETURN   /'CAD' SET, DATA IN AC
1893 \f/SUBROUTINE 'GET'--PART OF THIS PAGE & ALL OF NEXT
1894
1895 GET,    0
1896         JMS I CTRLI     /GO TEST FOR CONTROL-CHARS
1897         TAD MODSW       /OK, TEST MODE
1898         SNA
1899         JMP GET0        /NORMAL MODE, NO CHANGES
1900         SMA CLA
1901         JMP GET4        /SAVE MODE, DO MAPPING
1902         TAD OFFSET      /OFFSET MODE, ADD IT
1903 GET0,   JMS DBLPGS      /NOW ADD 'DOUBLE PAGES'
1904         TAD BLK         / OF LOC TO BLK TO SET
1905         DCA CBLK        /'CURRENT BLOCK'
1906 GET1,   JMS GETIO       /OUTPUT CURREN (IF NEEDED), GET NEXT
1907           JMP RERROR    /  READ ERROR, GO TELL ABOUT IT
1908         TAD MODSW       /TEST AGAIN FOR OFFSET
1909         SPA CLA
1910         TAD OFFSET      /YES, ADD IT AGAIN
1911         TAD LOCL        /USE 8 ADDRESS BITS FROM LOC
1912         AND N377
1913         TAD BUFST       /INTO BUFFER, TO SET
1914         DCA CAD         /'CURRENT ADDRESS'
1915         TADICAD         /NOW GET THE WORD
1916         ISZ GET         /RETURN TO CALL+2 WITH IT
1917 GETX,   JMP I GET       /[EXIT TO CALL+1 FOR MAP FAIL]
1918
1919 GETIO,  0       /DO I/O FOR 'GET' & 'SCANER'
1920         TAD CBLK        /IS THIS SAME BLOCK AS IS IN
1921         CIA             /CORE CURRENTLY?
1922         TAD RBLK
1923         SNA CLA
1924         JMP GETIO2      /YES, USE IT.
1925         ISZ MODIF       /NO, ANY CHANGES IN THIS BLK?
1926         JMP GETIO1      /NO, DEVICE OK AS IS
1927         JMS I DEVAD     /CALL DEVICE HANDLER
1928           4210          /WRITE, 2 PAGES, FIELD 1
1929 BUFST,    IOBUF
1930 WBLK,     0
1931           JMP WERROR    /WRITE ERROR
1932 GETIO1, TAD CBLK        /NOW UPDATE OUTPUT BLOCK
1933         DCA WBLK
1934         TAD CBLK        / AND INPUT BLOCK #
1935         DCA RBLK
1936         DCA MODIF       / AND RESET SWITCH
1937         TAD CBLK        /SHOW BLOCK NUMBER IN LIGHTS
1938         MQL             / (IF THERE ARE ANY!)
1939         CLA
1940         JMS I DEVAD     /CALL DEVICE HANDLER
1941           0210          /READ, 2 PAGES, FIELD 1
1942           IOBUF
1943 RBLK,     -1    /(NOTHING IN CORE-ILLEGAL BLK #)
1944           JMP I GETIO   /READ ERROR
1945 GETIO2, ISZ GETIO       /OK, DO NORMAL RETURN
1946         JMP I GETIO
1947
1948
1949 DBLPGS, 0       /CONVERT LOCATION TO DOUBLE-PAGES
1950         TAD LOCL
1951         AND M400        /HIGH 4 BITS HERE
1952         CLL RAL         /BECOME LOW 4 BITS
1953         TAD LOCH        /FOR A 7 BIT VALUE
1954         RTL
1955         RTL
1956         JMP I DBLPGS
1957
1958
1959 /GET WORD ROUTINE FOR "ODT" COMMANDS
1960
1961 ODGET,  0
1962         TAD SBLK        /SET UP BLOCK
1963         DCA BLK
1964         TAD SLOCH
1965         DCA LOCH
1966         TAD SLOCL
1967         DCA LOCL        /SET UP LOCATION
1968         JMS I GETI      /NOW GET WORD
1969 ERC05,    ERROR         /MAPPED MODE, NO SUCH ADDRESS
1970         JMP I ODGET     / & RETURN WITH IT
1971
1972
1973 /OUTPUT 12 BIT BLOCK # & 15 BIT ADDRESS IN OCTAL
1974
1975 BKLOC,  0
1976         TAD I BKLOC     /GET ARGUMENT (ADDR-1)
1977         ISZ BKLOC
1978         DCA GETPNT      / & SET UP A-XR
1979         TAD I GETPNT    /GET BLOCK PART
1980         JMS I OCTI      / & OUTPUT IT
1981         TAD I GETPNT    /GET FIELD
1982         AND N7
1983         JMS I TWOCI     / & OUTPUT "." & IT
1984           5660          / (".0")
1985         TAD I GETPNT    /GET ADDRESS
1986         JMS I OCTI      / & OUTPUT IT
1987         JMP I BKLOC
1988
1989
1990 /SUBROUTINE TO GET A COMMAND WORD OR CHARACTER
1991 /FROM THE COMMAND BUFFER.  IF THE BUFFER CONTAINS
1992 /ONLY NUMERIC ITEMS, RETURN TO CALL+1. TERMINATOR
1993 /IS SPACE OR CR
1994 GWORD,  0
1995         JMS I SSKIPI    /GET NEXT NON-SPACE
1996         TAD CHAR
1997         AND N77         /USE THIS CHAR AS LEFT
1998         JMS I RTL6I     / 6 BITS.
1999         DCA CHARSW      /SAVE IT
2000         JMS I SORTI     /CHECK FOR ^K, ^D, (, ", ',
2001           GWLST1-1      / DIGITS, SPACE & CR
2002           GWOPS1-GWLST1
2003         JMS I GETNI     /NONE, IS NEXT A SPACE
2004         JMS I SORTI     / OR A C.R.?
2005           GWLST2-1
2006           GWOPS2-GWLST2
2007         TAD CHAR        /NONE, USE AS LOWER 6 BITS
2008         AND N77
2009         TAD CHARSW
2010         DCA CHARSW      /SAVE IT
2011 GWD1,   JMS I GETNI     /LOOK FOR SPACE OR C.R.
2012         JMS I SORTI
2013           GWLST2-1
2014           GWOPS2-GWLST2
2015         JMP GWD1        /NEITHER, KEEP LOOKING
2016 /
2017 GWD2,   STA             /SPACE FOUND, SET SWITCH
2018 GWD3,   DCA CRSWT       /CR FOUND, RESET SWITCH
2019         TAD CHARSW      /RETURN WITH WORD
2020         ISZ GWORD       / TO CALL+2
2021 GWD4,   JMP I GWORD
2022 /EXIT TO CALL+1 IF ANY NUMERIC ITEM FOUND--
2023 /  ^K, ^D, (, ", ', DIGITS
2024
2025
2026 /"DIRECTORY" FORMAT OUTPUT ROUTINE
2027 DIRDMP, 0
2028         JMS I OCTI      /OUTPUT IN OCTAL FIRST
2029         SPACE2
2030         TADICAD
2031         JMS DIROUT      / THEN 3 OTHERS
2032         JMP I DIRDMP
2033
2034 /"?" ODT OUTPUT ROUTINE
2035 DIROUT, 0
2036         CIA             /ASSUME WAS NEGATIVE
2037         JMS I DECI      / & OUTPUT IN DECIMAL
2038         SPACE2
2039         TADICAD
2040         JMS I PDATEI    /OUTPUT AGAIN AS DATE
2041         SPACE2
2042         TADICAD
2043         JMS I TWOT      /OUTPUT LAST TIME AS PACKED ASCII
2044         JMP I DIROUT
2045
2046
2047 PAGE
2048 \f/CONTINUATION OF 'GET' -- MAPPING FOR "SAVE" AND "LOAD"
2049 /  MODES DONE HERE.
2050
2051 GET4,   JMS DBLPGS      /GET # DOUBLE-PAGES
2052         DCA CAD         / & SAVE IT
2053         STA
2054         TAD MODSW       /TEST FOR SAVE OR LOAD MODE
2055         SZA CLA
2056         JMP GETL1       / LOAD MODE
2057         CDF CIF 10
2058         JMS GCCB        /SAVE MODE, GET CCB
2059         DCA SEGCNT      / & SET UP # SEGMENTS
2060         TAD RBLK1       /SET UP ACTUAL FIRST BLOCK
2061         IAC
2062         DCA CBLK        / FOR MAPPING.
2063 GETS1,  CDF 10
2064         TAD I GETPNT    /GET AN ORIGIN WORD
2065         DCA GETORG
2066         TAD I GETPNT    / & A CONTROL WORD.
2067         CDF 0
2068         DCA GETCW
2069         TAD GETCW       /TEST FOR FIELD MATCH
2070         CLL RTR
2071         RAR
2072         AND N7          /(MASK OFF COUNT)
2073         CIA
2074         TAD LOCH        /SAME?
2075         SZA CLA
2076         JMP GETS2       /NO, TRY NEXT SEGMENT
2077         TAD LOCL        /YES, NOW TEST ADDRESSES
2078         AND M200        /(MASK TO PAGE)
2079         STL CIA
2080         TAD GETORG      /[ORIG PAGE]-[ADDR PAGE]
2081         SZA SNL         /ABOVE THE ORIGIN?
2082         JMP GETS2       /NO, TRY NEXT
2083         RAR             /OK, DIVIDE BY 2 (WITH SIGN)
2084         DCA GETORG      / & SAVE IT.
2085         TAD GETCW       /BEYOND TOP OF SEGMENT?
2086         AND M100        /(MASK OFF FIELD AND MAKE)
2087         SNA
2088         STL RAR         / 0 => 40, THEN SUBTRACT
2089         TAD M100        / ONE PAGE)
2090         TAD GETORG
2091         SPA CLA
2092         JMP GETS2       /NO, TRY NEXT
2093         TAD GETORG      /YES, UPDATE CBLK TO RIGHT
2094         CIA
2095         JMS UPCBLK      / ACTUAL BLOCK
2096         TAD BLK         /MUST BE IN "LVL 0" OR
2097         SZA CLA
2098         JMP GETX        / RETURN AS BAD
2099         JMP GET1        /NOW GO GET THE DATA
2100 /
2101 GETS2,  CLA
2102         TAD GETCW       /UPDATE CBLK
2103         AND M100
2104         SNA
2105         STL RAR         /(MAKING 0 => 40)
2106         TAD (100        /(ROUND UP PAGE COUNT)
2107         JMS UPCBLK
2108         ISZ SEGCNT      /ALL SEGMENTS DONE?
2109         JMP GETS1       /NO, TRY NEXT
2110         TAD OVLFLG      /YES, OVERLAYS? (LINK OUTPUT)
2111         SNA
2112         JMP GETX        / NO, RETURN TO CALL+1
2113         TAD (4          / YES, RESET POINTER
2114         DCA GETPNT      / TO SKIP OVER LVL 0
2115         JMP GETL2       / & CONTINUE
2116 /
2117 GETL1,  CDF CIF 10
2118         JMS GHDR        /GET & TEST HEADER
2119 GETL2,  CDF 10
2120         TAD I GETPNT    /GET NUMBER OF OVERLAYS
2121         DCA SEGCNT
2122         TAD I GETPNT    /GET PAGE & FIELD
2123         DCA GETCW
2124         TAD I GETPNT    /GET REL BLK NUMBER
2125         TAD RBLK1       / + START BLOCK
2126         DCA CBLK        / = ABS START BLK, THIS LEVEL
2127         TAD I GETPNT    /GET LENGTH, THESE OVERLAYS
2128         CDF 0
2129         DCA GETORG
2130         TAD GETCW       /GET DBL-PAGE & FIELD
2131         SNA
2132         JMP GETX        / 0 = THE END!!!
2133         AND M400        /CONVERT TO DBL-PAGE #
2134         CLL RTL
2135         RTL
2136         TAD GETCW       / IN BITS 5-11
2137         RAL
2138         AND N177
2139         CIA             /-(DBL-PG # OF OVLY START)
2140         TAD CAD         /+(DBL-PG # OF DESIRED)
2141         SPA
2142         JMP GETL3       / GONE TOO FAR, MISSED IT!
2143         DCA GETCW       /= RELATIVE BLOCK NUMBER
2144         TAD GETCW       /IS THIS WITHIN THIS OVLY?
2145         CIA
2146         TAD GETORG
2147         SPA SNA CLA
2148         JMP GETL2       / NO, TRY NEXT OVERLAY
2149         TAD BLK         /OK, SET UP -(#LVL +1)
2150         CMA
2151         DCA GETORG
2152         TAD GETORG      /ADDR IS OK, IS THERE A
2153         TAD SEGCNT      / LEVEL WANTED?
2154 GETL3,  SPA CLA
2155         JMP GETX        /ILLEGAL LEVEL; TOO FAR--EXIT
2156         TAD GETCW       /ALL OK!  ADD RELATIVE BLK
2157         SKP
2158 GETL4,  TAD SEGCNT      / TO (LVLS-1)*LENGTH
2159         TAD CBLK
2160         DCA CBLK        / TO OVERLAY START BLOCK
2161         ISZ GETORG      /[MULTIPLY BY ADDING]
2162         JMP GETL4
2163         JMP GET1
2164 GETORG, 0
2165 GETCW,  0
2166 SEGCNT, 0
2167
2168 UPCBLK, 0
2169         JMS I RTR6I     /MOVE COUNT TO BITS 6-11
2170         CLL RAR         /DIVIDE FOR DOUBLE PAGES
2171         TAD CBLK        /UPDATE
2172         DCA CBLK
2173         JMP I UPCBLK
2174
2175
2176
2177 PAGE
2178 \f/NUMERIC OUTPUT SUBROUTINES, NO ZERO SUPPRESSION:
2179
2180 OPRT,   0       /4-DIGIT OCTAL
2181         JMS NUMOUT
2182         -1000
2183         -100
2184         -10
2185         0
2186         JMP I OPRT
2187
2188 OCT3,   0       /3-DIGIT OCTAL
2189         JMS NUMOUT
2190         -100
2191         -10
2192         0
2193         JMP I OCT3
2194
2195 BPRT,   0       /3-DIGIT BCD
2196         JMS NUMOUT
2197         -400
2198         -20
2199         0
2200         JMP I BPRT
2201
2202
2203 SGNDP,  0       /4-DIGIT DECIMAL, SIGNED
2204         DCA NUMB
2205         TAD NUMB
2206         SPA CLA
2207         TAD N15
2208         SPACE1          /OUTPUT "-" OR " "
2209         TAD NUMB        /NOW OUTPUT IN DECIMAL
2210         SPA
2211         CIA
2212         JMS DPRT
2213         JMP I SGNDP
2214
2215 DECIMAL
2216
2217 DPRT,   0       /4-DIGIT DECIMAL, UNSIGNED
2218         JMS NUMOUT
2219         -1000
2220         -100
2221         -10
2222         0
2223         JMP I DPRT
2224
2225 DEC2,   0       /2-DIGIT DECIMAL, UNSIGNED
2226         AND N177        /MASK IT FIRST
2227         JMS NUMOUT
2228         -10
2229         0
2230         JMP I DEC2
2231
2232 OCTAL
2233
2234 NUMOUT, 0       /THE REAL OUTPUT SUBROUTINE
2235         DCA NUMB        /SAVE THE NUMBER
2236 NUMO1,  DCA NUMDGT      /RESET "DIGIT" TO 0
2237         CLA CLL
2238         TAD NUMB        /GET CURRENT VALUE
2239         TAD I NUMOUT    /SUBTRACT DIGIT BASE
2240         SNL             /DID IT OVERFLOW?
2241         JMP NUMO2       /NO, TOO FAR!
2242         ISZ NUMDGT      /YES, BUMP DIGIT
2243         DCA NUMB        / & UPDATE VALUE
2244         JMP NUMO1+1
2245 /
2246 NUMO2,  CLA CLL
2247         TAD NUMDGT      /OUTPUT THE "DIGIT"
2248         DIGIT
2249         ISZ NUMOUT      /BUMP TO NEXT ARG
2250         TAD I NUMOUT    /DONE ENOUGH?
2251         SZA CLA
2252         JMP NUMO1
2253         TAD NUMB        /YES, SO OUTPUT THE LAST
2254         DIGIT           / ONE.
2255         JMP I NUMOUT    /AND RETURN
2256 NUMB,   0
2257 NUMDGT, 0
2258
2259 SSKIP,  0       /SKIP SPACES IN COMMAND BUFFER.
2260         TAD CHAR
2261         TAD M240        /IS THIS A SPACE?
2262         SZA CLA
2263         JMP I SSKIP     /NO, DONE
2264         JMS I GETNI     /YES, GET NEXT CHAR
2265         JMP SSKIP+1     / & GO TRY IT
2266
2267
2268 /OS/8 ASCII OUTPUT SUBROUTINE.  OUTPUTS 1 CHAR
2269 /  FOR EVEN WORD & 2 CHARS FOR ODD WORD.
2270
2271 OSTYPE, 0
2272         JMS OSSET       /DO SETUP FOR UNPACKING
2273         JMS I (ASCII    /OUTPUT CHARS TO "STANDARD"
2274         ISZ CHARSW      /UNPACK 2ND CHARACTER?
2275         JMP OSUNPK      / YES, & RETURN TO OSSET CALL!
2276         JMP I OSTYPE    /DONE, RETURN TO CALLER
2277
2278
2279 /OS/8 "BYTE" OUTPUT SUBROUTINE.  OUTPUT ONE
2280 /  8-BIT OCTAL NUMBER FOR EVEN WORD AND TWO 8-
2281 /  BIT OCTAL NUMBERS FOR ODD WORD.  USED FOR
2282 /  DUMPING OS/8 ".BN" FILES OR ASCII IN OCTAL.
2283
2284 BYTEO,  0
2285         JMS OSSET       /DO SETUP FOR UNPACKING
2286         JMS OCT3        /3 DIGIT OCTAL OUTPUT
2287         ISZ CHARSW      /UNPACK 2ND "CHAR"?
2288         SKP
2289         JMP I BYTEO     / DONE, RETURN
2290         SPACE2          /YES, BUT OUTPUT 2 SPACES
2291         JMP OSUNPK      / BEFORE DOING UNPACKING
2292
2293
2294 /OS/8 FORMAT UNPACKING ROUTINES FOR 'OSTYPE' AND
2295 /  'BYTEO'.  THE SUBROUTINE SETS UP THE COUNTER
2296 /  FOR NUMBER OF OUTPUTS TO DO, SAVING & RESTORING
2297 /  THE AC.  THE ROUTINE WILL BE CALLED ONLY IF 2
2298 /  OUTPUTS BEING DONE AND DOES THE UNPACK OF THE
2299 /  2ND "CHARACTER", RETURNING TO THE CALLER OF THE
2300 /  SUBROUTINE!
2301
2302 OSSET,  0       /ENTER HERE TO INITIALIZE
2303         DCA INC         /SAVE AC
2304         IAC
2305         AND LOCL        /AC = 0 OR 1
2306         CMA             /AC = -1 OR -2 (-# TO DO)
2307         DCA CHARSW      /SET UP UNPACK COUNT
2308 OSRETN, TAD INC         /GET VALUE TO AC
2309         AND N377        /MASK TO 8 BITS
2310         JMP I OSSET
2311 /
2312 OSUNPK, STA     /JUMP HERE IF 2ND CHAR TO GET
2313         TAD CAD
2314         DCA SGNDP       /POINT TO HIGH WORD
2315         CDF 10
2316         TAD I CAD       /GET LOW BITS OF "CHAR"
2317         AND N7400       / MASK TO 4 BITS AND
2318         JMS I RTR6I     / MOVE TO BITS 8-11
2319         RTR
2320         DCA INC         /SAVING IT HERE FOR LATER!
2321         TAD I SGNDP     /NOW GET HIGH BITS OF "CHAR"
2322         AND N7400       / MASK TO 4 BITS AND
2323         CDF 0
2324         CLL RTR         / MOVE TO BITS 4-7
2325         RTR
2326         JMP OSRETN      /GET OTHER BITS & RETURN!
2327
2328
2329 /SUBROUTINE TO INCREMENT THE "CURRENT LOCATION"
2330
2331 INC,    0
2332         ISZ LOCL        /INCREMENT LOW 12 ADDR BITS
2333         JMP I INC       /OK AS IS
2334         CLL
2335         TAD LOCH        /LOW OVERFLOW, INCR. HIGH
2336         TAD (7771       / 3 ADDRESS BITS (& TEST)
2337         AND N7
2338         DCA LOCH
2339         SZL             /DID HIGH OVERFLOW ALSO?
2340         TAD N200        / YES, THEN BUMP BLK ALSO
2341         TAD BLK
2342         DCA BLK
2343         JMP I INC
2344
2345
2346 PAGE
2347 \f/OUTPUT PACKED STRING, ADDRESS IN CALL+1,
2348 / TERMINATOR IS XX00.
2349 TYPES,  0
2350         TAD I TYPES
2351         ISZ TYPES
2352         JMS TYPSTR
2353         JMP I TYPES
2354
2355 /OUTPUT PACKED STRING, ADDRESS IN AC, TERMIN IS XX00
2356 TYPSTR, 0
2357         DCA GETNT
2358 TTAGN,  CDF 10
2359         TAD I GETNT
2360         CDF 0
2361         ISZ GETNT
2362         JMS PACOUT
2363         TAD GNAME
2364         AND N77
2365         SNA CLA
2366         JMP I TYPSTR
2367         JMP TTAGN
2368
2369 /PACKED ASCII OUTPUT ROUTINE
2370 PACOUT, 0
2371         DCA GNAME
2372         TAD GNAME       /USE LEFT 6 BITS
2373         JMS I RTR6I
2374         JMS ONECHR
2375         TAD GNAME       /USE RIGHT 6 BITS
2376         JMS ONECHR
2377         JMP I PACOUT
2378
2379 /OUTPUT TRIMMED OR UNTRIMMED ASCII IN THE AC
2380 ONECHR, 0       /NO CODE FOR CR/LF
2381         AND N77
2382         SNA
2383         JMP I ONECHR    /IGNORE "@"
2384         TAD (-40
2385         SMA
2386         TAD M100
2387         JMS I TYPECI
2388           340
2389         JMP I ONECHR
2390
2391
2392 /SUBROUTINE TO MATCH CHAR AGAINST LIST1 AND JUMP
2393 /THROUGH LIST2 WHEN MATCH FOUND.  BOTH LISTS IN
2394 /FIELD 1.
2395
2396 SORTJ,  0
2397         SNA
2398         TAD CHAR        /USE CHAR IF AC = 0
2399         DCA SORTEM      /ITEM TO LOOK UP
2400         TAD I SORTJ
2401         ISZ SORTJ       /GET LIST1 ADDRESS
2402         DCA SCANX1
2403 SORT1,  CDF 10
2404         TAD I SCANX1    /COMPARE WITH SORTEM
2405         CDF 0
2406         SNA             /0 ?
2407         JMP SORT2       /END OF LIST
2408         CIA STL
2409         TAD SORTEM
2410         SZA CLA         /DOES IT MATCH?
2411         JMP SORT1       /NO, TRY NEXT
2412         TAD SCANX1      /YES, GET ADDRESS...
2413         TAD I SORTJ
2414         DCA SORTJ       /...OF JUMP ADDRESS
2415         CDF 10
2416         TAD I SORTJ
2417         DCA SORTJ
2418         CDF 0
2419         JMP I SORTJ     /GO TO ROUTINE
2420 SORT2,  ISZ SORTJ       /MATCH NOT FOUND,
2421         JMP I SORTJ     /EXIT TO CALL+3
2422 SORTEM, 0
2423
2424
2425 /SUBROUTINE TO GET A NAME FOR 'XOPEN', 'XFILE', 'XDEV' & 'XDDEV'
2426
2427 GNAME,  0       /GET A FILE OR DEVICE NAME
2428         DCA TEMP1       /SET UP "." SWITCH AND
2429         TAD TEMP1       / FILE/DEVICE SWITCH
2430         DCA TEMP2
2431         DCA NAM1
2432         DCA NAM2        /CLEAR NAME AREA
2433         DCA NAM3
2434         TAD (2326       / & INIT EXTENSION TO "SV"
2435         DCA NAM4
2436         TAD (NAM1       / & INIT POINTER FOR NAME
2437         DCA TEMP
2438         JMS I SSKIPI    /SKIP LEADING SPACES
2439         STA
2440         TAD COMOUT      /BACK UP THE POINTER
2441         DCA COMOUT
2442         JMS GPAIR       /1ST & 2ND CHAR
2443         JMS GPAIR       /3RD & 4TH
2444 GETSCN, JMS GPAIR       /5TH & 6TH OR 1ST & 2ND EXT.
2445         JMS GETNT       /SCAN FOR TERMINATOR
2446         CLA
2447         JMP .-2
2448 /
2449 GETCOL, TAD TEMP2       /":" SEEN, DEVICE OR FILE NAME?
2450         SZA CLA
2451         JMP GETNTC      / FILE, JUST USE THE ":"
2452         ISZ TEMP2       / DEVICE, FLAG ":" SEEN
2453         JMP GETSCN+1    /  AND SCAN TO TERMIN.
2454 /
2455 GETPER, ISZ TEMP1       /"." FOUND, FIRST ONE?
2456 ERCM,   ERROR           /NO, THE END...
2457         DCA NAM4        /YES, RESET EXT,
2458         TAD (NAM4       / SET POINTER
2459         DCA TEMP
2460         JMP GETSCN      / & GO GET IT
2461 /
2462 GETEND, STA             /TERM = SPACE, SET SWITCH
2463         DCA CRSWT       /TERM = CR, RESET SWITCH
2464         JMP I GNAME     /..DONE....
2465
2466 GETNT,  0       /GET & TEST A CHAR
2467         JMS I GETNI     /GET NEXT CHAR
2468         JMS I SORTI     /TEST IT
2469           GETLST-1
2470           GETOPS-GETLST
2471 GETNTC, TAD CHAR        /OK, USE CHAR
2472         AND N77         /MASK TO 6 BITS
2473         JMP I GETNT     / & EXIT WITH IT
2474
2475 GPAIR,  0       /GET RIGHT/LEFT-HALF-CHARS
2476         JMS GETNT
2477         JMS I RTL6I     /TO LEFT HALF
2478         DCA I TEMP      / & STORE IT
2479         JMS GETNT
2480         TAD I TEMP      /MERGE WITH LAST LEFT
2481         DCA I TEMP
2482         ISZ TEMP        /BUMP POINTER
2483         JMP I GPAIR
2484
2485 RTL6,   0       /ROTATE AC 6 LEFT
2486         CLL RTL
2487         RTL
2488         RTL
2489         JMP I RTL6
2490
2491 RTR6,   0       /ROTATE AC 6 RIGHT
2492         CLL RTR
2493         RTR
2494         RTR
2495         JMP I RTR6
2496
2497
2498 PAGE
2499 \f/SUBROUTINE TO READ A "LINE" FROM THE USER.  IT CHECKS FOR
2500 /  RUBOUT, ^U AND ^R FIRST, THEN CHECKS FOR ONE OF A LIST OF
2501 /  TERMINATORS PASSED BY THE CALLER.  AS WITH OS/8, RUBOUT
2502 /  DELETES CHARACTES AND ^U DELETES THE CURRENT LINE.  ^R
2503 /  (FOR RETYPE) ECHOES THE CURRENT COMMAND BUFFER IN THE SAME
2504 /  MANNER AS LINE-FEED DOES FOR OS/8.  IF THE CHARACTER IS A
2505 /  TERMINATOR, CONTROL PASSES DIRECTLY TO THE CORRESPONDING
2506 /  CALLER ROUTINE (OUT OF THIS ROUTINE).  INPUT CHARACTERS
2507 /  ARE ALSO TRANSLATED FROM LOWER CASE TO UPPER CASE.  EXIT
2508 /  IN THE NORMAL MANNER OCCURS ONLY ON BUFFER EMPTY FROM
2509 /  RUBOUT OR ^U.
2510
2511 READ,   0       /READ AND ECHO INPUT CHARACTER
2512         TAD I READ      /GET TWO LIST ADDRESS PARAMETERS
2513         ISZ READ
2514         DCA RETERM      / FROM CALLER AND SET UP IN
2515         TAD I READ      / SORT ROUTINE CALL
2516         ISZ READ
2517         DCA RETERM+1
2518 RENEXT, JMS RKEY        /GET A CHAR
2519           JMP RUBO      /RUBOUT, GO BEGIN DELETIONS
2520 REKEY,  DCA CHAR
2521         JMS I SORTI     /CHECK FOR CTRL-R & CTRL-U
2522           REACTL-1
2523           REACTS-REACTL
2524         TAD CHAR
2525         JMS I TYPEI
2526         JMS I SORTI     /CHECK FOR CALLER TERMINATORS
2527 RETERM,   0             / PARAMETERS HERE
2528           0
2529         TAD CHAR        /NONE, JUST STORE IN BUFFER
2530         SKP
2531 RESPC,  TAD ("          /FOR CAMMAND INPUT, TAB -> SPACE!
2532         CDF 10
2533         DCA I COMIR     /COMMAND (LINE) INPUT BUFFER
2534         CDF 0
2535         JMP RENEXT
2536 /
2537 /+++    FOR SCOPE OPERATION, RUBOUTS CAUSE OUTPUT OF THE
2538 /+++    SEQUENCE BACKSPACE, SPACE, BACKSPACE TO CLEAR THE
2539 /+++    PREVIOUS CHARACTER FROM THE SCREEN.  IF "SCOPE
2540 /+++    MODE" IS SET, RUBO IS OVERLAID ON STARTUP.
2541
2542 /***    FOR BATCH OPERATION, RUBOUTS ARE IGNORED BY 'RKEY'
2543 /***    AND 'RUBO' IS OVERLAID WITH CODE TO IGNORE A LINE-
2544 /***    FEED THAT FOLLOWS A CARRIAGE-RETURN.
2545 /
2546 RUBO,   JMS BTEST       /RUBOUT TYPED,TEST FOR EMPTY
2547         JMP RUBOF       / INPUT BUFFER EMPTY!
2548         JMS I TYPECI    /OK, OUTPUT 1ST "\"
2549           "\
2550 RUBO1,  JMS BTEST       /NOW EMPTY?
2551         JMP RUBOE       / YES, LINE END
2552         TAD COMIR       /ECHO LAST CHAR IN BUFFER
2553         DCA ENDC
2554         CDF 10
2555         TAD I ENDC
2556         CDF 0
2557         JMS I TYPEI
2558         STA
2559         TAD COMIR       /NOW BACK UP POINTER
2560         DCA COMIR
2561         JMS RKEY        /GET A CHAR
2562           JMP RUBO1     /ANOTHER RUBOUT, GO HANDLE
2563         DCA BTEST       /SAVE THE CHAR
2564         JMS I TYPECI    / DO CLOSING "\"
2565           "\
2566         TAD BTEST
2567         JMP REKEY       /& GO USE NEW CHAR
2568 /
2569 RUBOE,  JMS I TYPECI    /BUFFER WAS EMPTIED,
2570           "\            /OUTPUT CLOSING "\"
2571 RUBOF,  JMS I CRLFI     / & A CR/LF
2572         JMP I READ
2573 /
2574 RECHO,  JMS I TYPECI    /ECHO "^R" & THEN
2575           "R-100
2576         JMS I CRLFI     /ECHO CURRENT LINE
2577         TAD COMST       /INIT AUTO-XR
2578         DCA COMOUT
2579 RECHO1, TAD COMOUT      /DONE?
2580         CIA
2581         TAD COMIR
2582         SNA CLA
2583         JMP RENEXT      /YES, MORE INPUT
2584         JMS I GETNI     /NO, GET NEXT CHAR
2585         JMS I TYPEI     / & OUTPUT IT
2586         JMP RECHO1      / & CONTINUE
2587 /
2588 RERASE, JMS I TYPECI    /OUTPUT "^U"
2589           "U-100
2590         JMP RUBOF       /GO OUTPUT CR/LF & EXIT
2591
2592 BTEST,  0       /TEST FOR COMM. BUFFER EMPTY
2593         TAD COMIR
2594         CIA
2595         TAD COMST
2596         SZA CLA         /EMPTY?
2597         ISZ BTEST       /NO, STILL OK, TO CALL+2
2598         JMP I BTEST     / OTHERWISE TO CALL+1
2599 \fRKEY,  0       /GET A NON-NULL CHAR, TEST & TRANSLATE
2600         KSF             /***    JMS I CTRLI     /CHECK KEYBOARD
2601         JMP .-1         /***    CIF BAT         /BATCH OPER.
2602         JMS I CTRLI     /***    JMS I BATINI
2603         KSF             /***    ERROR           /EOF!!
2604         JMP RKEY+1      /***    NOP     /MUST USE SPECIAL CARE
2605         KRB             /***    NOP     / TO HANDLE CTRL-Q!
2606         AND N177        /MASK OFF PARITY
2607         SNA
2608         JMP RKEY+1      /NULL CHAR
2609         TAD (-177       /IS IT A RUBOUT?
2610         SNA
2611 RKEY0,  JMP I RKEY      /YES, EXIT TO CALL+1    /*** BATCH
2612         ISZ RKEY        /NO, EXIT TO CALL+2     /*** OPER.
2613         TAD (2          /TEST FOR ALT-MODES
2614         SMA
2615         JMP RKEY1       / 375 OR 376
2616         TAD (35         /IS IT LOWER CASE?
2617         SMA
2618         TAD (-40        /YES, MAKE UPPER CASE
2619         TAD (-35
2620 RKEY1,  TAD (375        /RESTORE CHAR & ADD PARITY
2621         JMP I RKEY      / & EXIT WITH IT
2622
2623
2624 /SUBROUTINE TO TERMINATE COMMAND BUFFER WITH A C.R.
2625 /RETURN TO CALL+1 IF ONLY A CR (EXCLUDING LEADING
2626 /SPACES) IN BUFFER, TO CALL+2 IF ANYTHING ELSE.
2627 ENDC,   0
2628         TAD (215        /PUT A CR IN BUFFER
2629         CDF 10
2630         DCA I COMIR
2631         CDF 0
2632         TAD COMST       /INIT'L BUFFER UNLOAD
2633         DCA COMOUT
2634         TAD CHAR        /SAVE CHAR FOR POSSIBLE
2635         DCA TEMP        / USE BY 'WCHEK'
2636         JMS I GETNI     /GET FIRST CHARACTER
2637         JMS I SSKIPI    /SKIP LEADING SPACES
2638         TAD CHAR        /GET 1ST NON-SPACE
2639         TAD M215        /IS IT A CR?
2640         SZA CLA         /YES, NOTHING IN BUFFER
2641         ISZ ENDC        /OTHERWISE RETURN TO CALL+2
2642         JMP I ENDC
2643
2644
2645 DODIG,  0       /OUTPUT AC AS AN ASCII DIGIT
2646         JMS I TYPECI
2647           "0
2648         JMP I DODIG
2649
2650
2651 PAGE
2652 \f/'FPP'/OCTAL/'PDP' OUTPUT ROUTINE FOR ODT
2653 ODTOUT, 0
2654         TAD TYPSW       /-1, 0, +1
2655         TAD (TAD ODTOL  /GENERATE ADDRESS OF DESIRED
2656         DCA ODTOPT      / OUTPUT ROUTINE
2657 ODTOPT, HLT             /[USED TWICE!]
2658         DCA ODTOPT
2659         JMS I ODGETI    /GET SPECIFIED WORD
2660         JMS I ODTOPT    / & OUTPUT IT
2661         JMP I ODTOUT
2662
2663         FPPDMP          /-1 = OCTAL + FPP
2664 ODTOL,  OPRT            / 0 = OCTAL
2665         PDPDMP          /+1 = OCTAL + PDP
2666
2667
2668 /OCTAL & 'PDP' (SYMBOLIC) DUMP ROUTINE
2669 PDPDMP, 0
2670         JMS I OCTI      /FIRST OUTPUT IN OCTAL
2671         SPACE2          /FOLLOWED BY 2 SPACES,
2672         JMS PDPOUT      / & THEN AS 'PDP'
2673         JMP I PDPDMP
2674
2675
2676 /'PDP' (SYMBOLIC) INSTRUCTION DECODING
2677 PDPOUT, 0
2678         CLA
2679         JMS OPRTST      /TEST FOR OPR & IOT
2680         JMP OPRS        /  OPR
2681         JMS IOPRNT      /  IOT
2682 SYMS,   JMS GETOP       /GET OP-CODE TO BITS 9-11
2683         RAL             / * 2
2684         JMS SYMTYP      /OUTPUT 3 CHAR SYMBOL & SPACE
2685           INSLST        /(TABLE FOR INDEXING)
2686           -2            /(- # WORDS)
2687         JMS OPRTST      /TEST FOR OPR & IOT
2688         JMP SYMEND      /  OPR, DONE
2689         JMP IOTS        /  IOT
2690         TADICAD         /MEMORY REF., INDIRECT?
2691         AND (400
2692         SNA CLA
2693         JMP REFS1       /NO
2694         JMS I TWOCI     /YES, OUTPUT "I "
2695           1140
2696 REFS1,  TADICAD         /SET UP ADDR BITS
2697         AND N177
2698         DCA BITVAL      /SAVE THEM
2699         TADICAD         /IS THIS A 'PAGE 0 REF'?
2700         AND N200
2701         SZA CLA
2702         TAD LOCL        /NO, USE PAGE BITS
2703         AND M200
2704         TAD BITVAL      /OK, NOW ADD ADDR BITS
2705 REFS2,  JMS I OCTI      /OUTPUT IN OCTAL
2706 SYMEND, JMP I PDPOUT    /DONE, RETURN
2707
2708 /
2709 IOTS,   TADICAD         /USE ONLY LAST 9 BITS
2710         AND (777
2711         JMP REFS2       /AND OUTPUT IN OCTAL
2712 /
2713 OPRS,   TADICAD         /IS THIS A NOP?
2714         AND (777
2715         SNA
2716         JMP SYMS        /YES, OUTPUT "NOP "
2717         AND N200        /IS THERE A CLA IN IT?
2718         SNA CLA
2719         JMP OPRS1       /NO, CONTINUE
2720         JMS SYMTYP      /YES, OUTPUT "CLA "
2721           CLANAM
2722           -2
2723         IAC
2724 OPRS1,  DCA CNT         /SET ANYTHING OUTPUT SWITCH
2725         TADICAD         /SET UP WORD FOR DECODE
2726         JMS I RTL6I
2727         RAR
2728         DCA BITVAL      /SAVE IT
2729         TADICAD         /CHECK FOR OPR1, OPR2 OR EAE
2730         CLL RAR
2731         AND N200
2732         SNA
2733         JMP OPR1A       /OPR1 MICRO-INSTRUCTION
2734         SNL CLA
2735         JMP OPR2A       /OPR2 MICRO-INSTRUCTION
2736 /
2737 /DO THE DOCODING FOR THE EAE MICRO-INSTRUCTIONS
2738 EAE,    TAD (EAELST-2   /SET UP EAE LIST POINTER
2739         DCA BITPNT
2740         JMS BITS        /SHIFT & CHECK BIT 5
2741         JMS OPRTYP      /IF = 1, "MQA "
2742         TAD BITVAL      /CHECK BIT 6
2743         CLL RAL         /("SCA" IN "A" MODE OF 8/E
2744         DCA BITVAL      / 'MODE BIT' IN "B" MODE)
2745         SZL
2746         TAD N20         /IF ON, USE OTHER WORDS
2747         DCA EAETMP
2748         JMS BITS        /CHECK BIT 7
2749         JMS OPRTYP      / "MQL "
2750         TADICAD
2751         AND (16
2752         TAD EAETMP      /(ADD SWITCH WORD)
2753         JMS SYMLIM      /CHECK FOR & OUTPUT LAST INST.
2754           -36           /UPPER LIMIT
2755 EAETMP, 0
2756 /
2757 /DO THE DECODING FOR THE OPR1 MICRO-INSTRUCTIONS
2758 OPR1A,  TAD (OP1LST-2   /SET OPR1 LIST
2759         DCA BITPNT
2760         JMS BITS        /SHIFT & CHECK BIT 5
2761         JMS OPRTYP      /IF = 1, OUTPUT "CLL "
2762         JMS BITS        /CHECK BIT 6
2763         JMS OPRTYP      / "CMA "
2764         JMS BITS        /CHECK BIT 7
2765         JMS OPRTYP      / "CML "
2766         ISZ BITPNT      /BUMP POINTER
2767         ISZ BITPNT
2768         TADICAD         /LOOK FOR IAC
2769         RAR
2770         SZL CLA
2771         JMS OPRTYP      /OUTPUT "IAC "
2772         TADICAD         /SET UP TO CHECK FOR ROTATES
2773         AND (16
2774         JMS SYMLIM      /CHECK & OUTPUT
2775           -12           /UPPER LIMIT
2776
2777
2778 PAGE
2779 \f/OCTAL & 'FPP' (SYMBOLIC) DUMP ROUTINE
2780 FPPDMP, 0
2781         JMS I OCTI      /FIRST OUTPUT IN OCTAL
2782         SPACE2          / THEN 2 SPACES
2783         JMS FPPOUT      / & THEN AS FPP
2784         JMP I FPPDMP
2785
2786 /THE FOLLOWING ROUTINES ARE USED BY 'PDPOUT'
2787
2788 /DO THE DECODING FOR THE OPR2 MICROINSTRUCTIONS
2789 OPR2A,  TAD (OP2LST-2   /SET UP LIST POINTER
2790         DCA BITPNT
2791         JMS BITS        /SHIFT & CHECK BIT 5
2792         JMS OPR2T       /IF 1, OUTPUT "SMA " OR "SPA "
2793         JMS BITS        /CHECK BIT 6
2794         JMS OPR2T       / "SZA " OR "SNA "
2795         JMS BITS        /CHECK BIT 7
2796         JMS OPR2T       / "SNL " OR "SZL "
2797         JMS BITS        /CHECK BIT 8
2798         SKP
2799         JMP OPR2B       /IT WAS 0
2800         TADICAD         /MUST CHECK FOR "SKP "
2801         AND (160
2802         SNA CLA         /ARE ALL SKIP SENSES = 0?
2803         JMS OPRTYP      /YES, SO OUTPUT "SKP "
2804 OPR2B,  TAD (OP2LST+14  /SET UP CHECK FOR OSR & HLT
2805         DCA BITPNT
2806         JMS BITS        /CHECK BIT 9
2807         JMS OPRTYP      / "OSR "
2808         JMS BITS        /CHECK BIT 10
2809         JMS OPRTYP      / "HLT "
2810         JMP OPEND       /CHECK FOR ANY DONE
2811
2812 SYMLIM, 0       /CHECK LAST SYMBOL AGAINST LIMIT
2813         DCA CHAR        /SAVE AC
2814         TAD CHAR
2815         SPA SNA         /IS IT > 0?
2816         JMP OPEND       /NO, TEST IF ANY OUTPUT DONE
2817         TAD I SYMLIM    /IT IS > UPPER LIMIT?
2818         SMA SZA CLA
2819         JMP OPEND       /NO, GO CHECK AGAIN
2820         TAD CHAR        /CALCULATE ADDRESS
2821         JMS OPRTYP      / & OUTPUT LAST
2822         JMP SYMEND      /...DONE
2823 /
2824 OPEND,  CLA
2825         TAD CNT         /ANYTHING OUTPUT?
2826         SZA CLA
2827         JMP SYMEND      /YES, DONE WITH OUTPUT
2828         JMS SYMTYP      /NO, OUTPUT "OPR "
2829           OPRMES
2830           -2
2831         JMP IOTS        /NOW GO OUTPUT LAST 9 BITS
2832
2833 BITS,   0       /DECODE A WORD ONE BIT AT A TIME
2834         TAD BITVAL      /SHIFT A BIT INTO LINK
2835         CLL RAL
2836         DCA BITVAL      /SAVE FOR LATER
2837         ISZ BITPNT      /BUMP SYMBOL POINTER
2838         ISZ BITPNT
2839         SNL
2840         ISZ BITS        /TO CALL+2 IF L = 0
2841         JMP I BITS
2842
2843 OPRTYP, 0       /OUTPUT AN OPR SYMBOL
2844         JMS SYMTYP      /OUTPUT THE SYMBOL
2845 BITPNT,   0             /ADDRESS
2846           -2
2847         ISZ CNT         /SET SWITCH
2848         JMP I OPRTYP
2849
2850 SYMTYP, 0       /OUTPUT A SYMBOL
2851         TAD I SYMTYP    /ADD TABLE ADDR TO ANY INDEX
2852         ISZ SYMTYP
2853         DCA SYMPNT      /SAVE POINTER
2854         TAD I SYMTYP    /GET COUNT OF WORDS
2855         ISZ SYMTYP
2856         DCA BITS        / & SAVE IT
2857 SYMNXT, CDF 10          /"SYMBOL"S IN FIELD 1
2858         TAD I SYMPNT
2859         CDF 0
2860         JMS I TWOT      /OUTPUT A PAIR OF LETTERS
2861         ISZ SYMPNT
2862         ISZ BITS        /DONE?
2863         JMP SYMNXT
2864         JMP I SYMTYP
2865 SYMPNT, 0
2866
2867 OPR2T,  0       /OUTPUT AN OPR2 SYMBOL
2868         TADICAD
2869         AND (10         /IF BIT IS ON, REVERSE THE
2870         JMS OPRTYP      /SENSE OF THE SKIP
2871         JMP I OPR2T
2872
2873 BITVAL, 0
2874
2875
2876 IOPRNT, 0       /OUTPUT I/O NAMES
2877         TAD (IOTTAB     /SET UP POINTER
2878 IOPRN1, DCA IOPNT       /SET (OR UPDATE) POINTER
2879         CDF 10
2880         TAD I IOPNT     /GET NEXT IOT
2881         CDF 0
2882         SNA             /AT END OF TABLE?
2883         JMP I IOPRNT    /YES, CODE NOT FOUND
2884         CIA
2885         TADICAD         /NO,  DO THEY MATCH?
2886         SNA CLA
2887         JMP IOPRN2      /YES, OUTPUT NAME
2888         TAD (4          /NO, UPDATE POINTER
2889         TAD IOPNT
2890         JMP IOPRN1      / & TRY AGAIN
2891 /
2892 IOPRN2, IAC             /WORD FOLLOWS CODE
2893         JMS SYMTYP      /OUTPUT THE MNEMONIC
2894 IOPNT,    0
2895           -3
2896         JMP SYMEND      / & RETURN
2897
2898
2899 OPRTST, 0       /TEST "INSTRUCTION" FOR OPR & IOT
2900         TADICAD         /GET WORD
2901         AND N7000       /MASK OFF OP CODE
2902         TAD (1000       /IS IT AN OPR?
2903         SNA
2904         JMP I OPRTST    /YES, EXIT TO CALL+1
2905         ISZ OPRTST
2906         TAD (1000       /IS IT AN IOT?
2907         SZA CLA
2908         ISZ OPRTST      /NO, EXIT TO CALL+3
2909         JMP I OPRTST    / YES, TO CALL+2
2910
2911
2912 PAGE
2913 \f/'FPP' (SYMBOLIC) INSTRUCTION DECODING
2914 FPPOUT, 0
2915         CLA             /HARD TO TELL WHAT MIGHT COME!
2916         TADICAD         /GET THE WORD
2917         AND (600        /MASK OFF MODE BITS
2918         SNA
2919         JMP SPECIAL     / NON-ARITHMETIC
2920         TAD M400        /GIVES: -=BASE, 0=LONG, +=INDIR.
2921         DCA TEMP2
2922         JMS GETOP       /GET OP-CODE TO BITS 9-11
2923 FPLEA,  JMS MULT3       /MULTIPLY BY 3 (WORDS/OP OUT)
2924         JMS SYMTYP      /OUTPUT 6 CHAR OPR SYMBOL
2925           FPPINS        /(INCLUDING "LEA")
2926           -3
2927         TAD TEMP2       /NOW HANDLE MODE
2928         SNA
2929         JMP LONG        / LONG INDEXED
2930         SMA CLA
2931         JMP INDIR       / INDIRECT INDEXED
2932 BASE,   JMS I TYPSI     / BASE - OUTPUT "  B+"
2933           MSBASE
2934         TADICAD         /GET WORD AGAIN
2935         AND N177        / MASK OFF OFFSET
2936         JMS MULT3       / MULTIPLY IT BY 3
2937         JMS OCT3        / & OUTPUT IN OCTAL
2938         JMP I FPPOUT
2939 /
2940 INDIR,  JMS I TYPSI     /OUTPUT "% B+"
2941           MSINDI
2942         TADICAD         /GET WORD AGAIN
2943         AND N7          / MASK OFF OFFSET
2944         JMS MULT3       / MULTIPLY IT BY 3
2945         JMS OCT3        / & OUTPUT IT IN OCTAL
2946         JMP XRPLUS      /FINALLY DO XR OUTPUT
2947 /
2948 LONG,   JMS I TWOCI     /OUTPUT "# "
2949           4340
2950         JMS FLDOUT      /AND FIELD AND "*"
2951 XRPLUS, JMS GET678      /GET XR FIELD
2952         JMS I TWOCI     / & OUTPUT ",X" WHERE
2953           5460          / "X" IS A DIGIT
2954         TADICAD         /GET WORD THE LAST TIME
2955         AND (100        / AND CHECK "+" BIT
2956         SZA CLA
2957         JMS I TYPECI    /OUTPUT "+" OR SKIP
2958           "+            /[A NOP]
2959         JMP I FPPOUT
2960 /
2961 SPECIAL,JMS GETOP       /GET OP-CODE
2962         JMS I SORTI     / & BRANCH ON IT
2963           FPPMO0-1
2964           FPPMOJ-FPPMO0
2965 SPCOP0, TADICAD         /FALLS THRU ON 0, GET
2966         AND (170        / SUB-OP-CODE
2967         JMS I SORTI     / & BRANCH ON IT
2968           FPPOP0-1
2969           FPPOPJ-FPPOP0
2970 SPOP00, TADICAD         /FALLS THRU ON 0, USE AS
2971         AND N7          / INDEX INTO LAST LIST
2972         IAC
2973 SPOP04, JMS MULT3       /THREE WORDS/SYMBOL
2974         JMS SYMTYP      /OUTPUT ONE OF SEVERAL
2975           FPOP00        / SYMBOLS IN THIS LIST
2976           -3
2977         JMP I FPPOUT
2978 /
2979 SPOP05, CLL STA         /= -1
2980         JMP SPOP04      /OUTPUT "STARTE"
2981 /
2982 SPNUSE, CLL STA RAL     /= -2
2983         JMP SPOP04      /OUTPUT "UNUSED"
2984 /
2985 SPO123, JMS GET678      /"ALN X", "ATX X", "XTA X"
2986         CLL RAL         /(2 WORDS PER)
2987         JMS SYMTYP      /OUTPUT SYMBOL
2988           FPXR1S-2
2989           -2
2990         JMP XROUT       / & XR VALUE
2991 /
2992 SPOP10, TAD (4          /"LDX *,X"
2993 SPOP11, JMS SYMTYP      /"ADDX *,X"
2994           FPXR2S
2995           -4
2996 XROUT,  TADICAD         /GET XR FIELD
2997         AND N7
2998         DIGIT           / & OUTPUT AS DIGIT
2999         JMP I FPPOUT
3000 /
3001 SPCOP1, TADICAD         /GROUP 0 OR 1?
3002         AND (100
3003         SNA CLA
3004         JMP SPOP1J      / 1 = CONDITIONAL JUMPS
3005         JMS GET678      / 0 = SETS, ETC.
3006         TAD (-4         /SUB-OP-CODES 0 THRU 3?
3007         SMA CLA
3008         JMP SPNUSE      / NO, 4 THRU 7 = UN-USED
3009         JMS GET678      /0 THRU 3: SETX,SETB,JSA,JSR
3010         IAC             / +1+1 => 2 THRU 5
3011 SPCOP3, IAC             / 1: TRAP3
3012 SPCOP4, JMS MULT3       / 0: TRAP4
3013         JMS SYMTYP      /GO DO ONE OF THESE
3014           FOP134
3015           -3
3016         JMP DOFLD       /FINISH WITH FIELD
3017 /
3018 SPOP1J, JMS CONDIT      /CONDITIONAL JUMPS
3019           1200          / "J--"
3020         SPACE2
3021 DOFLD,  JMS FLDOUT      /OUTPUT FIELD & "*"
3022         JMP I FPPOUT
3023 /
3024 SPCOP2, JMS I TYPSI     /OUTPUT "JNX "
3025           MSJNX
3026         JMP XRPLUS-1    / & HANDLE ADDRESS
3027 /
3028 /  SPCOP3 & SPCOP4
3029 /
3030 SPCOP5, TADICAD         /GET WORD AGAIN
3031         AND (100
3032         SZA CLA
3033         JMP SPNUSE      /BIT 5 ON IS UNUSED OP
3034         JMS CONDIT      /LOAD TRUTH
3035           1424          / "LT--"
3036         JMP I FPPOUT
3037 /
3038 SPCOP7, IAC             / "LEA" INDIRECT, SET SWITCH
3039 SPCOP6, DCA TEMP2       / "LEA" LONG, SET SWITCH
3040         CLL STA
3041         JMP FPLEA       / & GO DO OUTPUT
3042
3043
3044 PAGE
3045 \fPDATE, 0       /ROUTINE TO OUTPUT AN EXTENDED DATE WORD
3046         DCA CRLF        /SAVE IT
3047         TAD CRLF        /GET WORD & MASK
3048         AND N377
3049         CLL RTR         /DAY (4-8) TO 7-11
3050         RAR
3051         JMS I DEC2I     / OUTPUT AS 2 DIGITS (MASKED)
3052         JMS I TYPECI    / AND A SEPARATOR
3053           "-
3054         TAD CRLF        /GET WORD A SECOND TIME
3055         JMS I RTR6I     /MONTH (0-3) TO 7-10
3056         RAR             / FOR MONTH*2
3057         AND (36         / MASK IT AND USE AS AN INDEX
3058         JMS I TYPSI     / TO OUTPUT MONTH IN ALPHA
3059           MONTHS        / FORM (WITH SAFETY...)
3060         JMS I TYPECI    /FOLLOWED BY "-"
3061           "-
3062         TAD CRLF        /GET LAST TIME
3063         AND N7          / MASK OFF YEAR
3064         TAD YRTEST      /  TEST IF .GT. THIS YEAR
3065         SMA SZA
3066         TAD (-10        /   YES, SUBTRACT 8
3067         TAD YRBASE      / ADD TO BASE YEAR
3068         JMS I DEC2I     / & OUTPUT IT
3069         JMP I PDATE
3070 YRTEST, 0       /-(THIS YEAR) FOR TESTING
3071 YRBASE, 0       /BASE YEAR FOR DATE + THIS YEAR
3072
3073
3074 TYPEA,  0       /OUTPUT ASCII CHARACTER IN THE AC
3075         TAD I TYPEA     /GET ARG, IF ANY
3076         ISZ TYPEA
3077         DCA I RTL6I     /SAVE THE CHAR HERE FOR FIELD 1
3078         JMS I CTRLI
3079         CIF 10
3080         JMP TYPE1       /GO TO FIELD 1 TO DO THE OUTPUT
3081 /
3082 TYPEX,  ISZ NCNT        /BUMP LINE POSITION
3083         JMP I TYPEA     / & EXIT
3084
3085 CRLF,   0       /OUTPUT CARRIAGE RETURN, LINE FEED
3086         CLA
3087         JMS TYPEA
3088           215
3089         JMS TYPEA
3090           212
3091         DCA NCNT        /RESET LINE POSITION
3092         JMP I CRLF
3093
3094
3095 TYPEC,  0       /OUTPUT A SINGLE CHAR ARG
3096         TAD I TYPEC     /GET IT
3097         ISZ TYPEC
3098         JMS TYPE        /OUTPUT IT
3099         JMP I TYPEC
3100
3101
3102 TYPE,   0       /CHARACTER OUTPUT ROUTINE
3103         AND N377        /BE SURE ONLY 8 BITS
3104         SNA
3105         TAD CHAR        /USE CHAR IF AC = 0
3106         DCA TCHAR       /CHAR TO OUTPUT
3107         TAD TCHAR
3108         JMS I SORTI     /CHECK FOR SPECIALS
3109           TYPEL-1
3110           TYPEOP-TYPEL
3111         TAD TCHAR       /IS TCHAR < 240?
3112         TAD M240
3113         SPA CLA
3114         JMP TYPCTL      /NO, OUTPUT AS CTRL-CHAR
3115 TYPC,   JMS TYPEA       /NOW OUTPUT CHAR
3116 TCHAR,    0
3117         JMP I TYPE
3118 /
3119 TYPALT, JMS TYPEA       /OUTPUT "$" FOR ALT-MODES
3120           "$
3121         JMP I TYPE
3122 /
3123 TYPCR,  JMS CRLF        /C.R. TO OUTPUT
3124         JMP I TYPE
3125 /
3126 TYPTAB, JMS TYPEA       /SPACE OVER FOR TAB
3127           "
3128         TAD NCNT        /TAB TO OUTPUT
3129         TAD M10
3130         SNA
3131         JMP I TYPE
3132         SMA
3133         JMP TYPTAB+3    /REDUCE BY TAB SIZE
3134         CLA
3135         JMP TYPTAB
3136 /
3137 TYPCTL, JMS TYPEA       /CONTROL-CHAR, OUTPUT AS
3138           "^
3139         TAD C100        / "^","CHAR+100"
3140         JMP TYPC
3141 C100,   100
3142
3143
3144 CTRL,   0       /CHECK FOR CTRL-C, CTRL-S, CTRL-Q & CTRL-P
3145         DCA CTRLQS      /CLEAR HANG FLAG
3146 CTRL0,  KSF             /HAS A KEY BEEN HIT?
3147         JMP CTRLX       /NO, TEST IF HANGING
3148         KRS
3149         AND N177        /YES, MASK OFF PARITY BIT
3150         TAD (-"C+300    /IS IT A CTRL-C (ABORT PROGRAM)?
3151         SNA
3152 BCTRLC, JMP CTRLC       /***    JMP I CTRLCI    /== ABORT ==
3153         TAD M20         /IS IT A CTRL-S (STOP OUTPUT)?
3154         SZA
3155         JMP CTRL1
3156         ISZ CTRLQS      / YES, SET HANG FLAG
3157         KCC             /  & CLEAR HARDWARE FLAG
3158 CTRL1,  TAD (2          /IS IT A CTRL-Q (START OUTPUT)?
3159         SZA
3160         JMP CTRL2
3161         KCC             / YES, CLEAR THE HARDWARE
3162         JMP I CTRL      /  & JUST EXIT
3163 /
3164 CTRL2,  IAC             /IS IT A CTRL-P (STOP PROGRAM)?
3165         SZA CLA
3166         JMP CTRLX       /NO, TEST IF HANGING
3167         KCC
3168         DCA DSWIT       /YES, RESET DUMP SWITCH
3169         JMS I TYPECI    /OUTPUT "^P"
3170           "P-100
3171         JMP I RECRLF    / THEN CR/LF & RESTART
3172 /
3173 /ROUTINE TO EXECUTE THE 'EXIT' COMMAND
3174 /
3175 XEXIT,
3176 CTRLC,  DCA DSWIT       /RESET DUMP SWITCH
3177         JMP I M200      / & GO TO SYSTEM
3178 CTRLCI, XERR4+1         /*** CTRL-C ABORTS JOB STREAM! ***
3179 /
3180 CTRLX,  TAD CTRLQS      /HANGING BECAUSE OF CTRL-S?
3181         SZA CLA
3182         JMP CTRL0       / YES, BACK FOR ANOTHER ROUND
3183         JMP I CTRL      / NO, OUT WE GO!
3184
3185 CTRLQS, 0       /CTRL-S, CTRL-Q FLAG
3186
3187
3188 PAGE
3189 \f/INPUT AN UNSIGNED 24 BIT NUMBER
3190 ACCEPT, 0
3191         DCA ACC1        /CLEAR LO
3192         DCA ACC2        / & HI WORDS
3193         DCA DADD        / & LEGAL INPUT SWITCH
3194         JMS I SSKIPI    /GET FIRST NON-SPACE
3195         SKP
3196 ACCPT1, JMS I GETNI     /DON'T IGNORE SPACES
3197         JMS I SORTI     /CHECK FOR ^D, ^K, (, ", ',
3198           GWLST1-1      / DIGITS, SPACE
3199           ACOPS-GWLST1
3200         JMP ACCPT3      /NONE OF THE ABOVE
3201 /
3202 ACCNUM, TAD CHAR
3203         TAD (-"0        /MAKE A DIGIT
3204         DCA OCTSET
3205         TAD OCTSET      /IS DIGIT LEGAL?
3206         CIA
3207         TAD ACBASE
3208         SPA SNA CLA
3209 ERC09,  ERROR           / NO, ILLEGAL DIGIT!
3210 ACCMUL, TAD ACBASE      /SET UP MULTIPLY OF PREVIOUS
3211         DCA OPER1       / BY BASE
3212         DCA OPER2
3213         JMS DMUL        / DO MULTIPLY
3214         TAD OCTSET      /SET UP ADD OF NEXT "DIGIT"
3215         DCA OPER1
3216         DCA OPER2
3217         JMS DADD        /OK, DO THE ADD (& SET SWITCH)
3218         JMP ACCPT1
3219 /
3220         STA             /  SPACE HERE
3221         DCA CRSWT       /SET SWITCH: CR HERE
3222 ACCPT3, TAD DADD        /TERMINATING CHAR RECEIVED
3223         SNA CLA         /CHECK FOR LEGAL INPUT
3224 ERCR,   ERROR           /YOU CAN'T OUT-SMART ME!
3225         JMP I ACCEPT
3226 ACBASE, 10
3227 /
3228 /
3229 DQUOTE, JMS QUOTEC      / " - GET SINGLE CHAR
3230         DCA OCTSET      / SAVE VALUE
3231         JMP ACCMUL      / & USE IT AS A "DIGIT"
3232 /
3233 SQUOTE, JMS QUOTEC      / ' - PACKED ASCII, GET 1ST
3234         AND N77         /MASK TO 6 BITS
3235         JMS I RTL6I     /MOVE TO LEFT HALF
3236         DCA OCTSET      / & SAVE IT
3237         JMS QUOTEC      /GET 2ND CHAR
3238         AND N77         /MASK
3239         TAD OCTSET      /MERGE
3240         JMP DQUOTE+1    / & USE THIS AS A "DIGIT"
3241 /
3242 CTRLD,  TAD (2          / ^D - SET RADIX TO DECIMAL
3243 CTRLK,  JMS OCTSET      / ^K - SET RADIX TO OCTAL
3244         JMP ACCPT1
3245
3246
3247 /SUB. TO SET UP FOR OCTAL/DECIMAL INPUT.  CALLED FROM
3248 /  COMMAND INPUT & MODIFY & IF AN "^K"/"^D" IN INPUT.
3249 OCTSET, 0       /SET UP FOR OCTAL/DECIMAL INPUT
3250         TAD (10         /ENTER WITH AC= 2 FOR DECIMAL
3251         DCA ACBASE
3252         JMP I OCTSET
3253
3254 QUOTEC, 0       /GET A QUOTED CHARACTER
3255         JMS CGTEST      /GET & TEST FOR A CR
3256 ERC13,    ERROR         / ILLEGAL USE OF " OR '
3257         TAD CHAR        /OK, RETURN WITH IT
3258         JMP I QUOTEC
3259
3260
3261 /SUBROUTINE TO DEVELOP ARGUMENTS FROM THE COMMAND
3262 /BUFFER, AND RETURN WITH -(#) OF ARGS IN 'TEMP'.
3263 GARGS,  0
3264         TAD TEMPST      /GET BUFFER ADDRESS
3265         DCA DPNT
3266         DCA TEMP        /ZERO THE NUMBER OF ARGS
3267 GAR1,   STA
3268         DCA TEMP1       /SET BLK TO -1
3269         STA
3270         DCA CNT         /RESET SWITCH
3271 GAR2,   JMS EXPRIN      /GET NEXT ARG
3272         JMS I SSKIPI    /IGNORE TRAILING SPACES
3273         JMS I SORTI     /BRANCH ON TERMINATOR
3274           GARLST-1
3275           GAROPS-GARLST
3276 ERCS,   ERROR           /ILLEGAL TERMIN., FLAME OUT
3277 /
3278 GAR3,   JMS GPUT        /CR FOUND, END
3279         TAD TEMPST      /SET UP POINTER FOR
3280         DCA DPNT        / GETTING RESULTS
3281         JMP I GARGS
3282 /
3283 GAR4,   JMS I GETNI     /SKIP OVER "."
3284         TAD ACC1        /.= TERMIN (BLOCK PART)
3285         JMP GAR1+1      /SET BLOCK & GET NEXT
3286 /
3287 GAR5,   TAD ACC1        /-= TERMIN (LOC PART)
3288         DCA TEMP2
3289         JMS I GETNI     /SKIP OVER "-"
3290         JMP GAR2-1      /GO SET SWITCH
3291 /
3292 GAR6,   JMS GPUT        /,= TERMIN
3293         JMS I GETNI     /SKIP OVER ","
3294         JMP GAR1
3295
3296
3297 /SUBROUTINE TO PUT THE DEVELOPED ARGS IN THE ARG
3298 /BUFFER.  ALL ARGUMENTS ARE STORED IN 4 WORDS IN
3299 /THE BUFFER, AS SPECIFIED BY:
3300 /   BLOCK.LOC1-LOC2  (TERMINATED BY , OR C.R.)
3301 /AS:
3302 /I-------I-------I-------I-------I-----
3303 /I WORD1 I WORD2 I WORD3 I WORD4 I ETC.
3304 /I-------I-------I-------I-------I-----
3305 /WHERE:
3306 /  WORD1=       BLOCK (OR -1 IF NONE SPECIFIED)
3307 /  WORD2=       LOC (HIGH) [ONLY 3 BITS, LOC2 IF SPEC'D]
3308 /  WORD3=       LOC1 (LOW)
3309 /  WORD4=       LOC2-LOC1-1 (LOC2=LOC1 IF NOT
3310 /               SPECIFIED) [ONLY 12 LOW BITS USED]
3311 GPUT,   0
3312         TAD TEMP1
3313         DCA I DPNT      /SET BLOCK
3314         ISZ CNT         /WAS A LOC2 SPECIFIED?
3315         JMP GPUT1       /YES, OK
3316         TAD ACC1
3317         DCA TEMP2       /NO, MAKE ARGS SAME
3318 GPUT1,  TAD ACC2        /STORE HIGH ADDR
3319         AND N7          /MASKED TO 3 BITS
3320         DCA I DPNT
3321         TAD TEMP2       /USE 1ST ARG
3322         DCA I DPNT
3323         TAD ACC1
3324         CMA
3325         TAD TEMP2
3326         DCA I DPNT      /DIFF= (TEMP2-ACC1-1)
3327         STA
3328         TAD TEMP        /ANOTHER ENTRY
3329         DCA TEMP
3330         JMP I GPUT
3331
3332
3333 XS240O, 0       /XS240 FORMAT PACKED ASCII
3334         JMS I RTR6I     /HIGH 6 BITS
3335         AND N77
3336         SPACE1          / PLUS A SPACE
3337         TADICAD         /THEN LOW 6 BITS,
3338         AND N77
3339         SPACE1          / PLUS A SPACE
3340         JMP I XS240O
3341
3342
3343 GETN,   0       /GET NEXT CHAR FROM COMM. BUFF.
3344         CDF 10
3345         TAD I COMOUT
3346         CDF 0
3347         DCA CHAR
3348         JMP I GETN
3349
3350
3351 PAGE
3352 \f/ROUTINE TO EVALUATE THE PARENTHESIZED EXPRESSION
3353 /OF DOUBLE PRECISION INTEGERS IN THE COMMAND BUFFER.
3354 /IT CALLS ITSELF RECURSIVELY TO EVALUATE EXPRESSIONS
3355 /IN "(...)", PLACING INFORMATION ON A PUSH-DOWN-LIST
3356 /OR DOING ARITHMETIC ACCORDING TO OPERATOR PRECIDENCE.
3357 /
3358 /OPERATIONS (IN ORDER OF PRECIDENCE):
3359 /  OR AND ADD SUB DIV MPY
3360 /  !   &   +   -   /   *
3361
3362 /ALL ARITHMETIC IS DONE IN DOUBLE-PRECISION SIGNED
3363 /INTEGER.  OVERFLOW ON MULTIPLY, ADD OR SUBTRACT IS
3364 /IGNORED BUT DIVIDE BY 0 WILL CAUSE AN ERROR.
3365
3366
3367 EVAL,   0
3368         DCA OPER2       /0 => D.P. TEMP (NEW NUMBER
3369         DCA OPER1       / OR LAST RESULT).
3370         DCA LASTOP      /0 => LASTOP
3371         JMS I TERMTI    /GET NEXT & TEST FOR TERM.
3372         JMP EVAL1       /TERM, CHECK IT
3373         JMP ENUM        / IT MUST BE A NUMBER
3374
3375 EVAL1,  JMS I SORTI     /CHECK LEGAL TERMS
3376           EVLST1-1      /"+","-" & "("
3377           EVOPS1-EVLST1
3378 ERCT,   ERROR           /SORRY ABOUT THAT
3379
3380 EVAL2,  JMS I LPARI     /IS CHAR "("?
3381 ERCU,   ERROR           /YES,ILLEGAL (NO OP FIRST)
3382 EVMIN,  TAD CNTRA       /SEQN # OF TERMINATOR
3383         DCA THISOP      /SET UP THISOP
3384         TAD CNTRA       /IS IT ")" OR "CR"?
3385         TAD M10
3386         SMA CLA
3387         DCA THISOP      /YES, 0 => THISOP
3388 EVAL3,  TAD THISOP      /CHECK PRIORITIES
3389         CIA
3390         TAD LASTOP      /IS LASTOP < THISOP?
3391         SPA CLA
3392         JMP EVPAR       /YES, CONTINUE SCAN
3393         TAD THISOP      / IS THISOP+LASTOP=0?
3394         TAD LASTOP
3395         SNA CLA
3396         JMP EVALX       /YES, DONE
3397         TAD LASTOP      /NO, DO THIS OP NOW
3398         TAD EVTAB
3399         DCA EVOP        /SET UP OPERATION
3400         TAD LASTOP      /IS THIS =0?
3401         SNA CLA
3402         JMP EVOP        /YES, DO OP
3403         POP             /NO, POP LAST OFF LIST
3404         DCA ACC2        / INTO D.P.AC.
3405         POP
3406         DCA ACC1
3407 EVOP,   HLT             /JMS TO OPERATION ROUTINE
3408         TAD ACC2
3409         DCA OPER2       /DUPLICATE D.P.AC. INTO
3410         TAD ACC1
3411         DCA OPER1       / D.P. TEMP
3412         POP
3413         DCA LASTOP      /POP UP ANOTHER OLD OPERATOR
3414         JMP EVAL3       /AND GO DO IT
3415
3416 EVPAR,  JMS I LPARI     /IS CHAR A "("?
3417         JMP EVLPAR      /YES, GO DO A SUB-EXPRESSION
3418         TAD LASTOP      /NO, PUSH DOWN OLD OP
3419         PUSH
3420         TAD OPER1       / & D.P. TEMP (LAST
3421         PUSH
3422         TAD OPER2       / RESULT OR NEW NUMBER).
3423         PUSH
3424         TAD THISOP      /UPDATE LASTOP
3425         DCA LASTOP
3426 EVNEXT, JMS I TERMTI    /GET NEXT & TEST FOR TERM.
3427         JMP EVLPAR      /TERM, MUST BE A "("
3428 ENUM,   JMS I SORTI     /CHECK FOR "C","B", ETC...
3429           EVLST2-1
3430           EVOPS2-EVLST2
3431         JMS ACCEPT      /GET A # OR BOMB OUT!
3432         STA
3433         TAD COMOUT      /BACK UP POINTER
3434         DCA COMOUT
3435 ENUMX,  TAD ACC1
3436         DCA OPER1       /LO ORDER PART
3437         TAD ACC2
3438         DCA OPER2       /HI ORDER PART
3439         JMP EVOPN       /GO CHECK TERMINATOR
3440 /
3441 EVDATE, CDF 10          /"D" -- USE DATE WORD
3442         TAD I (7666     /GET DATE WORD
3443         CDF 0
3444         JMP EVBLK+1
3445 EVREM,  TAD ACCX1       /"R" -- USE REMAINDER
3446         DCA ACC1
3447         TAD ACCX2       / AS NEXT "INPUT".
3448         JMP EVBLK+2
3449 EVTEMP, TAD TEMPV1      /"T" -- USE 'TEMP' STORAGE
3450         DCA ACC1
3451         TAD TEMPV2
3452         JMP EVBLK+2
3453 EVSR,   LAS SKP         /"S" -- USE SWITCHES
3454         TADICAD         /"C" -- USE CONTENTS
3455         JMP EVBLK+1
3456 EVFIL,  TAD FILLER      /"F" -- USE FILLER
3457         JMP EVBLK+1
3458 EVLOC,  TAD LOCL        /"L" -- USE LOCATION
3459         DCA ACC1
3460         TAD LOCH
3461         JMP EVBLK+2
3462 EVBLK,  TAD BLK         /"B" -- USE BLOCK
3463         DCA ACC1        /INTO LO ORDER PART
3464         DCA ACC2        /0 HIGH ORDER PART
3465         JMP ENUMX       /CHECK NEXT CHARACTER
3466
3467 EVLPAR, JMS I LPARI     /IS CHAR "("?
3468         SKP
3469 ERCV,   ERROR           /NO, DIE! (ILLEGAL OPERATOR)
3470 EVPAR2, TAD LASTOP      /PUSH DOWN LASTOP
3471         PUSH
3472         TAD EVAL        /PREPARE TO RE-CALL
3473         PUSH
3474         JMS EVAL        /RECURSIVE CALL
3475 ERCW,   ERROR           /TERM = CR, NOT ENOUGH PARENS
3476         POP
3477         DCA EVAL        /RESTORE RETURN ADDR
3478         POP
3479         DCA LASTOP      /RESTORE LASTOP
3480 EVOPN,  JMS I TERMTI    /GET NEXT & TEST FOR TERM.
3481         JMP EVAL2       /OK
3482         JMP EVPAR2-1    /GARBAGE, GIVE SAME ERROR
3483
3484 EVALX,  TAD CNTRA       /WAS CHAR CR OR ")"?
3485         TAD M10
3486         SNA CLA
3487         ISZ EVAL        / ")", RETURN TO CALL+2
3488         JMP I EVAL      / CR, RETURN TO CALL+1
3489
3490 LPARI,  LPAR
3491 TERMTI, TERMT
3492
3493 EVTAB,  JMS I .    /JMS THRU TABLE TO OPERATIONS
3494
3495         DIOR    /INCLUSIVE OR
3496         DAND    /AND
3497         DADD    /ADD
3498         DSUB    /SUBTRACT
3499         DDIV    /DIVIDE
3500         DMUL    /MULTIPLY
3501
3502
3503 PAGE
3504 \fPUSHX, 0       /PUSH AC ONTO LIST
3505         CDF 10
3506         DCA I PDLPT
3507         CDF 0
3508         ISZ PDLPT       /BUMP POINTER
3509         JMP I PUSHX
3510
3511 POPX,   0       /POP LIST INTO AC
3512         STA STL         /SET LINK SO IT WILL BE 0
3513         TAD PDLPT       /BACK UP POINTER
3514         DCA PDLPT
3515         CDF 10
3516         TAD I PDLPT
3517         CDF 0
3518         JMP I POPX
3519
3520
3521 LPAR,   0       /CHECK IF CHAR = "("
3522         TAD CHAR
3523         TAD (-"(
3524         SZA CLA
3525         ISZ LPAR        /IF IT IS NOT, TO CALL+2
3526         JMP I LPAR      /  ELSE TO CALL+1
3527
3528 /COMPARE CHAR AGAINST LIST OF TERMINATORS.  IF IT
3529 /IS ONE, RETURN TO CALL+1, ELSE TO CALL+2.
3530 TERMT,  0
3531         CLA CLL
3532         JMS I GETNI     /GET NEXT CHARACTER
3533         JMS I SSKIPI    /IGNORE SPACES
3534         TAD (TERMS-1    /SET UP POINTER
3535         DCA SPNT
3536         DCA CNTRA       /SET CNTRA TO 0
3537 TERMT1, CDF 10
3538         TAD I SPNT      /GET AN ITEM
3539         CDF 0
3540         ISZ CNTRA       /ADD 1 TO ITEM #
3541         SNA
3542         JMP TERMTE      /WAS 0, END
3543         CIA
3544         TAD CHAR        /SAME AS THIS?
3545         SNA CLA
3546         JMP I TERMT     /YES, TO CALL+1
3547         JMP TERMT1
3548 TERMTE, ISZ TERMT       /DIDN'T FIND IT, TO
3549         JMP I TERMT     / CALL+2
3550
3551 /DOUBLE-PRECISION ROUTINES
3552
3553 DADD,   0       /D.P. ADD
3554         CLL
3555         TAD OPER1
3556         TAD ACC1        /ADD LOW ORDER PARTS
3557         DCA ACC1
3558         RAL             /GET CARRY TO AC11
3559         TAD OPER2       /ADD HIGH ORDER PARTS
3560         TAD ACC2
3561         DCA ACC2        /STORE HIGH ORDER PART
3562         JMP I DADD
3563
3564 DSUB,   0       /D.P. SUBTRACT
3565         DCA DPSGN       /ZERO IT FOR SAFETY
3566         JMS MULNEG      /NEGATE OPERAND
3567         JMS DADD        / & ADD
3568         JMP I DSUB
3569
3570 DAND,   0       /D.P. LOGICAL AND
3571         TAD ACC2        /AND HIGH ORDER PARTS
3572         AND OPER2
3573         DCA ACC2
3574         TAD ACC1        /AND LOW ORDER PARTS
3575         AND OPER1
3576         DCA ACC1
3577         JMP I DAND      /RETURN
3578
3579 DIOR,   0       /D.P. LOGICAL INCLUSIVE OR
3580         TAD ACC2        /IOR HIGH ORDER PARTS
3581         CMA
3582         AND OPER2
3583         TAD ACC2
3584         DCA ACC2
3585         TAD ACC1        /IOR LOW ORDER PARTS
3586         CMA
3587         AND OPER1
3588         TAD ACC1
3589         DCA ACC1
3590         JMP I DIOR
3591
3592
3593 /SUBROUTINE TO GET SINGLE ARGS FROM THE COMMAND
3594 /BUFFER.  MUST BE IN 'BLOK.LOC' FORM.  ONLY ".",
3595 /SPACE AND CR ARE ALLOWED OTHER THAN DIGITS.
3596 ARG,    0
3597         STA
3598 ARG1,   DCA TEMP1       /SET 'BLOK' [INIT TO -1]
3599         JMS EXPRIN      /  GET AN ARG
3600         JMS I SORTI     /LOOK UP TERMINATOR
3601           ARGLST-1
3602           ARGOPS-ARGLST
3603 ERCQ,   ERROR           /ILLEGAL TERMINATOR
3604 /
3605 ARG2,   JMS I GETNI     /SKIP OVER "."
3606         TAD ACC1        /TERM = ".", SET 'BLOK'
3607         JMP ARG1
3608 /
3609 ARG3,   JMP I ARG       /TERM = " " OR CR
3610
3611
3612 /GET NEXT ARG FROM COMM. BUFF.  IF NEXT CHAR IS
3613 /  A "(", USE 'EVAL' TO GET IT, OTHERWISE USE
3614 /  'ACCEPT'.
3615 EXPRIN, 0
3616         JMS I SSKIPI    /IGNORE SPACES
3617         JMS LPAR        /IS CHAR A "("?
3618         JMP EXPRI1
3619         JMS ACCEPT      /NO, MUST BE A NUMBER
3620         JMP I EXPRIN
3621 /
3622 EXPRI1, JMS I EVALI     /YES, GO EVALUATE EXPRESSION
3623 ERC08,  ERROR           /CR = ILLEGAL TERMINATOR
3624         JMS CGTEST      /OK, SKIP OVER ")" & TEST FOR CR
3625           SKP
3626         STA             /NO, SET SWITCH
3627         DCA CRSWT       /YES, RESET IT
3628         JMP I EXPRIN    / & LEAVE...
3629
3630
3631 SCANER, 0       /EXECUTION SUBROUTINE FOR 'SCAN' COMMAND
3632         CLA
3633         TAD BLK         /SET UP DESIRED BLOCK
3634         DCA CBLK
3635         JMS GETIO       /DO NECESSARY I/O
3636           SKP CLA       /  READ ERROR!
3637         JMP I SCANER    /THIS BLOCK IS OK!
3638         TAD BLK
3639         JMS I OCTI      /OUTPUT BLOCK NUMBER
3640         JMS I TYPSI     / & TELL IT'S BAD
3641           MSBAD
3642         JMS I CRLFI     / TO ANOTHER LINE
3643         JMP I SCANER
3644
3645
3646 PAGE
3647 \f/SIGNED MULTIPLY AND DIVIDE ROUTINES
3648
3649 DMUL,   0
3650         JMS MDCOM       /MAKE DPAC POS, INITIALIZE
3651         SPA CLA         /MAKE SURE MULTIPLIER IS POSITIVE
3652         JMS MULNEG      / IT WAS NEG, MAKE POS & SET SIGN
3653 DMUL1,  TAD ACC2        /SHIFT RIGHT & OUT
3654         RAR
3655         DCA ACC2        /THRU HI OF LO
3656         TAD ACC1
3657         RAR
3658         DCA ACC1        /THRU LO OF LO INTO LINK
3659         ISZ DPNEG       /DONE YET?
3660         JMP DMUL2       /NO, CONTINUE
3661 DMUL4,  TAD DPSGN       /YES, CHECK SIGN OF RESULT
3662         RAR
3663         SZL CLA         /SKIP IF SIGN OK
3664         JMS DPNEG       /NOT OK, NEGATE
3665         JMP I DMUL
3666 /
3667 DMUL2,  SNL             /ADD IN THIS TIME?
3668         JMP DMUL3       /NO, BIT OUT WAS 0
3669         CLA CLL         /YES, BIT WAS 1
3670         TAD OPER1       /START WITH LOW
3671         TAD ACCX1
3672         DCA ACCX1
3673         CLA RAL         /GET CARRY
3674         TAD OPER2       /ADD HIGH PARTS
3675 DMUL3,  TAD ACCX2       /AND BEGIN SHIFTING OUT
3676         RAR
3677         DCA ACCX2
3678         TAD ACCX1
3679         RAR
3680         DCA ACCX1
3681         JMP DMUL1
3682
3683 DDIV,   0
3684         TAD DDIV        /MOVE RETURN ADDRESS
3685         DCA DMUL
3686         JMS MDCOM       /MAKE DPAC POS, INITIALIZE
3687         SMA CLA         /IS DIVISOR NEGATIVE?
3688         JMS MULNEG      / NO, NEGATE IT & SET SIGN
3689         SZL             /  IS IT 0? (CARRY OUT ON NEGATE)
3690 ERCX,   ERROR           /   YES, YOU LOST
3691         ISZ DPSGN       /CORRECT FOR SIGN DIF IN * & /
3692 DDIV1,  TAD ACCX1       /SUBTRACT LO OF LO
3693         TAD OPER1
3694         DCA ACCX1
3695         CLA RAL         /CARRY TO AC
3696         TAD ACCX2       /SUBTRACT HI OF LO
3697         TAD OPER2
3698         SPA             /TOO FAR?
3699         JMP DDIV2       /YES
3700         CLL CML         /NO, SET LINK
3701         DCA ACCX2
3702         JMP DDIV3
3703 DDIV2,  CLA
3704         TAD OPER1       /RESET LO ORDER PART
3705         CIA
3706         TAD ACCX1
3707         DCA ACCX1
3708         CLL             /RESET LINK
3709 DDIV3,  TAD ACC1        /BEGIN SHIFTING
3710         RAL
3711         DCA ACC1
3712         TAD ACC2
3713         RAL
3714         DCA ACC2
3715         ISZ DPNEG       /DONE YET?
3716         SKP
3717         JMP DMUL4       /YES, CHECK SIGN & RETURN
3718         TAD ACCX1       /NO, KEEP SHIFTING
3719         RAL
3720         DCA ACCX1
3721         TAD ACCX2
3722         RAL
3723         DCA ACCX2
3724         JMP DDIV1
3725
3726 MDCOM,  0     /COMMON ROUTINE FOR MULTIPLY & DIVIDE
3727         DCA DPSGN       /RESET SIGN
3728         TAD ACC2        /IS DPAC POS?
3729         SPA CLA
3730         JMS DPNEG       /NO, NEGATE
3731         DCA ACCX2       / 0 => DPACX
3732         DCA ACCX1
3733         TAD (-31        /INITIALIZE COUNTER
3734         DCA DPNEG
3735         CLL
3736         TAD OPER2       /RETURN W. HIGH OPERAND
3737         JMP I MDCOM
3738
3739 MULNEG, 0       /NEGATE THE MULTIPLIER/DIVISOR
3740         TAD OPER1       /DO LO-ORDER PART
3741         CLL CIA
3742         DCA OPER1
3743         TAD OPER2       /DO HI-ORDER PART
3744         CMA
3745         SZL             /CARRY?
3746         CLL IAC         /YES, ADD IT IN
3747         DCA OPER2
3748         ISZ DPSGN       /SIGN CHANGE MADE
3749         JMP I MULNEG
3750
3751 DPNEG,  0       /NEGATE THE D.P.AC.
3752         TAD ACC1        /DO LO-ORDER PART
3753         CLL CIA
3754         DCA ACC1
3755         TAD ACC2        /DO HI-ORDER PART
3756         CMA
3757         SZL             /CARRY?
3758         CLL IAC         /YES, ADD IT IN
3759         DCA ACC2
3760         ISZ DPSGN       /SIGN CHANGE MADE
3761         JMP I DPNEG
3762
3763
3764 BLKTST, 0       /TEST & SET BLK
3765         DCA DPNEG       /SAVE DATA
3766         TAD DPNEG       /GET IT BACK AGAIN
3767         ISZ DPNEG       /LEGAL BLOCK NUMBER?
3768         DCA BLK         / YES IF NOT 7777 (-1)
3769         CLA             / IF NOT, CLEAR JUNK
3770         JMP I BLKTST
3771
3772
3773 DICAD,  0       /"DCA I CAD" IN FIELD 1
3774         CDF 10
3775         DCA I CAD
3776         CDF 0
3777         JMP I DICAD
3778
3779 TICAD,  0       /"TAD I CAD" IN FIELD 1
3780         CDF 10
3781         TAD I CAD
3782         CDF 0
3783         JMP I TICAD
3784
3785
3786 PAGE
3787 \f/CHECK IF THE COMMAND BUFFER STARTS WITH A WORD.  IF
3788 /IT DOES, RETURN TO 'MAIN3' WITH THE SPECIAL CHAR-
3789 /ACTER AND JUST USE IT AS PART OF THE COMMAND STRING.
3790 /IF IT DOES NOT, TEST FOR EXPRESSIONS [IN "(...)",
3791 /TO ALLOW CHARACTERS IN THE EXPRESSIONS TO NOT BE
3792 /TAKEN AS COMMAND CHARACTERS] AND SINGLE & DOUBLE
3793 /QUOTES [THE FOLLOWING CHARACTER OR CHARACTERS ARE
3794 /LITERALS, NOT COMMANDS].  IF THE PARENS MATCH AND
3795 /THE QUOTES ARE FOLLOWED BY THE CORRECT NUMBER OF
3796 /CHARACTERS, THEN THE LAST CHARACTER WAS AN "ODT"
3797 /COMMAND TO BE EXECUTED SO RETURN TO CALL+1.  OTHER-
3798 /WISE RETURN TO 'MAIN3' AS ABOVE.
3799
3800 WCHEK,  0
3801         JMS I GWORDI    /COM BUF BEGIN WITH A WORD?
3802           JMP WCHEK2    /NO, TEST FOR PARENS, ETC.
3803 WCHEK1, STA
3804         TAD COMIR       /YES, BACK UP COMIR
3805         DCA COMIR
3806         TAD TEMP        /AND USE THE SPECIAL CHAR AS
3807         JMP I .+1       / PART OF THE COMMAND STRING
3808           RESPC+1
3809 /
3810 WCHEK2, STA
3811         TAD COMOUT      /SET UP ANOTHER A-XR
3812         DCA DPNT
3813         DCA CNT         /RESET (OR SET) PAREN COUNT
3814 WCHEK3, TADIDP          /GET A CHAR FROM COMM. BUFF.
3815         JMS I SORTI     / & GO TEST IT
3816           WCKLST-1
3817           WCKOPS-WCKLST
3818         JMP WCHEK3      /NONE, CONTINUE SCAN
3819 /
3820 WCHEK4, TAD CNT         /CR, DO PARENS MATCH?
3821         SZA CLA
3822         JMP WCHEK1      /NO, CONTINUE COMMAND INPUT
3823         JMP I WCHEK     /YES, INPUT IS DONE
3824 /
3825 WCHEK5, STA CLL RAL     /SET TO -2
3826         IAC             /AC = +1 OR -1
3827         TAD CNT         / UPDATE PAREN COUNT
3828         JMP WCHEK3-1    / & CONTINUE SCAN
3829 /
3830 WCHEK6, JMS WCHONE      / ' -- 2 CHARACTERS
3831         JMS WCHONE      / " -- 1 CHARACTER
3832         JMP WCHEK3      /OK, CONTINUE SCAN
3833
3834 WCHONE, 0
3835         TADIDP          /GET NEXT CHAR
3836         TAD M215        /IS IT A CR?
3837         SNA CLA
3838         JMP WCHEK1      /YES, DON'T EXECUTE SPECIAL
3839         JMP I WCHONE    /NO, OK
3840 \f/FPP INSTRUCTION DECODING SUPPORT SUBROUTINES
3841
3842 GETOP,  0       /GET OP-CODE (BITS 0-3) TO BITS 9-11
3843         TADICAD
3844         AND N7000
3845         CLL RTL
3846         RTL
3847         JMP I GETOP
3848
3849 GET678, 0       /GET BITS 678 TO BITS 9-11
3850         TADICAD
3851         CLL RTR
3852         RAR
3853         AND N7
3854         JMP I GET678
3855
3856 MULT3,  0       /MULTIPLY AC BY THREE
3857         DCA GETOP
3858         TAD GETOP
3859         CLL RAL
3860         TAD GETOP       /WORKS FOR POS OR NEG!
3861         JMP I MULT3
3862
3863 CONDIT, 0       /OUTPUT CONDITIONAL FPP INSTRUCTION
3864         TAD I CONDIT    /GET LEADING 1 OR 2 CHARS
3865         ISZ CONDIT
3866         JMS I TWOT      / & OUTPUT THEM
3867         JMS GET678      /GET CONDITION CODE
3868         JMS I SYMTYI    / AS INDEX TO TABLE
3869           FPCOND
3870           -1
3871         JMP I CONDIT
3872 SYMTYI, SYMTYP
3873
3874 FLDOUT, 0       /OUTPUT FIELD DIGIT & "*"
3875         TADICAD
3876         AND N7          /GET FIELD
3877         JMS I RTL6I     / TO BITS 3-5
3878         JMS I TWOCI     / & OUTPUT "F*"
3879           6052          / WHERE "F" IS DIGIT
3880         JMP I FLDOUT
3881
3882
3883
3884         DECIMAL         /SET RADIX TO DECIMAL
3885
3886 TEMPL=  .               /ARGUMENT BUFFER
3887                 /L(TEMPL)=180(10)
3888 F0END=  TEMPL+180
3889         DMPHAN-F0END    /(SHOW SPACE LEFT)
3890
3891         OCTAL
3892
3893 PAGE    /****** MUST BE NO LITERALS! ******
3894
3895 DMPHAN= 06600   /DUMP HANDLER AREA, 2 FIELD 0 PAGES
3896
3897 DEVHAN= 07200   /DEVICE HANDLER AREA, 2 FIELD 0 PGS
3898
3899
3900 IFNZRO  DMPHAN-F0END&4000  <BADERR,__CAN'T RUN>
3901
3902 /IF THE ABOVE ASSEMBLES, THE BUFFERS ARE OVER-
3903 /  RUNNING THE DUMP DEVICE HANDLER.
3904
3905
3906 *TEMPL  /ADD INITIALIZATION CODE WHICH IS OVERLAID
3907
3908 INIMSG, 0       /INITIALIZE ERROR MESSAGES ON SCRATCH BLKS
3909         CDF 10
3910         TAD I (7726     /BUT FIRST CHECK FOR "SCOPE MODE"
3911         CDF 0
3912         AND N200        / (BIT 4 OF 17726)
3913         SNA CLA
3914         JMP INIDAT      /  NOT SET, GO SET UP DATE
3915 INISCO, TAD I SPNT      /SET, CHANGE RUBOUT HANDLER TO
3916         SNA
3917         JMP INIDAT      / ERASE CHARACTERS FROM SCREEN
3918         DCA I DPNT      / AND FROM BUFFER (MUCH EASIER
3919         JMP INISCO      / THAN ON HARD COPY!)
3920 /
3921 INIDAT, CDF 10          /NOW INIT EXTENDED DATE
3922         TAD I (7666     /GET SYSTEM DATE WORD
3923         CDF 0
3924         AND N7          /PICK OFF THIS YEAR PART
3925         CIA
3926         DCA YRTEST      / AND SET TEST YEAR (NEG)
3927         TAD I M1        /NOW GET EXTENDED YEAR BITS
3928         AND (600        / FROM "B.I.P." WORD AND
3929         CLL RTR         /  MOVE TO BITS 7,8 (*8)
3930         RTR
3931         TAD (106        /ADD TO A STARTING BASE OF 70[10]
3932         CIA
3933         TAD YRTEST      /AND ADD THIS YEAR ALSO
3934         CIA
3935         DCA YRBASE      /= 70 + EXTEND*8 + THIS YEAR
3936         TAD I (7746     /GET JSW
3937         AND (6777       /CLEAR BIT 2 (CAN RESTART!)
3938         CLL RAR
3939         STL RAL         /SET BIT 11 (DON'T SAVE FIELD 1)
3940         DCA I (7746     /& PUT IT BACK
3941         JMS I (7607     /WRITE ERROR MESSAGES
3942           4610          / 6 PAGES, FIELD 1
3943           0             / FROM LOC 10000
3944           27            / NORMAL SAVE AREA!
3945           SKP CLA
3946         JMP I INIMSG    /OK, JUST EXIT
3947         TAD M200
3948         DCA XERR3       /FAILED, ASSUME WRITE LOCKED
3949         TAD (ERROR      / SO NO ERROR MESSAGES ON
3950         DCA ERC15       / ERROR OR "SHOW ERRORS"
3951         JMP I INIMSG
3952
3953
3954 PAGE    /LITERALS HERE ARE OK!
3955 \f/INITIALIZATION CODE--RESIDES IN BUFFER AREA AND IS WIPED
3956 /  OUT DURING EXECUTION.  HANDLES CHAINED AND NORMAL STARTS.
3957
3958 START,  CLA SKP         /NORMAL
3959         STA             /CHAINED (FROM CCL!)
3960         DCA TEMP
3961         CDF 10
3962         DCA I (CCBB     /ZAP CCB SWITCH
3963         CDF 0
3964         TAD N200
3965         DCA I (7745     /RESET START ADDRESS
3966         JMS INIMSG      /INIT SCOPE, DATE & ERROR MESSAGES
3967         JMS BATSET      /TEST & SET UP FOR BATCH
3968         ISZ TEMP        /CHAINED?
3969         JMP I (201      / NO, START IT UP!
3970         CDF 10
3971         TAD I M200      /YES, 1ST OUTPUT DEVICE?
3972         CDF 0
3973         AND (17         /(IGNORE LENGTH SPEC)
3974         SNA
3975         JMP STSWIT      / NO, LEAVE AS SYS
3976         DCA DEVNO       /YES, SET DEVICE NUMBER
3977         TAD DEVNO
3978         CALUSR          /NOW DO HANDLER FETCH BY
3979           1             / NUMBER (PAINTING?)
3980 STDEV,    DEVHAN+1      /--2 PAGES--
3981           JMP STERR     /ARGGGG! FAILED!!!
3982         TAD STDEV
3983         DCA DEVAD       /SET UP HANDLER ENTRY
3984         TAD M200
3985         DCA DPNT        /SET UP FIELD 1 POINTER
3986         TADIDP          /GET NAME OF FILE
3987         DCA NAM1
3988         TADIDP
3989         DCA NAM2
3990         TADIDP
3991         DCA NAM3
3992         TADIDP          /GET EXTENSION
3993         DCA NAM4
3994         TAD NAM1        /WAS THERE REALLY A NAME?
3995         SZA CLA
3996         STA             / YES, SET NAME SWITCH
3997         DCA TEMP        / NO, RESET
3998         CDF 10
3999         DCA I (XDNAM    /CLEAR DEVICE NAME WORDS
4000         DCA I (XDNAM+1
4001         TAD I DPNT      /GET NEXT WORD & TEST FOR ZERO
4002         SZA CLA
4003         JMP STSWIT      / SOMETHING NOT RIGHT!
4004         TAD I DPNT      /OK, ASSUME CCL CHAIN & SET
4005         DCA I (XDNAM    / UP DEVICE NAME
4006         TAD I DPNT
4007         DCA I (XDNAM+1
4008         TAD I (XDNAM    /EMPTY?
4009         SZA CLA
4010         JMP STSWIT
4011         TAD (0423       /YES, MUST BE DEFAULT NAME--
4012         DCA I (XDNAM    / "DSK"
4013         TAD (1300
4014         DCA I (XDNAM+1
4015 STSWIT, CDF 10
4016         TAD I (7643     /TEST SWITCHES
4017         AND N200        / "/E"?
4018         DCA ERMODE      / 0= LONG, NON-0= SHORT
4019         IAC
4020         AND I (7643     / "/L"? [LOAD]
4021         SNA CLA
4022         JMP STSWO       /NO, CHECK NEXT
4023         TAD NAM4        /YES, SET DEFAULT EXTENSION
4024         SNA
4025         TAD (1404       / TO ".LD"
4026         DCA NAM4
4027         IAC
4028         JMP STSWEX-2    / & GO SET MODE
4029 /
4030 STSWO,  TAD I (7644
4031         AND (1000       / "/O"? [OFFSET]
4032         SNA CLA
4033         JMP STSWS       /NO, GO CHECK LAST
4034         TAD I (7646     /YES, GET LOW 12 BITS OF
4035         CIA             / "=NNNN" AS OFFSET AND
4036         DCA OFFSET      / IT UP
4037         STA
4038         JMP STSWEX-1    / & GO SET MODE
4039 /
4040 STSWS,  TAD I (7644     / "/S"? [SAVE]
4041         AND (40
4042         SNA CLA
4043         JMP STSWEX      /NO, WAS NOT ANY THAT COUNT
4044         TAD NAM4        /YES, SET DEFAULT EXTENSION
4045         SNA
4046         TAD (2326       / TO ".SV"
4047         DCA NAM4
4048         IAC             / & SET MODE
4049         DCA MODSW       /-1=OFF,0=NOR,+1=SV,+2=LD
4050 STSWEX, CDF 0
4051         ISZ TEMP        /FILE NAME SPECIFIED?
4052         JMP I (201      / NO, JUST START
4053         DCA CRSWT       /YES, SET SWITCH TO CR,
4054 STTLS,  TLS             / START TTY     ***     BATCH OPER.
4055         JMS I CRLFI     / & DO CR/LF
4056         TAD NAM4        /ANY EXTENSION SPECIFIED?
4057         SNA CLA
4058         STA             / NO--ALLOW 3 TRIES: SV, LD, NULL
4059         DCA TEMP1       /  ELSE ALLOW ONLY 1 TRY
4060         TAD NAM4        /IF NO EXTENSION SET YET,
4061         SNA
4062         TAD (2326       / SET TO START DEFAULTS WITH SV
4063         DCA NAM4
4064         JMP XFICHN      /NOW GO DO FILE LOOKUP
4065 /
4066 STERR,  TLS             /START UP OUTPUT  ***   BATCH OPER.
4067         JMP ERCY        / & GIVE ERROR!
4068
4069
4070 PAGE
4071 \f/INITIALIZATION CODE FOR BATCH OPERATION
4072
4073 BATSET, 0
4074         TAD I M1        /TEST BIT 1 OF 07777 FOR "BIP"
4075         RAL             / (BATCH-IN-PROGRESS)
4076         SMA CLA
4077         JMP I BATSET    / NO, INTERACTIVE MODE
4078         TAD I M1        / YES, GET FIELD BITS OF BATCH
4079         AND (70         /  TO GENERATE A "CIF BAT"
4080         TAD (CIF        /   AND SET UP 3 CALLS:
4081         DCA CBATI       /       INPUT,
4082         TAD CBATI
4083         DCA CBATO       /       OUTPUT AND
4084         TAD CBATI
4085         DCA CBATE       /       ERROR.
4086 BATMOV, TAD I SCANX1    /GET NEXT STORAGE ADDRESS
4087         SNA
4088         JMP I BATSET    / 0 = ALL DONE!
4089         DCA DPNT        /SET UP POINTER
4090 BATLUP, TAD I SCANX1    /GET A PATCH WORD
4091         SNA
4092         JMP BATMOV      / 0 = GROUP END
4093 BATPAT, CDF 0           /CHANGED FOR "TYPEB"!!
4094         DCA I DPNT      /PATCH THE WORD
4095         CDF 0
4096         JMP BATLUP      /DO IT AGAIN!
4097
4098
4099 /"SCOPE MODE" PATCHES FOR RUBOUT HANDLER.  INITIAL-
4100 /  IZATION CODE FIRST CHECKS FOR SCOPE AND THEN FOR
4101 /  BATCH.  THUS, IF BOTH ARE SET, FIRST THINGS WILL BE
4102 /  SET UP FOR SCOPE AND THEN THEY WILL BE RESET FOR
4103 /  BATCH.  THIS SEQUENCE IS REQUIRED!
4104
4105 SCOPLS, RELOC   RUBO
4106         JMS BTEST       /BUFFER NOW EMPTY?
4107         JMP RENEXT      / YES, JUST IGNORE RUBOUT
4108         STA
4109         TAD COMIR       /NO, BACK UP POINTER
4110         DCA COMIR
4111         TAD COMIR       /SET UP POINTER FOR TESTING, ALSO
4112         DCA COMOUT
4113         JMS RUBO2       /OUTPUT BACKSPACE, SPACE, BACKSPACE
4114         JMS I GETNI     /GET RUBBED OUT CHAR AND TEST
4115         TAD CHAR
4116         TAD M240        / FOR A CONTROL CHAR
4117         SPA CLA
4118         JMS RUBO2       /YES, ERASE "^" ALSO!
4119         JMP RENEXT      /TRY FOR ANOTHER CHAR
4120
4121 RUBO2,  HLT     /MUST BE NON-ZERO!!!
4122         JMS I TYPEAI    /OUTPUT A BACKSPACE,
4123           "H-100        /(CTRL-H)
4124         SPACE1          / SPACE,
4125         JMS I TYPEAI    / BACKSPACE SEQUENCE TO
4126           "H-100        / CLEAR OFF SCREEN CHAR
4127         JMP I RUBO2
4128 TYPEAI, TYPEA
4129         0
4130
4131         RELOC
4132
4133
4134 BATLS,  /PATCHES--ADDRESS-1, CODE, 0 WITH EXTRA 0 FOR END.
4135
4136         RUBO-1          /==== INPUT PATCHES ====
4137         RELOC   RUBO
4138         DCA CHAR        /SAVE NEW CHAR INPUT
4139         TAD CHAR        /IS THIS A FORM-FEED?
4140         TAD RM214
4141         SNA
4142         JMP RKEY+1      / YES, JUST IGNORE IT!
4143         TAD R2          /NO, THEN IS IT A LINE-FEED?
4144         SNA CLA
4145         TAD RLAST       / YES, WAS LAST A CARRIAGE-RETURN?
4146         TAD M215
4147         SZA CLA
4148         TAD CHAR        /NO TO ONE OR OTHER, USE CHAR.
4149         DCA RLAST       / YES TO BOTH, SET TO 0!
4150         TAD RLAST       /OK, WAS IT A CR-LF PAIR?
4151         SNA CLA
4152         JMP RKEY+1      /  YES, JUST IGNORE LF!
4153         JMP REKEY+1     /  NO, GO USE THIS CHAR
4154
4155 BATINI, 5400            /IN THE BATCH FIELD
4156 RM214,  -214
4157 R2,     2
4158 RLAST,  215             /!!! CR OF ".R FUTIL" HAS AN LF !!
4159         0
4160
4161         RKEY+1-1
4162         RELOC           /TO PUT 'CBATI' ON THIS PAGE
4163 CBATI=  .+1             /REALLY ON "CIF BAT"
4164         RELOC   RKEY+1
4165         JMS I CTRLI     /CHECK FOR CONTROL KEYS
4166         CIF             /***    CIF BAT
4167         JMS I BATINI    /GET A BATCH CHARACTER
4168 ERC17,  ERROR           /!!! EOF ON INPUT !!!
4169         NOP             /FILLER FOR INTERACTIVE CTRL-Q
4170         NOP
4171         0
4172
4173         RKEY0-1
4174         RELOC   RKEY0
4175         JMP RKEY+1      /IGNORE RUBOUT UNDER BATCH
4176         NOP             / & RETURN TO CALL+1!
4177         0
4178
4179         BCTRLC-1
4180         RELOC   BCTRLC
4181         JMP I CTRLCI    /CTRL-C, ABORT JOB STREAM!
4182         0
4183
4184         RELOC           /==== OUTPUT PATCHES ====
4185         201-1
4186         NOP
4187         0
4188
4189         STTLS-1
4190         NOP             /ZAP 3 "TLS"S USED FOR STARTUP
4191         0
4192
4193         STERR-1
4194         NOP
4195         0
4196
4197         RELOC           /==== ERROR PATCH ====
4198
4199         XERR4-1
4200 CBATE=  .               /REALLY ON "CIF BAT"
4201         RELOC   XERR4
4202         CIF             /***    CIF BAT
4203         JMP I N7000     /ABORT TO BATCH FIELD!
4204         0
4205
4206         RELOC
4207
4208         BATPAT-1
4209         CDF 10          /*** NEXT CODE IN FIELD 1 ***
4210         0
4211
4212         TYPEB-1
4213         RELOC
4214 CBATO=  .+1             /REALLY ON "CIF BAT"
4215         IFDEF   TYPEB   </NO PASS1 ERROR!
4216         RELOC   TYPEB   /*** REALLY IN FIELD 1 ***
4217         >
4218         CDF 10          /***    SET UP RETURN D.F.
4219         CIF             /***    CIF BAT
4220         JMS I .+1       /OUTPUT A CHARACTER TO LOG
4221           7400          /BATOUT, IN THE BATCH FIELD
4222         CDF 0           /***    RESET D.F.
4223         0
4224
4225         RELOC
4226
4227         0
4228
4229
4230 PAGE
4231
4232 FIELD   1       /THE END OF FIELD 0!
4233 \f*10000         /PUT A POINTER HERE!
4234
4235         NXTIOT  /ADDR OF NEXT FREE SPACE IN TABLE
4236
4237
4238 /ERROR MESSAGES AND ADDRESS LIST.  THESE ITEMS RESIDE
4239 /  UNDER THE USR, REQUIRING THAT THE USR SWAP THEM
4240 /  WHEN IT IS USED AND THAT THE PROGRAM KICK OUT THE
4241 /  USR WHEN AN ERROR OCCURS IN LONG ERROR MESSAGE MODE
4242 /  OR WHEN A "SHOW ERRORS" COMMAND IS GIVEN.  IT IS
4243 /  TO THE ADVANTAGE OF DECTAPE (AND PROBABLY ALSO
4244 /  FLOPPY DISK) SYSTEMS TO USE SHORT ERROR MESSAGE
4245 /  MODE TO REDUCE USR SWAPPING IF DOING MANY "FILE"
4246 /  OR "SET DEVICE ...DDEV..." COMMANDS.
4247
4248 *10002  /MESSAGE ADDRESS AT ERROR CODE NUMBER +1 (AUTO-XR)
4249
4250 /LIST OF ADDRESSES OF ERROR MESSAGES
4251
4252         ERMSA
4253         ERMSB
4254         ERMSC
4255         ERMS14
4256         ERMSD
4257         ERMSE
4258         ERMSG
4259         ERMSH
4260         ERMSI
4261         ERMSK
4262         ERMSJ
4263         ERMSXO
4264         ERMSL
4265         ERMSZ
4266         ERMSO
4267         ERMS11
4268         ERMS04
4269         ERMSP
4270         ERMSQ
4271         ERMSR
4272         ERMS09
4273         ERMS08
4274         ERMS13
4275         ERMSS
4276         ERMST
4277         ERMSU
4278         ERMSV
4279         ERMSW
4280         ERMSX
4281         ERMSY
4282         ERMSM
4283         ERMS00
4284         ERMS01
4285         ERMS02
4286         ERMS03
4287         ERMS10
4288         ERMSF
4289         ERMSGC
4290         ERMSHD
4291         ERMS05
4292         ERMS07
4293         ERMS18
4294         ERMS19
4295         ERMS20
4296         ERMS15
4297         ERMS16
4298 EMSEND, ERMS17
4299         ERMS99
4300
4301
4302 /ERROR MESSAGES:
4303
4304 ERMSA,  TEXT &ILLEGAL SINGLE-WORD COMMAND&
4305
4306 ERMSB,  TEXT &ILLEGAL MULTI-WORD COMMAND&
4307
4308 ERMSC,  TEXT &TOO MANY ")"S&
4309
4310 ERMSD,  TEXT &ILLEGAL FORMAT WORD&
4311
4312 ERMSE,  TEXT &BAD FORMAT SYNTAX&
4313
4314 ERMSF,  TEXT &NO FILE FOR C.C.B./HEADER REQUEST&
4315
4316 ERMSGC, TEXT &BAD C.C.B (NOT A SAVE FILE)&
4317
4318 ERMSHD, TEXT &BAD HEADER (NOT A LOAD MODULE)&
4319
4320 ERMSG,  TEXT &ILLEGAL ITEM TO SHOW&
4321
4322 ERMSH,  TEXT &ILLEGAL SEARCH MODIFIER&
4323
4324 ERMSI,  TEXT &BAD SEARCH SYNTAX&
4325
4326 ERMSJ,  TEXT &ILLEGAL MODE&
4327
4328 ERMSK,  TEXT &SET OPTION FOLLOWED BY A CR, BAD SYNTAX&
4329
4330 ERMSXO, TEXT &NUMBER OR ILLEGAL SET OPTION&
4331
4332 ERMSL,  TEXT &NUMBER OR ILLEGAL OUTPUT OPTION&
4333
4334 ERMSM,  TEXT &ILLEGAL "." IN NAME (FILE OR DEVICE)&
4335
4336 ERMSO,  TEXT &ILLEGAL MODIFY FORMAT&
4337
4338 ERMSP,  TEXT &PROGRAM OR HARDWARE PROBLEM&
4339
4340 ERMSQ,  TEXT &BAD TERMINATOR IN SINGLE ARGUMENT&
4341
4342 ERMSR,  TEXT &TERMINATOR BEFORE LEGAL NUMBER INPUT&
4343
4344 ERMSS,  TEXT &BAD TERMINATOR IN MULTIPLE ARGUMENT&
4345
4346 ERMST,  TEXT &ILLEGAL CHARACTER IN EXPRESSION&
4347
4348 ERMSU,  TEXT &ILLEGAL USE OF "(" IN EXPRESSION&
4349
4350 ERMSV,  TEXT &ILLEGAL OPERATOR IN EXPRESSION&
4351
4352 ERMSW,  TEXT &TOO FEW ")"S IN EXPRESSION&
4353
4354 ERMSX,  TEXT &DIVISION BY 0 ATTEMPTED&
4355
4356 ERMSY,  TEXT &UNKNOWN HANDLER NAME&
4357
4358 ERMSZ,  TEXT &NUMBER OR ILLEGAL ERROR OPTION&
4359
4360 ERMS01, TEXT &NON-&
4361         *.-1
4362
4363 ERMS00, TEXT &FATAL READ ERROR&
4364
4365 ERMS03, TEXT &NON-&
4366         *.-1
4367
4368 ERMS02, TEXT &FATAL WRITE ERROR&
4369
4370 ERMS04, TEXT &ODD START LOC OR COUNT IN OS/8 MODIFY&
4371
4372 ERMS05, TEXT &BAD ADDRESS/OVERLAY (ODT COMMANDS)&
4373
4374 /ERMS06,
4375
4376 ERMS07, TEXT &BAD ADDRESS/OVERLAY (MODIFY)&
4377
4378 ERMS08, TEXT &ARGUMENT EXPRESSION NOT TERMINATED BY ")"&
4379
4380 ERMS09, TEXT &ILLEGAL DIGIT&
4381
4382 ERMS10, TEXT &DUMP HANDLER ERROR&
4383
4384 ERMS11, TEXT &NUMBER OR ILLEGAL DMODE OPTION&
4385
4386 /ERMS12,
4387
4388 ERMS13, TEXT &ILLEGAL USE OF ' OR "&
4389
4390 ERMS14, TEXT &MAPPED MODE--USE LIST, NOT DUMP&
4391
4392 ERMS15, TEXT &NO ERROR MESSAGES&
4393
4394 ERMS16, TEXT &INPUT ERROR ON MESSAGES&
4395
4396 ERMS17, TEXT &EOF ON BATCH INPUT&
4397
4398 ERMS18, TEXT &ENTER FAILED&
4399
4400 ERMS19, TEXT &CLOSE FAILED&
4401
4402 ERMS20, TEXT &DUMP FILE OVERRUN&
4403
4404 ERMS99, TEXT &DEBUG&
4405 \f*12000 /BEGIN ABOVE THE USR AREA
4406
4407 /GCCB & GHDR--ROUTINES TO READ IN THE FIRST BLOCK OF THE
4408 /  LAST FILE SPECIFIED BY THE LAST "FILE" COMMAND, ASSUM-
4409 /  ING THAT IT WAS A SAVE FILE OR LOAD MODULE, AND DO THE
4410 /  FEW CHECKS THAT ARE AVAILABLE TO TEST FOR A CCB (CORE-
4411 /  CONTROL-BLOCK) OR HEADER BLOCK BEFORE LETTING THE DATA
4412 /  BE USED FOR THE APPROPRIATE PURPOSE.
4413
4414 GCCB,   0       /GET CORE-CONTROL-BLOCK
4415         JMS CCBHDR      /DO COMMON TEST & READ-IN
4416         SMA CLA         /1ST WORD (-# SEGS) NEG?
4417         JMP GCCERR      / NO, CAN'T BE CCB
4418         TAD I (CCBB+3   /GET JOB STATUS WORD
4419         AND (200        /OVERLAY BIT SET (LINK)?
4420         SZA CLA         / 0 = NO
4421         TAD (CCBB+140-1 / 1 = YES, START ADDR-1
4422         CDF 0
4423         DCA I (OVLFLG   /NO = 0; YES = ADDR-1
4424         CDF 10
4425         TAD I (CCBB+1   /2ND WORD A "CDF CIF X0"?
4426         AND (7707
4427         CIA
4428         TAD GCCCDF
4429         SZA CLA
4430 GCCERR, JMS ERROR1      /LOOKS BAD, JUST EXIT NOW!
4431         ISZ GETSWX      /LOOKS OK, 1ST TIME SINCE READ?
4432         JMP GCCB2       /NO, DON'T CHANGE THINGS AGAIN
4433         TAD (CCBB+140+3 /YES, POINT TO LENGTH WORDS
4434 GCCB1,  DCA GHDR        / TO CHANGE PAGES TO BLOCKS
4435         TAD I GHDR      /GET A WORD - PAGES
4436         SNA
4437         JMP GCCB2       / 0 = DONE
4438         IAC             /ROUND DOWN IN 2 STEPS FOR PDP-8
4439         CLL RAR
4440         DCA I GHDR      /STORE A WORD - BLOCKS
4441         TAD GHDR        /UPDATE POINTER TO NEXT
4442         TAD (4
4443         JMP GCCB1
4444 /
4445 GCCB2,  DCA GETSWX      /BE SURE SWITCH STAYS CLEAR
4446         TAD I SEGNI     /GET -# SEGMENTS
4447 GCCCDF, CDF CIF 0
4448         JMP I GCCB      /OK, RETURN VALUE
4449
4450 GHDR,   0       /GET HEADER BLOCK (FORTRAN IV)
4451         TAD (3          /TO SET UP CCBB+6
4452         JMS CCBHDR      /DO COMMON TEST & READ-IN
4453         TAD (-2         /1ST WORD MUST BE EXACTLY 2
4454         SZA CLA
4455         JMP HDRERR      / NO, CAN'T BE A HEADER
4456         ISZ GETSWX      /1ST TIME THRU SINCE READ?
4457         JMP GHDR1       / NO, DON'T CHANGE ANYTHING
4458         DCA I (CCBB+47  /YES, BE SURE THESE WORDS
4459         DCA I (CCBB+50  / ARE 0 FOR USERS
4460         TAD I (CCBB+1   /GET START FIELD WORD
4461         SNA
4462         JMP HDRERR      / SHOULD BE 1 THRU 7
4463         CLL RTL         /LOOKS OK, MOVE FIELD TO BITS
4464         RAL             / 6-8 TO HELP "SHOW HEAD"
4465         DCA I (CCBB+1
4466         TAD I (CCBB+1   /ARE THESE ONLY BITS SET?
4467         AND (7707
4468         SZA CLA
4469         JMP HDRERR      / NO, SOMETHING MUST BE BAD
4470         TAD I (CCBB+3   /OK, TEST FIELD OF NEXT FREE
4471         SNA
4472         JMP HDRERR      / SHOULD BE 1 THRU 7
4473         AND (7770
4474         SZA CLA
4475 HDRERR, JMS ERROR1
4476 GHDR1,  DCA GETSWX      /MAKE SURE THIS IS 0
4477         CMA             /AC NON-ZERO FOR OK
4478         CDF CIF 0
4479         JMP I GHDR      /OK, BACK TO USER
4480
4481 CCBHDR, 0
4482         TAD (CCBB+3     /CCBB+6 FOR GHDR
4483         CDF 0
4484         DCA I (GETPNT   /SET UP POINTER FOR 'GET'
4485         TAD I (DEVAD    /GET ADDR OF DEVICE
4486         DCA DEVADX      / HANDLER & SAVE HERE
4487         TAD I (RBLK1    /GET START BLOCK NUMBER
4488         SNA
4489 ERCF,   JMS ERROR1      / NO FILE!!! GIVE ERROR
4490         CDF 10
4491         DCA GCCBLK      /OK, SET UP 1ST BLOCK
4492         TAD I SEGNI     /IS SOMETHING IN MEMORY?
4493         SZA
4494         JMP I CCBHDR    / YES, RETURN 1ST WORD
4495         CIF 0
4496         JMS I DEVADX    /NO, READ 1ST BLOCK OF FILE
4497           0110          /READ; 1 PAGE; FIELD 1
4498 SEGNI,    CCBB          /BUFFER IS HERE
4499 GCCBLK,   0             /BLOCK NUMBER
4500           JMP RDERX     /...BAD NEWS...
4501         STA
4502         DCA GETSWX      /OK, SET "JUST READ" SWITCH
4503         TAD I SEGNI     /AND GET 1ST WORD
4504         JMP I CCBHDR
4505 /
4506 RDERX,  CDF CIF 0       /RETURN TO FIELD 0
4507         JMP I (RERROR   / FOR READ ERROR
4508
4509 DEVADX, 0
4510 GETSWX, 0
4511
4512
4513 MSMOD,  TEXT "  MOD"
4514
4515 MSBAD,  TEXT " BAD BLOCK"
4516
4517
4518 PAGE
4519 \f/CONTINUATION OF OUTPUT COMMANDS AND ROUTINES FROM FIELD 0
4520
4521 /CONTINUATION OF 'SET' 'DDEV' HANDLER
4522
4523 XDDEV1, DCA DDEVAD      /SET UP HANDLER ADDRESS
4524         TAD I (GDEV2
4525         DCA DDEVNO      / AND DEVICE NUMBER
4526         CDF 10
4527         TAD DDEVNO      /LOOK AT DCW FOR SPECIFIED
4528         TAD (7760-1     / DEVICE TO SEE IF FILE
4529         DCA DDCWPT      / STRUCTURED.
4530         TAD I DDCWPT    /BIT 0 = 1 FOR FILES
4531         SMA CLA
4532         TAD (212        / NO, LINE-AT-A-TIME
4533         DCA DDEVS       / YES, BLOCK-AT-A-TIME
4534         TAD DMPADR      /OK, INITIALIZE OUTPUT POINTER
4535         DCA DMPPTR
4536         DCA XOSIZ       / AND ZERO BLOCK COUNTER
4537         DCA DNAM        / AND CLEAR ANY FILE NAME
4538         IAC
4539         DCA DMPBLK      / AND SET BLOCK NUMBER TO 1
4540         JMP XDDEV2      /LAST, GO SET UP NAME FOR OUTPUT
4541
4542
4543 /CONTINUATION OF EXECUTION OF 'OPEN' COMMAND
4544
4545 XOPEN1, TAD (NAM1-1     /SET UP POINTER TO FIELD 0 FILE
4546         DCA DPNT        / NAME (NOTE: XR IN FIELD 1!!!)
4547         TAD I DPNT      /MOVE THE FILE NAME UP HERE
4548         DCA DNAM
4549         TAD I DPNT
4550         DCA DNAM+1
4551         TAD I DPNT
4552         DCA DNAM+2
4553         TAD I DPNT      /GET THE EXTENSION PART
4554         ISZ I (TEMP1    / WAS ANYTHING REALLY SPECIFIED?
4555         JMP XOPEN2
4556         CLA
4557         TAD (0425       /  NO, DEFAULT TO ".DU"
4558 XOPEN2, DCA DNAM+3
4559         TAD XCLNAM      /SET UP POINTER TO NAME FOR USR
4560         DCA XOBLK
4561         CDF 10          /SET UP RETURN FIELD
4562         TAD I DDCWPT    /CLEAR ANY OPEN FILE ON
4563         AND (7770       / THIS DEVICE SO "OPEN"
4564         DCA I DDCWPT    / CAN BE DONE WHENEVER!
4565         CIF 0           /SET UP SUBROUTINE FIELD
4566         TAD DDEVNO      /GET DUMP DEVICE NUMBER
4567         JMS USEUSR      / AND GO GET USR & CALL IT.
4568           3             /ENTER
4569 XOBLK,    0     /NAME POINTER, BECOMES START BLK
4570 XOSIZ,    0     / BECOMES -# BLOCKS CAN USE
4571 ERC18,    JMS ERROR1    /THE ENTER FAILED!
4572         TAD XOBLK       /OK! SET UP FILE START BLOCK
4573         DCA DMPBLK
4574         TAD DMPADR      /INITIALIZE POINTER
4575         DCA DMPPTR
4576 XOCEX,  CDF CIF 0
4577         JMP MAIN1       /TRY NEXT COMMAND
4578
4579 DDEVAD, 7607    /INIT ADDRESS TO "SYS:" (SEE ABOVE)
4580 DDEVNO, 1       /INIT THIS TO "SYS:" ALSO.
4581 DDCWPT, 7760    / THIS ALSO
4582
4583 DNAM,   0       /DUMP FILE NAME, INIT TO NULL
4584         0
4585         0
4586         0       /(EXTENSION HERE)
4587
4588
4589 /CONTINUATION OF EXECUTION OF 'CLOSE' COMMAND
4590
4591 XCLOS1, TAD DNAM        /IS ANY FILE OPEN?
4592         SNA CLA
4593         JMP XOCEX       / NO, IGNORE COMMAND
4594         TAD XCTLZ       / YES, OUTPUT A CTRL-Z
4595         JMS DMPOUT      /  AND FILL TO END
4596 XCTLZ,    "Z-100
4597         TAD XOBLK       /OK, CALCULATE FILE SIZE
4598         CIA
4599         TAD DMPBLK      /= NEXT - START
4600         DCA XCLSIZ      /= FILE SIZE IN BLOCKS
4601         TAD DDEVNO      /GET DUMP DEVICE NUMBER
4602         CIF 0
4603         JMS USEUSR      /GET USR AND CALL IT
4604           4             /CLOSE
4605 XCLNAM,   DNAM          /POINTER TO FILE NAME
4606 XCLSIZ,   0             /SIZE OF NEW FILE
4607 ERC19,    JMS ERROR1    /OH NO! CLOSE FAILED!
4608         DCA DNAM        /OK, ZAP KNOWLEDGE OF FILE
4609         JMP XOCEX
4610
4611
4612 DMPOUT, 0       /DUMP FILE CHARACTER OUTPUT ROUTINE
4613         DCA DMPCHR      /SAVE THE CHARACTER
4614         TAD DMPCHR      /PUT IT INTO FILE BUFFER
4615         CDF 10          /(MUST BE SURE!)
4616 DMPNUL, DCA I DMPPTR    /INSERT AN 8 BIT CHAR
4617         ISZ DMPPTR
4618         TAD DMPPTR      /NOW AT END OF BUFFER?
4619         TAD (-DMPBUF-400
4620         SNA CLA
4621         JMP DMPIT       / YES, DUMP BUFFER NOW
4622         TAD DMPCHR      /NO, FILL FOLLOWING THIS CHAR?
4623         CIA
4624         TAD I DMPOUT    /(THE TEST CHAR @ CALL+1)
4625         SNA CLA
4626         JMP DMPNUL      / YES, FILL WITH NULLS!
4627         JMP I DMPOUT    /  NO, EXECUTE FILL CHAR
4628 /
4629 DMPIT,  CIF 0
4630         JMS I DDEVAD    /CALL DUMP FILE HANDLER
4631           4210          /WRITE, 2 PAGES, FIELD 1
4632 DMPADR,   DMPBUF
4633 DMPBLK,   1             /BLOCK NUMBER
4634 ERC10,    JMS ERROR1    /ERROR ON OUTPUT FILE!
4635         TAD DMPADR      /NOW RESET OUTPUT POINTER
4636         DCA DMPPTR
4637         ISZ DMPBLK      /INCREMENT BLOCK NUMBER
4638         ISZ XOSIZ       /ANY MORE SPACE LEFT?
4639         JMP I DMPOUT    / YES, EXIT NOW
4640         DCA DNAM        /  NO! ZAP DUMP FILE
4641 ERC20,  JMS ERROR1      /   AND DIE!
4642 DMPCHR, 0
4643 DMPPTR, 0       /CHARACTER OUTPUT POINTER
4644
4645
4646 PAGE
4647 \f/CONTINUATION OF ROUTINE TO OUTPUT A CHAR TO A DEVICE
4648
4649 TYPE1,  TAD I (DMODE    /TTY= NONE, PART&-DSWIT, ALL
4650         AND I (DSWIT    / SO TEST FOR PART&DSWIT
4651         SZA CLA
4652         JMP TYPE2       /NO OUTPUT TO TTY
4653         TAD I (RTL6     /GET CHARACTER TO OUTPUT
4654 TYPEB,  NOP             /***    CDF 10          /*** BATCH
4655         TSF             /***    CIF BAT         /*** CHANGES
4656         JMP .-1         /***    JMS I .+1       /*** LOG
4657         TLS             /***      7400          /*** OUTPUT
4658         CLA             /***    CDF 0
4659 TYPE2,  STL CLA RAR     /=4000 (SET AC BIT 0 FOR TEST)
4660         TAD I (DSWIT    /=4000 OR 4001 (DSWIT=1)
4661         AND I (DMODE    /FILE= PART&DSWIT OR ALL
4662         SNA CLA
4663         JMP TYPE3       / OUTPUT TO TTY ONLY
4664         TAD DDEVS       /FILE STRUCTURED OUTPUT?
4665         CDF 10
4666         SNA
4667         TAD I (DNAM     / YES, FILE OPEN?
4668         CDF 0
4669         SNA CLA
4670         JMP TYPE3       /  NO TO EITHER
4671         TAD I (RTL6     /OK, GET CHARACTER TO OUTPUT
4672         JMS DMPOUT      /OUTPUT IT & TEST FOR END
4673 DDEVS,    0             /TEST: 0=FILE, 212= NON-FILE
4674 TYPE3,  CDF CIF 0
4675         JMP TYPEX       /BACK AND OUT
4676
4677
4678 ERROR1, 0       /FIELD 1 ERROR ROUTINE HEAD
4679         CLA             /CLEAR POSSIBLE JUNK IN AC
4680         TAD ERROR1      /MOVE RETURN ADDR TO FIELD 0
4681         CDF CIF 0
4682         DCA I (XERROR
4683         JMP I (XERROR+1
4684
4685
4686 XDDEV2, CDF 0           /NAME IS OVER THERE
4687         TAD I (NAM1     /MOVE DEVICE NAME INTO STRING
4688         DCA XDDNAM      / IN THIS FIELD FOR "SHOW DDEV"
4689         TAD I (NAM2
4690         DCA XDDNAM+1
4691         CDF CIF 0
4692         JMP XSETN       /BACK TO 'SET'
4693
4694 MSDDEV, TEXT "@DDEV = SYS@"
4695 XDDNAM= .-3
4696
4697 MSDEV,  TEXT "@DEVICE = SYS@"
4698
4699 XDNAM=  .-3     /ADDR OF 1ST WORD OF DEVICE NAME
4700
4701 /CONTINUATION OF CODE FROM FIELD 0
4702
4703 XDEVM,  DCA XDNAM       /SET 4 DEVICE NAME CHARS IN
4704         TAD I (NAM2     / OUTPUT MESSAGE
4705         DCA XDNAM+1
4706         CDF 10
4707         DCA I (CCBB     /NO C.C.B. OR HEADER PRESENT
4708         CDF CIF 0
4709         STA
4710         DCA I (RBLK     /RESET BLOCK NUMBER
4711         JMP XSETN       /GO DO NEXT OPTION
4712
4713
4714 MSERR,  TEXT " ERROR CODES: FUTIL "
4715         *.-1
4716
4717 /VERSION NUMBER MESSAGE--THE FOLLOWING CODE INSERTS THE
4718 /  VERSION NUMBER AND PATCH LEVEL SET NEAR THE START OF
4719 /  THE SOURCE INTO THE VERSION MESSAGE.
4720
4721 MSVER,  TEXT "VERSION = ???"    /VERS = 2 DIGITS, PATCH = 1
4722         *.-2
4723 VERTEN= VERSION%12              /TENS DIGIT
4724 VERONE= -VERTEN^12+VERSION      /ONES DIGIT
4725         VERTEN^100+VERONE+6060  /INSERT TWO DIGITS
4726         PATCH^100               /INSERT PATCH + NULL TERM
4727
4728 /ALPHA MONTH NAMES PLUS DUMMIES FOR PDATE SUBROUTINE
4729
4730 MONTHS, TEXT " 00@JAN@FEB@MAR@APR@MAY@JUN@JUL"
4731         TEXT "AUG@SEP@OCT@NOV@DEC@ 13@ 14@ 15"
4732
4733
4734 PAGE
4735 \f/SYMBOLICS FOR PDP-8 INSTRUCTIONS:
4736 INSLST, TEXT  "AND TAD ISZ DCA JMS JMP IOT NOP "
4737         *.-1
4738
4739 / GROUP 1 MICRO-INSTS.:
4740 OP1LST, TEXT  "CLL CMA CML IAC BSW RAL RTL RAR RTR "
4741         *.-1
4742
4743
4744 / GROUP 2 MICRO-INST'S:
4745 OP2LST, TEXT  "SMA SZA SNL SKP SPA SNA SZL OSR HLT "
4746         *.-1
4747
4748 / EAE MICRO-INST'S:
4749 EAELST, TEXT  "MQA MQL SCL MUY DVI NMI SHL ASR LSR SCA "
4750         *.-1
4751         TEXT  "DAD DST SWBADPSZDPICDCM SAM "
4752         *.-1
4753
4754 CLANAM, 0314  /"CLA "
4755         0140
4756
4757 OPRMES, 1720  /"OPR "
4758         2240
4759 \f/ IOT INSTRUCTIONS:
4760
4761 IOTTAB, 6000
4762         TEXT "SKON"
4763         6001
4764         TEXT "ION@"
4765         6002
4766         TEXT "IOF@"
4767         6003
4768         TEXT "SRQ@"
4769         6004
4770         TEXT "GTF@"
4771         6005
4772         TEXT "RTF@"
4773         6006
4774         TEXT "SGT@"
4775         6007
4776         TEXT "CAF@"
4777         6010
4778         TEXT "RPE@"
4779         6011
4780         TEXT "RSF@"
4781         6012
4782         TEXT "RRB@"
4783         6014
4784         TEXT "RCF@"
4785         6016
4786         TEXT "RCC@"
4787         6020
4788         TEXT "PCE@"
4789         6021
4790         TEXT "PSF@"
4791         6022
4792         TEXT "PCF@"
4793         6024
4794         TEXT "PPC@"
4795         6026
4796         TEXT "PLS@"
4797         6030
4798         TEXT "KCF@"
4799         6031
4800         TEXT "KSF@"
4801         6032
4802         TEXT "KCC@"
4803         6034
4804         TEXT "KRS@"
4805         6035
4806         TEXT "KIE@"
4807         6036
4808         TEXT "KRB@"
4809         6040
4810         TEXT "TFL@"
4811         6041
4812         TEXT "TSF@"
4813         6042
4814         TEXT "TCF@"
4815         6044
4816         TEXT "TPC@"
4817         6045
4818         TEXT "TSK@"
4819         6046
4820         TEXT "TLS@"
4821         6100
4822         TEXT "DPI@"
4823         6101
4824         TEXT "SMP@"
4825         6102
4826         TEXT "SPL@"
4827         6103
4828         TEXT "EPI@"
4829         6104
4830         TEXT "CMP@"
4831         6105
4832         TEXT "S,CMP"
4833         6106
4834         TEXT "CEP@"
4835         6107
4836         TEXT "SPO@"
4837         6110
4838         TEXT "RCTV"
4839         6111
4840         TEXT "RCRL"
4841         6112
4842         TEXT "RCRH"
4843         6113
4844         TEXT "RCCV"
4845         6114
4846         TEXT "RCGB"
4847         6115
4848         TEXT "RCLC"
4849         6116
4850         TEXT "RCCB"
4851         6130
4852         TEXT "CLZE"
4853         6131
4854         TEXT "CLSK"
4855         6132
4856         TEXT "CLOE"
4857         6133
4858         TEXT "CLAB"
4859         6134
4860         TEXT "CLEN"
4861         6135
4862         TEXT "CLSA"
4863         6136
4864         TEXT "CLBA"
4865         6137
4866         TEXT "CLCA"
4867         6201
4868         TEXT "CDF 00"
4869         *.-1
4870         6211
4871         TEXT "CDF 10"
4872         *.-1
4873         6221
4874         TEXT "CDF 20"
4875         *.-1
4876         6231
4877         TEXT "CDF 30"
4878         *.-1
4879         6241
4880         TEXT "CDF 40"
4881         *.-1
4882         6251
4883         TEXT "CDF 50"
4884         *.-1
4885         6261
4886         TEXT "CDF 60"
4887         *.-1
4888         6271
4889         TEXT "CDF 70"
4890         *.-1
4891         6202
4892         TEXT "CIF 00"
4893         *.-1
4894         6212
4895         TEXT "CIF 10"
4896         *.-1
4897         6222
4898         TEXT "CIF 20"
4899         *.-1
4900         6232
4901         TEXT "CIF 30"
4902         *.-1
4903         6242
4904         TEXT "CIF 40"
4905         *.-1
4906         6252
4907         TEXT "CIF 50"
4908         *.-1
4909         6262
4910         TEXT "CIF 60"
4911         *.-1
4912         6272
4913         TEXT "CIF 70"
4914         *.-1
4915         6203
4916         TEXT "CDIF00"
4917         *.-1
4918         6213
4919         TEXT "CDIF10"
4920         *.-1
4921         6223
4922         TEXT "CDIF20"
4923         *.-1
4924         6233
4925         TEXT "CDIF30"
4926         *.-1
4927         6243
4928         TEXT "CDIF40"
4929         *.-1
4930         6253
4931         TEXT "CDIF50"
4932         *.-1
4933         6263
4934         TEXT "CDIF60"
4935         *.-1
4936         6273
4937         TEXT "CDIF70"
4938         *.-1
4939         6204
4940         TEXT "CINT"
4941         6214
4942         TEXT "RDF@"
4943         6224
4944         TEXT "RIF@"
4945         6234
4946         TEXT "RIB@"
4947         6244
4948         TEXT "RMF@"
4949         6254
4950         TEXT "SINT"
4951         6264
4952         TEXT "CUF@"
4953         6274
4954         TEXT "SUF@"
4955         6550
4956         TEXT "FFST"
4957         6551
4958         TEXT "FPINT"
4959         6552
4960         TEXT "FPICL"
4961         6553
4962         TEXT "FPCOM"
4963         6554
4964         TEXT "FPHLT"
4965         6555
4966         TEXT "FPST"
4967         6556
4968         TEXT "FPRST"
4969         6557
4970         TEXT "FPIST"
4971         6561
4972         TEXT "FMODE"
4973         6563
4974         TEXT "FMRB"
4975         6564
4976         TEXT "FMRP"
4977         6565
4978         TEXT "FMDO"
4979         6567
4980         TEXT "FPEP"
4981
4982
4983 NXTIOT, ZBLOCK 200      /LEAVE ROOM FOR EXPANSION
4984
4985         0               /TABLE TERMINATOR
4986
4987
4988 /CODES MAY BE ADDED TO THE TABLE IN THE SPACE LEFT BY THE
4989 /  "ZBLOCK 200".  SINCE EACH ENTRY REQUIRES 4 WORDS (THE
4990 /  ACTUAL CODE IN THE FIRST WORD AND UP TO 6 PACKED ASCII
4991 /  CHARACTERS IN THE NEXT THREE WORDS, PADDED WITH TRAIL-
4992 /  ING 0'S), THERE IS ROOM FOR 40 OCTAL (32 DECIMAL) IOTS
4993 /  AND THEIR NAMES.  THESE CAN BE PATCHED IN DIRECTLY
4994 /  USING THE PROGRAM ITSELF.  **** NOTE THAT THE CONTENTS
4995 /  OF LOCATION 10000 POINT TO THE FIRST FREE ENTRY. ****
4996 \f/SYMBOLICS FOR FPP-12/8A INSTRUCTIONS
4997
4998 MSBASE, TEXT "  B+"
4999
5000 MSINDI, TEXT "% B+"
5001
5002 MSJNX,  TEXT "JNX  "
5003
5004 /THE FOLLOWING STRINGS ARE PADDED WITH "@"S IN PROPER
5005 /  PLACES TO FORCE WORD ALIGNMENT AS NEEDED.
5006
5007         TEXT "LEA@"     /+1 WORD 0000
5008 FPPINS, TEXT "FLDA@@FADD@@FSUB@@FDIV"
5009         TEXT "FMUL@@FADDM@FSTA@@FMULM"
5010
5011         TEXT "UNUSEDSTARTE"
5012         *.-1
5013 FPOP00, TEXT "FNOP@@FEXIT@FPAUSEFCLA@@FNEG"
5014         TEXT "FNORM@STARTFSTARTDJAC@@"
5015
5016 FPXR1S, TEXT "ALN ATX XTA "
5017
5018 FPXR2S, TEXT "ADDX *,@LDX *,@"
5019
5020 FOP134, TEXT "TRAP4 TRAP3 SETX  SETB  JSA  @JSR  "
5021
5022 FPCOND, TEXT "EQGELEA@NELTGTAL"
5023
5024
5025 /CONTROL TABLES FOR FPP INSTRUCTION DECODING
5026
5027 FPPMO0, 7       /MAJOR SUB-OP-CODE OF SPECIALS
5028         6
5029         5
5030         4
5031         3
5032         2
5033         1
5034         0       /END & FALL-OUT POINT
5035
5036 FPPMOJ, SPCOP7
5037         SPCOP6
5038         SPCOP5
5039         SPCOP4
5040         SPCOP3
5041         SPCOP2
5042         SPCOP1
5043
5044 FPPOP0, 170     /MINOR SUB-OP-CODE OF SUB-OP-CODE
5045         160     / 0 SPECIALS
5046         150
5047         140
5048         130
5049         120
5050         110
5051         100
5052         70
5053         60
5054         50
5055         40
5056         30
5057         20
5058         10
5059         00
5060
5061 FPPOPJ, SPNUSE  /ALL UNUSED POSSIBILITIES
5062         SPNUSE
5063         SPNUSE
5064         SPNUSE
5065         SPNUSE
5066         SPNUSE
5067         SPOP11
5068         SPOP10
5069         SPNUSE
5070         SPNUSE
5071         SPOP05
5072         SPOP04
5073         SPO123
5074         SPO123
5075         SPO123
5076 \f/MESSAGES:
5077
5078 MS01,   TEXT " =  "
5079
5080 MS07,   0023  /"SMASK = "
5081 MS02,   TEXT    "MASK = "
5082
5083 MS03,   TEXT "ABS. LOC = "
5084
5085 MS04,   TEXT "UPPER = "
5086
5087 MS05,   TEXT "LOWER = "
5088
5089 MS06,   TEXT "FORMAT = "
5090
5091 MS08,   TEXT "DIRECTORY"
5092
5093 MS09,   TEXT "OFFSET = "
5094
5095 MS10,   TEXT "MODE = "
5096
5097 MS11,   TEXT "CCB:"
5098
5099 MS12,   TEXT "ODT  LOC = "
5100
5101 MS13,   TEXT ":   "
5102
5103 MS14,   TEXT "  CORE SEGS:   "
5104
5105 MS15,   TEXT "LOOKUP FAILED"
5106
5107 MS16,   TEXT "FPP"
5108
5109 MS17,   TEXT " AT "
5110
5111 MS18,   TEXT "  SA = "
5112
5113 MS19,   TEXT ",  JSW = "
5114
5115 MS20,   TEXT "REL. LOC = "
5116
5117 MS21,   TEXT "PACKED"
5118
5119 MS22,   TEXT "ASCII"
5120
5121 MS23,   TEXT "OS/8"
5122
5123 MS24,   2516  /"UNSIGNED"
5124
5125 MS25,   TEXT "SIGNED"
5126
5127 MS26,   TEXT "OCTAL"
5128
5129 MS27,   TEXT "OFFSET"
5130
5131 MS28,   TEXT "SAVE"
5132
5133 MS29,   TEXT "NORMAL"
5134
5135 MS30,   TEXT "OUTPUT = "
5136
5137 MS31,   TEXT "PDP"
5138
5139 MS32,   TEXT "BLOCK = "
5140
5141 MS33,   TEXT ")  "
5142
5143 MS34,   TEXT "LOAD"
5144
5145 MS35,   TEXT "BCD"
5146
5147 MS36,   TEXT "BYTE"
5148
5149 MS37,   TEXT "FILLER = "
5150
5151 MS38,   TEXT "HEADER:"
5152
5153 MS39,   TEXT ", NEXT WORD = "
5154
5155 MS40,   TEXT ", LOAD V "
5156
5157 MS41,   TEXT ", E.P. REQ'D"
5158
5159 MS42,   TEXT "  OVLYS START BLOCK LENGTH"
5160
5161 MS43,   TEXT "XS240"
5162 \f/MAIN LOOP CHARACTER LIST
5163 CCHARL, "#
5164         "$
5165         "%
5166         "&
5167         ":
5168         "<
5169         "=
5170         ">
5171         "?
5172         "@
5173         "[
5174         "\
5175         "]
5176         "/
5177         "!
5178         "+
5179         "-
5180         ";
5181         "^
5182         "_
5183 /'TYPE' COMMAND LIST
5184 TYPEL,  211     /TAB
5185         233     /ALT MODES
5186         375
5187         376
5188 /'XMODIF' CHECK LIST
5189 TYPEM,  215     /CR
5190         212     /LF
5191         0
5192
5193 /ADDRESSES FOR 'OMODES'
5194 OTABLE, BPRT    /#
5195         OSTYPE  /$
5196         BYTEO   /%
5197         XS240O  /&
5198         SGNDP   /:
5199         OPRT    /<
5200         DPRT    /=
5201         PDPOUT  />
5202         DIROUT  /?
5203         PDATE   /@
5204         ASCII   /[
5205         FPPOUT  /\
5206         PACOUT  /]
5207
5208 /MAIN LOOP JUMP LIST - RESPOND TO SPECIAL CHAR
5209 COPSL,  OMODES
5210         OMODES
5211         OMODES
5212         OMODES
5213         OMODES
5214         OMODES
5215         OMODES  /SEE ABOVE LIST
5216         OMODES
5217         OMODES
5218         OMODES
5219         OMODES
5220         OMODES
5221         OMODES
5222         SLASH
5223         EXCL
5224         PLUS
5225         MINUS
5226         SEMIC
5227         UPARR
5228         BACKAR
5229         RESPC
5230         ALTMOD
5231         ALTMOD
5232         ALTMOD
5233         CRCR
5234         LFLF
5235
5236 /'TYPE' JUMP LIST
5237 TYPEOP, TYPTAB
5238         TYPALT
5239         TYPALT
5240         TYPALT
5241         TYPCR
5242         TYPCR+1
5243
5244 /COMMAND WORD LIST FOR COMMANDS NOT FOLLOWED BY CR
5245 CWORDL, TEXT "EVE@DUD@LIL@FIF@OPSCSTSMWOW@MOM@SHSES@WRIFEXCOC@"
5246
5247 /MAIN LOOP JUMP LIST - EXECUTE A COMMAND
5248 WOPSL,  XVAL
5249         XVAL
5250         XDUMP
5251         XDUMP
5252         XLIST0
5253         XLIST0
5254         XFILE
5255         XFILE
5256         XOPEN
5257         XSCAN
5258         XSTRIN
5259         XSMASK
5260         XWORD
5261         XWORD
5262         XMODIF
5263         XMODIF
5264         XSHOW
5265         XSET
5266         XSET
5267         XWRARG
5268         XIF
5269         XEXIT
5270         MAIN1   /COMMENT
5271         MAIN1
5272
5273 /LISTS FOR COMMANDS FOLLOWED BY A CR.
5274 CWORL2, TEXT "REWRENEXCLCOC@"
5275
5276 WOPSLL, XREWIN  /REWIND
5277         XWRITE  /WRITE
5278         MAIN1   /END
5279         XEXIT   /EXIT
5280         XCLOSE  /CLOSE
5281         MAIN1   /COMMENT
5282         MAIN1
5283 \f/'XFORM' LISTS  ----ORDER IS CRITICAL----
5284 FORML,  TEXT "PAP@ASA@OSOSXSX@UNU@SIS@OCO@BCB@BYBYPDPDFPF@DID@"
5285
5286 FOPSL,  XFCHR   /PACKED (ASCII)
5287         XFCHR
5288         XFCHR   /ASCII
5289         XFCHR
5290         XFCHR   /OS/8 (ASCII, PACKED)
5291         XFCHR
5292         XFCHR   /XS240 (ASCII, PACKED)
5293         XFCHR
5294         XFNUM   /UNSIGNED (DECIMAL)
5295         XFNUM
5296         XFNUM   /SIGNED (DECIMAL)
5297         XFNUM
5298         XFNUM   /OCTAL
5299         XFNUM
5300         XFNUM   /BCD
5301         XFNUM
5302         XFNUM   /BYTE (OCTAL)
5303         XFNUM
5304         XFSYM   /PDP (SYMBOLIC)
5305         XFSYM
5306         XFSYM   /FPP (SYMBOLIC)
5307         XFSYM
5308         XFSYM   /DIRECTORY
5309         XFSYM
5310
5311 /  ROUTINE ADDRESS LIST
5312
5313 FTABLE, PACOUT
5314         ASCII
5315         OSTYPE
5316         XS240O
5317         DPRT
5318         SGNDP
5319         OPRT
5320         BPRT
5321         BYTEO
5322         PDPDMP
5323         FPPDMP
5324         DIRDMP
5325
5326 /'XSHFMT' DESCRIPTOR ADDRESS LIST
5327 FMTLS,  MS21    /PACKED ASCII
5328         MS22    /ASCII
5329         MS23    /OS/8 ASCII
5330         MS43    /XS240 ASCII
5331         MS24    /UNSIGNED DECIMAL
5332         MS25    /SIGNED DECIMAL
5333         MS26    /OCTAL
5334         MS35    /BCD
5335         MS36    /BYTE
5336         MS31    /PDP SYMBOLIC
5337         MS16    /FPP SYMBOLIC
5338         MS08    /DIRECTORY
5339
5340
5341 /'XMODIF' COMMAND LIST
5342 MODIFL, TEXT "PAP@ASA@OSXSNUN@"
5343
5344 /'XMODIF' JUMP LIST
5345 MODIFO, XPAC0   /PACKED
5346         XPAC0
5347         XASC1   /ASCII
5348         XASC1
5349         XOPS1   /OS/8
5350         XXS20   /XS240
5351         XNUM2   /NUMERIC
5352         XNUM2
5353
5354 MODADS, XMOD0   /MODIFL TEST LIST
5355         XMOD0
5356         XMOD0
5357         XMOD0
5358         XMOD0
5359         XMOD0
5360         XMOD0
5361         XMOD0
5362         XMOD0
5363
5364 MODDLS, TEXT "PAASOSXSNUNUNUNUNUNUNUNU" /DEFAULT LIST
5365
5366 /'XMODIF' CHARACTER JUMP LIST
5367 MCHARO, XMODCR  /CR, END
5368         RENEXT  /LF, IGNORE
5369
5370 /'XIF' CHARACTER JUMP LIST
5371 IFSKPO, XIFCR   /CR, END OF LINE
5372         RENEXT  /LF, IGNORE
5373
5374 /XNUM JUMP LIST
5375 NUMOPS, XNUM1   /,
5376         ERCQ    /:
5377         ERCQ    /.
5378         XNUM1+1 /SPACE
5379         XNUM3   /CR
5380 \f/'XSHOW' COMMAND LIST
5381 SHOWL,  TEXT "BLB@ODCCC@HEH@ABA@RER@SMVE"
5382         *.-1
5383 /'XSET' COMMAND LIST
5384 SETLST, TEXT "DDFOF@OUO@ERE@OFUPLOTEDEDMMOFIMAM@
5385
5386 /'XSHOW' JUMP LIST
5387 SHOWOP, XSHBLK  /BLOCK
5388         XSHBLK
5389         XSHODL  /ODT LOC
5390         XSHCCB  /CCB (CORE CONTROL BLOCK)
5391         XSHCCB
5392         XSHHDR  /HEADER (F4 LOAD MODULE)
5393         XSHHDR
5394         XSHABS  /ABS. LOC
5395         XSHABS
5396         XSHREL  /REL. LOC
5397         XSHREL
5398         XSHSMS  /SMASK
5399         XSHVER  /VERSION
5400         XSHDDEV /DDEV
5401         XSHFMT  /FORMAT
5402         XSHFMT
5403         XSHOUT  /OUTPUT
5404         XSHOUT
5405         XSHERR  /ERRORS
5406         XSHERR
5407         XSHOFF  /OFFSET
5408         XSHUPP  /UPPER
5409         XSHLOW  /LOWER
5410         ERCG    /TEMP--NOT ALLOWED FOR SHOW
5411         XSHDEV  /DEVICE
5412         ERCG    /DMODE--NOT ALLOWED FOR SHOW
5413         XSHMOD  /MODE
5414         XSHFIL  /FILLER
5415         XSHMSK  /MASK
5416         XSHMSK
5417
5418 /'XSET' JUMP LIST
5419 SETJMP, XDDEV   /DDEV (DUMP DEVICE)
5420         XFORM   /FORMAT
5421         XFORM
5422         XOUTS   /OUTPUT
5423         XOUTS
5424         XEMODE  /ERROR (MODE)
5425         XEMODE
5426         XOFFS   /OFFSET
5427         XUPP    /UPPER
5428         XLOW    /LOWER
5429         XTEMP   /TEMP
5430         XDEV    /DEVICE
5431         XDMODE  /DMODE (DUMP MODE)
5432         XMODE   /MODE
5433         XFILL   /FILLER
5434         XMASK   /MASK
5435         XMASK
5436
5437 /'XEMODE' COMMAND LIST
5438 XELST,  TEXT "SHS@LOL@"
5439
5440 /'XEMODE' BRANCH LIST
5441 XEOPS,  XEMOD1          /SHORT
5442         XEMOD1
5443         XEMOD1+1        /LONG
5444         XEMOD1+1
5445
5446 /'XOUTS' LISTS
5447 XOLST,  TEXT "FPF@PDP@OCO@"
5448
5449 XOOPS,  XOUTS1-1        /FPP SYMBOLIC
5450         XOUTS1-1
5451         XOUTS1          /PDP SYMBOLIC
5452         XOUTS1
5453         XOUTS1+1        /OCTAL
5454         XOUTS1+1
5455
5456 /'XMODE' COMMAND LIST
5457 MODLST, TEXT "OFO@SAS@LOL@NON@"
5458
5459 /'XMODE' JUMP LIST
5460 MODOPS, XMODS-1 /OFFSET
5461         XMODS-1
5462         XMODS+1 /SAVE FILE
5463         XMODS+1
5464         XMODS   /LOAD MODULE
5465         XMODS
5466         XMODS+2 /NORMAL
5467         XMODS+2
5468
5469 /'XDMODE' LISTS
5470 XDMLST, TEXT "ALPANO"
5471
5472 XDMOPS, XDMODS-1        /ALL
5473         XDMODS          /PART
5474         XDMODS+1        /NONE
5475
5476
5477 /LIST OF DESCRIPTOR ADDRESSES FOR "SHOW MODE"
5478
5479         MS27    /-1 = "OFFSET"
5480 MODELS, MS29    / 0 = "NORMAL"
5481         MS28    /+1 = "SAVE"
5482         MS34    /+2 = "LOAD"
5483
5484
5485 /LIST OF DESCRIPTOR ADDRESSES FOR "SHOW OUTPUT"
5486
5487         MS16    /-1 = "FPP (SYMBOLIC)"
5488 OUTLS,  MS26    / 0 = "OCTAL"
5489         MS31    /+1 = "PDP (SYMBOLIC)"
5490
5491
5492 /'XWORD' COMMAND LIST
5493 XWORCL, TEXT "UNU@"
5494         *.-1
5495 /'XSTRIN' COMMAND LIST
5496 STRLST, TEXT "FRF@TOT@ABA@MAM@ME"
5497
5498
5499 /'XWORD' JUMP LIST
5500 XWOROP, XWOR2   /UNEQUAL
5501         XWOR2
5502         XWSFRM  /FROM
5503         XWSFRM
5504         XWSTO   /TO
5505         XWSTO
5506         XWSABS  /ABSOLUTE
5507         XWSABS
5508         ERCH    /MASKED--NO!
5509         XWOR7   /MEMREF
5510         XWOR7
5511
5512 /'XSTRIN' JUMP LIST
5513 STROPS, XWSFRM  /FROM
5514         XWSFRM
5515         XWSTO   /TO
5516         XWSTO
5517         XWSABS  /ABSOLUTE
5518         XWSABS
5519         XSTR0   /MASKED
5520         XSTR0
5521         ERCH    /MEMREF--NO!
5522 \f/LIST OF TERMINATORS, IN ORDER, FOR 'EVAL'
5523 TERMS,  "!  /1
5524         "&  /2
5525         "+  /3
5526         "-  /4
5527         "/  /5
5528         "*  /6
5529         "(  /7
5530         ")  /10
5531         215     /CR: 11
5532         0
5533
5534 /'GWORD' & 'ACCEPT' COMMAND LISTS
5535 GWLST1, "9
5536         "8
5537         "7
5538         "6
5539         "5
5540         "4
5541         "3
5542         "2
5543         "1
5544         "0
5545         204     /^D
5546         213     /^K
5547         ""
5548         "'
5549         "(
5550 GWLST2, 240     /SPACE
5551         215     /CR
5552         0
5553
5554 /'GWORD' JUMP LISTS
5555 GWOPS1, GWD4    / 9 - A NUMBER
5556         GWD4    / 8 - A NUMBER
5557         GWD4    / 7 - A NUMBER
5558         GWD4    / 6 - A NUMBER
5559         GWD4    / 5 - A NUMBER
5560         GWD4    / 4 - A NUMBER
5561         GWD4    / 3 - A NUMBER
5562         GWD4    / 2 - A NUMBER
5563         GWD4    / 1 - A NUMBER
5564         GWD4    / 0 - A NUMBER
5565         GWD4    /^D - A NUMBER
5566         GWD4    /^K - A NUMBER
5567         GWD4    / " - A NUMBER
5568         GWD4    / ' - A NUMBER
5569         GWD4    / ( - A NUMBER
5570 GWOPS2, GWD2    /SPACE - TERMINATOR
5571         GWD3    /  CR  -     "
5572
5573 /'ACCEPT' JUMP LIST
5574 ACOPS,  ACCNUM  / 9 - A DIGIT
5575         ACCNUM  / 8 - A DIGIT
5576         ACCNUM  / 7 - A DIGIT
5577         ACCNUM  / 6 - A DIGIT
5578         ACCNUM  / 5 - A DIGIT
5579         ACCNUM  / 4 - A DIGIT
5580         ACCNUM  / 3 - A DIGIT
5581         ACCNUM  / 2 - A DIGIT
5582         ACCNUM  / 1 - A DIGIT
5583         ACCNUM  / 0 - A DIGIT
5584         CTRLD   / ^D SWITCH
5585         CTRLK   / ^K SWITCH
5586         DQUOTE  / " - SINGLE ASCII
5587         SQUOTE  / ' - PACKED ASCII
5588         ERCR    / ( - ILLEGAL HERE
5589         ACCPT3-2        /SPACE - END
5590         ACCPT3-1        /CR - END
5591
5592 /'GARGS' JUMP LIST - TERMINATORS
5593 GAROPS, GAR5    /-
5594         GAR6    /,
5595         ERCS    /:, SHOULDN'T SEE, WILL DO ERROR
5596         GAR4    /.
5597         ERCS    /SPACE, SHOULDN'T SEE, WILL DO 'ERROR'
5598         GAR3    /CR
5599
5600 /'GARGS' & 'ARG' COMMAND LISTS
5601 GARLST, "-
5602         ",
5603 GETLST, ":
5604 ARGLST, ".
5605         240     /SPACE
5606         215     /CR
5607         0
5608
5609 /'GETNT' LISTS
5610 GETOPS, GETCOL
5611         GETPER
5612         GETEND
5613         GETEND+1
5614
5615 /'ARG' JUMP LIST
5616 ARGOPS, ARG2
5617         ARG3
5618         ARG3
5619
5620 /'WCHEK' LISTS
5621 WCKLST, "(
5622         ")
5623         ""
5624         "'
5625         215
5626         0
5627
5628 WCKOPS, WCHEK5+1
5629         WCHEK5
5630         WCHEK6+1
5631         WCHEK6
5632         WCHEK4
5633
5634 /'EVAL' JUMP LIST 1
5635 EVOPS1, EVNEXT  /+
5636         EVMIN   /-
5637         EVLPAR  /(
5638
5639 /'EVAL' COMMAND LISTS
5640 EVLST1, "+
5641         "-
5642         "(
5643         0
5644
5645 EVLST2, "L
5646         "B
5647         "S
5648         "C
5649         "F
5650         "R
5651         "T
5652         "D
5653         0
5654
5655 /'EVAL' JUMP LIST 2
5656 EVOPS2, EVLOC   /L (LOC)
5657         EVBLK   /B (BLK)
5658         EVSR    /S (S.R.)
5659         EVSR+1  /C (CONTENTS)
5660         EVFIL   /F (FILLER)
5661         EVREM   /R (REMAINDER)
5662         EVTEMP  /T (TEMP)
5663         EVDATE  /D (DATE)
5664
5665 /ACTION CHARS FOR "READLN" SUBROUTINE
5666 REACTL, "R-100  /CTRL-R = RE-ECHO
5667         "U-100  /CTRL-U = ERASE LINE
5668         0
5669
5670 REACTS, RECHO
5671         RERASE
5672 \f/ERROR ROUTINE ADDRESS LIST:
5673
5674 ERLIST, ERCA
5675         ERCB
5676         ERCC
5677         ERC14
5678         ERCD
5679         ERCE
5680         ERCG
5681         ERCH
5682         ERCI
5683         ERCK
5684         ERCJ
5685         XSET1
5686         ERCL
5687         ERCZ
5688         ERCO
5689         ERC11
5690         ERC04
5691         ERCP
5692         ERCQ
5693         ERCR
5694         ERC09
5695         ERC08
5696         ERC13
5697         ERCS
5698         ERCT
5699         ERCU
5700         ERCV
5701         ERCW
5702         ERCX
5703         ERCY
5704         ERCM
5705         ERC00
5706         ERC01
5707         ERC02
5708         ERC03
5709         ERC10
5710         ERCF
5711         GCCERR
5712         HDRERR
5713         ERC05
5714         ERC07
5715         ERC18
5716         ERC19
5717         ERC20
5718         ERC15
5719         ERC16
5720         ERC17
5721         0
5722
5723
5724         DECIMAL
5725
5726 SMASKB, -1              /STRING SEARCH MASK BUFFER
5727                 /L(SMASKB)=66(10)
5728 COMB=   SMASKB+66       /COMMAND INPUT BUFFER
5729                 /L(COMB)= 140(10)
5730 PDLB=   COMB+140        /PUSH-DOWN-LIST BUFFER
5731                 /**** ALSO REWIND BUFFER! ****
5732         CCBB-PDLB       /SHOW PDL SPACE
5733
5734         OCTAL
5735
5736
5737 CCBB=   16400   /CORE-CONTROL-BLOCK BUFFER AND HEADER
5738                 / BUFFER FOR LOAD MODULES, 1 PAGE FIELD 1
5739
5740 DMPBUF= 16600   /DUMP OUTPUT BUFFER, 2 PAGES FIELD 1
5741
5742 IOBUF=  17200   /DEVICE I/O DUFFER, 2 PAGES FIELD 1
5743
5744
5745 $$$$
5746 \f