sw/os8/v3d/sources/system/dectapes/dectape3/BITMAP.PA

   1 /1.1 OS8 BINARY MAP (BITMAP) V4
   2 /
   3 /
   4 /
   5 /
   6 /
   7 /
   8 /
   9 /
  10 /
  11 /COPYRIGHT  (C)  1972,1973,1974,1975 BY DIGITAL EQUIPMENT CORPORATION
  12 /
  13 /
  14 /
  15 /
  16 /
  17 /
  18 /
  19 /
  20 /
  21 /
  22 /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
  23 /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
  24 /CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
  25 /FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
  26 /
  27 /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
  28 /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
  29 /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
  30 /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
  31 /
  32 /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
  33 /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
  34 /DIGITAL.
  35 /
  36 /
  37 /
  38 /
  39 /
  40 /
  41 /
  42 /
  43 /
  44 /
  45 \f/NO CHANGES MADE FOR OS/8 V3C
  46
  47         VERSION=        4
  48         SUBVER=         01      /LOCATED AT "VERLOC" AS 60+VERSION^100+SUBVER
  49
  50 XR=     10
  51 LOADXR= 11
  52 XFIELD= 20      /HOLDS FIELD WE ARE "STORING" INTO
  53 ORIGIN= 21      /HOLDS CURRENT ORIGIN
  54 OUT=    22
  55 B1=     23
  56 B3=     24
  57 C1=     25
  58 COLCTR= 27
  59 WD=     30
  60 WD1=    31
  61 WD2=    32
  62 FILPTR= 33
  63 FLDNO=  35
  64
  65 /OS/8 EQUIVALENCES
  66
  67 MPARAM= 7643
  68 JSBITS= 7746
  69 MIFILE= 7617
  70 PTP=    20
  71 DCB=    7760
  72
  73 /BUFFER AND DEVICE HANDLER ASSIGNMENTS
  74
  75 OUCTL=  4200
  76 OUBUF=  6000
  77 OUDEVH= 6400
  78 \f       FIELD 1
  79         *2000
  80
  81 BITMAP, JMP CALLCD
  82         JMP NOCD        /CHAINED ENTRY POINT
  83 NEXTCD, TAD I   (MPARAM-1
  84         SPA CLA
  85         JMP I   (BUILD  /ALTMODE TERMINATES INPUT, STARTS OUTPUT
  86 CALLCD, JMS I (200
  87         5               /COMMAND DECODE
  88         0216            /DEFAULT EXTENSION IS .BN
  89 NOCD,   TAD     (LDRPCH
  90         DCA     OUT
  91         ISZ     ONCE
  92         JMP     CDCOOL
  93         CLA CLL CMA RTL
  94         CDF 0
  95         AND I   (JSBITS /REMOVE "DON'T CARE ABOUT CD AREA" BIT
  96         DCA I   (JSBITS
  97         CDF 10
  98         JMS I   (CTINIT
  99 CDCOOL, TAD I (MPARAM+1
 100         AND (100
 101         SZA CLA         /IS /R SWITCH ON?
 102         JMS I (CTINIT   /YES - RE-INITIALIZE LOADER TABLES
 103 LD7400, 7400
 104         TAD (MIFILE
 105         DCA FILPTR
 106         JMP I   (NEWFIL
 107 ONCE,   -1
 108 \f/SUBROUTINE TO "LOAD" A WORD.
 109 /INCREMENTS TWO-BIT QUANTITY CORRESPONDING TO THE WORD.
 110 /FIELD 0 IS MAPPED INTO WORDS 00000-01377,FIELD 1 INTO 01400-02777
 111 /FIELDS 4-7 ARE MAPPED INTO 20000-25777
 112
 113 LOADWD, 0               /ENTER WITH LOW 4 BITS OF ORIGIN IN AC
 114         CLL RAL
 115         TAD     (BITTBL-1
 116         DCA     LOADXR
 117         TAD I   LOADXR  /GET WORD IN THE 3-WORD SET
 118         DCA     LDOFST  /(WHICH MAPS 16 WORDS)
 119         TAD I   LOADXR  /GET THE LOW ORDER BIT OF THE PAIR
 120         DCA     LDBIT   /WHICH MAPS THIS WORD
 121         TAD     ORIGIN  /NOW FIND OUT WHICH TRIPLEWORD TO USE
 122         RTL
 123         RTL
 124         AND     (7407
 125         TAD     XFIELD
 126         RTL
 127         RTL
 128         CDF 0
 129         RTL
 130         RAL
 131         SZL
 132 CDF20Y, CDF 20          /NOP'ED IF NO FIELD 2 IN MACHINE
 133         CLL RTR         /FIELDS 4-7 MAPPED IN FIELD 2
 134         DCA     LTEMP
 135         TAD     LTEMP
 136         CLL RAL
 137         TAD     LTEMP
 138         TAD     LDOFST
 139         DCA     LTEMP
 140         TAD     LDBIT
 141         CLL RAL
 142         TAD     LDBIT
 143         AND I   LTEMP
 144         SNA CLA         /IF COUNT IS AT 3 (MAX),
 145         JMP I   LOADWD  /DON'T INCREMENT IT
 146         TAD     LDBIT
 147         CIA
 148         TAD I   LTEMP
 149         DCA I   LTEMP
 150         RDF
 151         CDF 10
 152         SZA CLA
 153         DCA I   (F4FLAG /SEARCH FIELD 2 IF WE STORED THERE
 154         JMP I   LOADWD
 155 LDOFST, 0
 156 LDBIT,  0
 157 LTEMP,  0
 158 \f/BIT TABLE FOR MAPPING
 159
 160 BITTBL, 0;2000;0;400;0;100;0;20;0;4;0;1
 161         1;2000;1;400;1;100;1;20;1;4;1;1
 162         2;2000;2;400;2;100;2;20;2;4;2;1
 163         PAGE
 164 \fNEWFIL,        TAD (7001
 165         DCA HANDLR
 166         TAD I FILPTR
 167         AND (7760
 168         SZA             /LENGTH OF 256 BLOCKS IMPLIES AT LEAST 256
 169         TAD (17
 170         CLL CML RTR
 171         RTR
 172         DCA RCDCNT
 173         TAD I FILPTR
 174         ISZ FILPTR
 175         SNA
 176         JMP I   (NEXTCD /FILE POINTER = 0 MEANS NO MORE INPUT FILES
 177         JMS I (200
 178         1               /ASSIGN
 179 HANDLR, 7001            /LOAD INTO 7000 IF NOT ALREADY LOADED
 180         JMP I (IOERR
 181         TAD I FILPTR
 182         DCA RECNO
 183         ISZ FILPTR
 184         CLA CMA
 185         DCA CHCNT
 186         DCA REOF
 187         TAD I (MPARAM   /TEST FOR /I
 188         AND (10
 189         SNA CLA
 190         JMP I (LOADER   /I IS NOT ON
 191         JMP I (OERR     /NO!
 192 \fGETCH, 0               /GET-NEXT-INPUT-CHARACTER ROUTINE
 193         JMS I   (CTCTST
 194         ISZ JMPGET
 195         ISZ CHCNT
 196 JMPX,   JMP JMPGET
 197         TAD REOF
 198         SZA CLA
 199         JMP I GETCH     /EOF REACHED BEFORE LOGICAL END - ERROR
 200         CLL
 201         TAD     RCDCNT
 202         TAD     (6
 203         SNL
 204         DCA     RCDCNT
 205         SZL
 206         ISZ     REOF
 207         CLL CMA CML RTR
 208         RTR
 209         RTR
 210         TAD     (1411
 211         DCA     RCTL
 212         CIF 0
 213         JMS I HANDLR
 214 RCTL,   0               /READ RECORDS INTO FIELD 1
 215 PBUFFR, BUFFER
 216 RECNO,  0
 217         JMP RERROR
 218         TAD     RECNO
 219         TAD     (6
 220         DCA     RECNO
 221         TAD     (-4401
 222         DCA CHCNT
 223         TAD PBUFFR
 224         DCA CHPTR
 225         TAD JMPX
 226         DCA JMPGET
 227         JMP GETCH+1
 228 \fJMPGET,        JMP .
 229         JMP CHAR1
 230         JMP CHAR2
 231         TAD JMPX
 232         DCA JMPGET
 233         TAD I CHPTR
 234         AND (7400
 235         CLL RTR
 236         RTR
 237         TAD CHTMP
 238         RTR
 239         RTR
 240         ISZ CHPTR
 241         JMP GCHCOM
 242 CHAR2,  TAD I CHPTR
 243         AND (7400
 244         DCA CHTMP
 245         ISZ CHPTR
 246 CHAR1,  TAD I CHPTR
 247 GCHCOM, AND (377
 248         ISZ GETCH
 249         JMP I GETCH
 250 RERROR, SPA CLA
 251         JMP I (IOERR    /AN ACTUAL READ ERROR - AMAZING!
 252         ISZ REOF
 253         JMP RECNO+2
 254 REOF,   0
 255 CHCNT,  0
 256 CHPTR,  0
 257 CHTMP,  0
 258 RCDCNT, 0
 259 \fZTST,  0               /TEST A BLOCK OF THE BITMAP FOR ALL ONES
 260         DCA     B3      /LENGTH OF THE BLOCK IN AC
 261         TAD     LOADXR
 262         DCA     XR
 263         STA
 264         JMS I   (XCDF
 265         AND I   XR
 266         ISZ     B3
 267         JMP     .-2
 268         CDF 10
 269         CMA
 270         SZA
 271         JMP I   ZTST
 272         TAD     XR
 273         DCA     LOADXR  /UPDATE LOADXR IF ALL ZEROES
 274         JMP I   ZTST
 275         PAGE
 276 \fITSOVR,        JMS ASSEMB      /GET THE CHECKSUM
 277         CIA
 278         TAD LCKSUM
 279         SZA CLA         /IS IT GOOD?
 280         JMP I (BADCKS   /NO
 281         TAD I (MPARAM+1
 282         AND L40
 283         SNA CLA         /IF /S IS NOT SET,
 284         JMP I (NEWFIL   /ONLY ONE PROGRAM PER FILE.
 285 LOADER, DCA LCKSUM
 286         JMS GETFLD
 287         DCA XFIELD
 288         TAD (200
 289         DCA ORIGIN      /INITIALIZE FOR PROGRAM
 290         JMS I (GETCH
 291         JMP I (NEWFIL
 292         SNA
 293         JMP .-3
 294         TAD (-200       /FIND SOME LEADER
 295         SZA CLA
 296         JMP LOADER+1
 297 LEADER, JMS I (GETCH
 298         JMP I (NEWFIL
 299         SNA
 300         JMP LOADER+1
 301         TAD (-200       /FIND END OF LEADER
 302         SNA
 303         JMP LEADER
 304 NEWWD,  SMA             /FIELD SETTING?
 305         JMP FIELDW      /YES
 306         TAD (200
 307         DCA WD1         /STORE 1ST CHAR
 308         JMS I (GETCH
 309         JMP I (BADINP
 310         DCA WD2         /2D CHAR
 311         JMS I (GETCH
 312         JMP I (BADINP
 313         TAD (-200       /IF THIS IS LEADER, WE HAVE THE CHECKSUM
 314         SNA
 315         JMP ITSOVR
 316         DCA WD
 317         JMS ASSEMB
 318         SNL             /ORIGIN OR DATA?
 319         JMP DATAWD      /DATA
 320         DCA ORIGIN
 321         JMP GETNXT
 322 \fDATAWD,        CLA
 323         TAD     ORIGIN
 324         AND     (17
 325         JMS I (LOADWD   /GO SET THE CORRECT BIT(S)
 326         CDF 10
 327         ISZ ORIGIN
 328 L40,    40
 329 GETNXT, TAD WD1
 330         TAD WD2
 331         TAD LCKSUM
 332         DCA LCKSUM
 333         TAD WD
 334         JMP NEWWD
 335
 336 ASSEMB, 0
 337         TAD WD1
 338         CLL RTL
 339         RTL
 340         RTL
 341         TAD WD2
 342         JMP I ASSEMB
 343
 344 FIELDW, TAD (-32
 345         SNA
 346         JMP CTLZ
 347         TAD (-46
 348         SPA
 349         JMP NOTXP
 350         DCA WD1
 351         TAD WD1
 352         AND (7
 353         SZA CLA
 354         JMP NOTXP
 355         TAD WD1
 356         AND (70
 357         DCA XFIELD
 358         JMS I (GETCH
 359         JMP I (BADINP
 360         TAD (-200
 361         SZA
 362         JMP NEWWD
 363 NOTXP,  CLA
 364         TAD LCKSUM
 365         SNA CLA
 366         JMP LOADER
 367         JMP I (BADINP
 368 LCKSUM, 0
 369
 370 CTLZ,   TAD LCKSUM
 371         SZA CLA
 372         JMP I (BADINP
 373         JMP I (NEWFIL
 374 \fGETFLD,        0               /ROUTINE TO CHECK FOR OPTION 0-7
 375         DCA C1          /AND RETURN LOWEST-NUMBERED VALUE
 376         TAD I (MPARAM+2
 377         AND (1774
 378         SNA
 379         JMP I GETFLD
 380         RTL
 381         RAL
 382         ISZ C1
 383         SNL
 384         JMP .-3
 385         CLA CMA
 386         TAD C1
 387         CLL RTL
 388         RAL
 389         JMP I GETFLD
 390         PAGE
 391 \fERPCH, 0
 392         AND (77         /GET LOW ORDER 6 BITS
 393         SZA
 394         JMP NZCHAR
 395         JMS ERR
 396 FILMSG, TEXT    /, FILE 0/
 397         JMP I   (BITMAP
 398 NZCHAR, TAD     (240
 399         AND     (77
 400         TAD     (240
 401         JMS I   OUT     /PRINT
 402         JMP I ERPCH     /AND RETURN
 403
 404 LDRPCH, 0
 405         TLS
 406         TSF
 407         JMP .-1
 408         CLA
 409         JMP I LDRPCH
 410
 411 ERR,    0
 412         CLA
 413         CDF 10
 414         TAD I (FILPTR   /ZERO CHAR GETS REPLACED BY "FILE #"
 415         TAD (322        /MAGIC NUMBER
 416         CLL CML RAR     /AC NOW CONTAINS " #"
 417         DCA FILMSG+3
 418 ERRLUP, TAD I ERR
 419         SNA
 420         JMP EOMESG      /MESSAGE MUST BE EVEN NUMBER OF CHARS LONG
 421         RTR
 422         RTR
 423         RTR
 424         JMS ERPCH
 425         TAD I ERR
 426         JMS ERPCH
 427         ISZ ERR
 428         JMP ERRLUP
 429 EOMESG, JMS I   (ECRLF
 430         JMP I   ERR     /RETURN
 431 \fIOERR, JMS ERR
 432         TEXT    %I/O ERROR%
 433         JMP I   (BITMAP
 434 BADINP, JMS ERR
 435         TEXT    /BAD INPUT/
 436         JMP I   (BITMAP
 437 BADCKS, JMS ERR
 438         TEXT    / BAD CHECKSUM/
 439         JMP I   (BITMAP
 440 NULERR, JMS ERR
 441         TEXT    /NO INPUT/
 442         JMP I   (BITMAP
 443 OUTERR, TAD     (LDRPCH
 444         DCA     OUT
 445         JMS ERR
 446         TEXT    /ERROR ON OUTPUT DEVICE/
 447         JMP I   (CALLCD
 448 OERR,   JMS ERR
 449         TEXT %NO /I!%
 450         JMP I   (BITMAP
 451 \fCTINIT,        0
 452         CLA CLL CML RTR
 453         DCA     C1
 454         DCA     B1
 455         DCA     0       /STRAIGHT-8 CROCK
 456 CTINLP, CDF 0
 457         CLA CMA
 458         DCA I B1
 459 CDF20X, CDF 20
 460         STA
 461         DCA I   B1
 462         JMP     CTFLD2  /*** THIS INSTR SKIPPED IF 8K PDP-8!!!
 463         DCA     CDF20X  /DUE TO BUG IN EXTENDED MEMORY CONTROLLER
 464         TAD     ERR+1   /A CLA
 465         CDF 10
 466         DCA I   (CDF20Y
 467 CTFLD2, ISZ     B1
 468         ISZ C1
 469         JMP CTINLP
 470         CDF 10
 471         JMP I CTINIT
 472         PAGE
 473 \f/GENERAL OUTPUT ROUTINES
 474
 475         /JMS I (OOPEN           INITIALIZES THE OUTPUT ROUTINE
 476         /ERROR RETURN           AC>0 IF NO OUTPUT DEVICE/FILE, AC<0 IF ERROR
 477
 478         /JMS I (OCHAR           OUTPUTS A CHARACTER
 479         /ERROR RETURN           OUTPUT ERROR OR TOO MUCH OUTPUT
 480
 481         /JMS I (OCLOSE          CLOSES THE OUTPUT FILE
 482         /ERROR RETURN           FILE TOO LARGE TO BE CLOSED OR OUTPUT ERROR
 483
 484         /JMS I (OTYPE           RETURNS DCB WORD OF OUTPUT DEVICE IN AC
 485
 486
 487
 488         /PARAMETERS NEEDED:
 489
 490         /OUBUF=         ADDRESS OF OUTPUT BUFFER
 491         /OUCTL=         OUTPUT BUFFER CONTROL WORD (MUST BE NEGATIVE)
 492         /OUDEVH=        ADDRESS OF PAGE FOR OUTPUT HANDLER
 493
 494         /ASSUMES I/O MONITOR IS RESIDENT IN CORE.
 495         /CAN BE CALLED FROM ANY FIELD WITH BUFFERS IN ANY FIELD.
 496
 497 OUFLD=  OUCTL&70
 498 \fOOPEN, 0
 499 OU7600, 7600
 500         TAD OU7601
 501         DCA OUBLK
 502         TAD (OUDEVH+1
 503         DCA OUHNDL
 504         CDF 10
 505         TAD I   (7604
 506         SNA             /IF OUTPUT HAS NO EXTENSION,
 507         TAD     (1520   /GIVE IT THE EXTENSION .MP
 508         DCA I   (7604
 509 OUASGN, TAD I OU7600            /GET DEVICE NUMBER WORD OF OUTPUT FILE ENTRY
 510         AND (17                 /STRIP OFF ANY LENGTH INFO
 511         SNA                     /IS THERE AN OUTPUT DEVICE?
 512         JMP USETTY              /NO - INHIBIT OUTPUT
 513         JMS I (200
 514         1                       /ASSIGN, FETCH HANDLER
 515 OUHNDL, 0                       /OUTPUT DEVICE HANDLER ENTRY
 516         HLT                     /HUH?
 517 OUENTR, TAD I OU7600
 518         JMS I (200
 519         3                       /ENTER OUTPUT FILE
 520 OUBLK,  7601                    /REPLACED WITH STARTING BLOCK
 521 OUELEN, 0                       /REPLACED WITH LENGTH OF HOLE
 522         JMP OEFAIL              /FAILED - MAYBE WE ASKED TOO MUCH
 523         DCA OUCCNT
 524         JMS I (OUSETP
 525         CDF CIF 10              /RESTORE CALLING FIELDS
 526         JMP I OOPEN
 527 OEFAIL, TAD I OU7600
 528         AND (7760               /GET REQUESTED LENGTH
 529         SNA CLA                 /WAS IT AN INDEFINITE REQUEST
 530         JMP I   (OUTERR         /YES - CANNOT ENTER THE FILE
 531         TAD I OU7600
 532         AND (17                 /MAKE THE REQUESTED LENGTH ZERO
 533         DCA I OU7600
 534         JMP OUENTR              /TRY, TRY AGAIN
 535 USETTY, DCA     TTYNO
 536         JMS I   (200
 537         12
 538         5524
 539 TTYNO,  0
 540         0
 541         HLT     /NO TELETYPE!
 542         TAD     TTYNO
 543         DCA I   OU7600
 544         JMP     OUASGN
 545 \fOUTDMP,        0
 546         DCA OUCTLW              /STORE THE CONTROL WORD
 547         CDF 10
 548         TAD OUCCNT
 549         SNA
 550         ISZ OUCTLW
 551         TAD OUBLK
 552         DCA OUREC               /COMPUTE THE STARTING BLOCK NUMBER OF THIS TRANSFER
 553         TAD OUCTLW
 554         CLL RTL
 555         RTL
 556         RTL
 557         AND (17                 /COMPUTE THE NUMBER OF RECORDS
 558         TAD OUCCNT              /UPDATE THE NUMBER OF BLOCKS IN THE FILE
 559         DCA OUCCNT
 560         TAD OUCCNT
 561         CLL CML
 562         TAD OUELEN
 563         SNL SZA CLA             /DOES THE LENGTH EXCEED THE GIVEN LENGTH?
 564         JMP I (OUTERR           /YES - SIGNAL OUTPUT ERROR
 565         CIF 0
 566         JMS I OUHNDL
 567 OUCTLW, 0
 568         OUBUF
 569 OUREC,  0
 570         JMP I   (OUTERR
 571         JMP I OUTDMP
 572 \fOCLOSE,        0
 573         CDF 10
 574         JMS I (OTYPE
 575         AND (770
 576         TAD (-PTP               /CHECK FOR PAPER TAPE PUNCH OUTPUT
 577         SZA CLA                 /AND SKIP ^Z OUTPUT IF TRUE
 578         TAD (232                /OUTPUT A ^Z
 579         JMS I (OCHAR
 580         JMS I (OCHAR
 581 FILLLP, JMS I (OCHAR
 582         JMS I (OTYPE            /GET TYPE OF OUTPUT DEVICE
 583         SPA CLA
 584         TAD (100                /IF ITS A DIRECTORY DEVICE FORCE A RECORD
 585         TAD (77                 /BOUNDARY - OTHERWISE A HALF-RECORD
 586         AND I (OUDWCT
 587         SZA CLA                 /UP TO THE BOUNDARY YET?
 588         JMP FILLLP              /NO - FILL WITH ZEROS
 589         TAD I (OUDWCT           /GET DOUBLEWORD COUNT LEFT
 590         TAD (OUCTL&3700
 591         SNA                     /A FULL WRITE LEFT?
 592         JMP NODUMP              /YES - DON'T DO IT - THE ^Z IS ALREADY OUT
 593         TAD (4000+OUFLD         /PUT IN THE FIELD BITS AND THE WRITE BIT
 594         JMS OUTDMP
 595 NODUMP, TAD I OU7600            /GET THE DEVICE NUMBER
 596         JMS I (200
 597         4                       /CLOSE THE OUTPUT FILE
 598 OU7601, 7601                    /POINTER TO THE OUTPUT FILE NAME
 599 OUCCNT, 0
 600         JMP I   (OUTERR
 601         CDF CIF 10              /RESTORE CALLING FIELDS
 602         JMP I OCLOSE
 603         PAGE
 604 \fOUCTMP=        OUCTL&3700
 605 OUSETP, 0                       /ROUTINE TO INITIALIZE CHARACTER POINTERS
 606         TAD (-OUCTMP            /GET SIZE OF BUFFER IN DOUBLEWORDS
 607         DCA OUDWCT
 608         TAD (OUBUF
 609         DCA OUPTR               /INITIALIZE WORD POINTER
 610         TAD OUJMPE
 611         DCA OUJMP               /INITIALIZE THREE-WAY CHARACTER SWITCH
 612         JMP I OUSETP
 613
 614 OCHAR,  0
 615         AND (377
 616         DCA OUTEMP
 617         RDF
 618         TAD CDIF0
 619         DCA OUCRET
 620         CDF OUFLD               /SET DATA FIELD TO BUFFER'S FIELD
 621         ISZ OUJMP               /BUMP THE CHARACTER SWITCH
 622 OUJMP,  HLT                     /THREE WAY CHARACTER SWITCH
 623         JMP OCHAR1
 624         JMP OCHAR2
 625 OCHAR3, TAD OUTEMP
 626         CLL RTL
 627         RTL
 628         AND (7400
 629         TAD I OUPOLD
 630         DCA I OUPOLD            /UPDATE FIRST WORD OF TWO WITH HIGH
 631         TAD     OUTEMP          /ORDER 4 BITS OF THIRD CHAR
 632         CLL RTR
 633         RTR
 634         RAR
 635         AND (7400
 636         TAD I OUPTR
 637         DCA I OUPTR             /UPDATE SECOND WORD FROM LOW ORDER 4 BITS
 638         TAD OUJMPE
 639         DCA OUJMP               /RESET SWITCH
 640         ISZ OUPTR
 641         ISZ OUDWCT              /BUMP DOUBLEWORD COUNTER EVERY 3 CHARS
 642         JMP OUCRET
 643         TAD (OUCTL              /LOAD CONTROL WORD FOR A FULL WRITE
 644         JMS I (OUTDMP           /DUMP THE BUFFER
 645         JMS OUSETP              /RE-INITIALIZE THE POINTERS
 646         JMP OUCRET
 647 OCHAR2, TAD OUPTR
 648         DCA OUPOLD              /SAVE POINTER TO FIRST WORD OF TWO
 649         ISZ OUPTR               /BUMP WORD POINTER TO SECOND WORD
 650 OCHAR1, TAD OUTEMP
 651         DCA I OUPTR
 652 OUCRET, HLT                     /RESTORE CALLING FIELDS
 653         JMP I OCHAR
 654 OUTEMP, 0
 655 OUPOLD, 0
 656 OUPTR,  0
 657 OUJMPE, JMP OUJMP
 658 OUDWCT, 0
 659 \fOTYPE, 0
 660         RDF
 661         TAD CDIF0
 662         DCA OTRTN
 663         CDF 10
 664         TAD I (7600
 665         AND (17
 666         TAD (DCB-1
 667         DCA OUTEMP
 668         TAD I OUTEMP
 669 OTRTN,  HLT
 670         JMP I OTYPE
 671
 672 DOBITS, 0
 673         DCA     B3
 674         JMS I   (XCDF
 675         TAD I   LOADXR
 676         CDF 10
 677         DCA     B1
 678 BITLP,  TAD     B1
 679         CLL RTL
 680         DCA     B1
 681         TAD     B1
 682         CMA CML RAL
 683         AND     (3
 684         TAD     (260
 685         JMS I OUT
 686         ISZ COLCTR
 687         TAD     COLCTR
 688         AND     (7
 689         SZA CLA
 690         JMP BITISZ
 691         TAD I   (TTOFLG
 692         SNA CLA         /IF OUTPUT IS NOT TO TTY,
 693         TAD (240        /PUT A SPACE AFTER EVERY GROUP OF 8
 694         SZA
 695         JMS I OUT
 696 BITISZ, ISZ     B3
 697         JMP     BITLP
 698         JMP I   DOBITS
 699 \fCTCTST,        0
 700         TAD     (200
 701         KRS
 702         TAD (-203
 703         SNA CLA                 /IS THE TELETYPE BUFFER A ^C
 704         KSF                     /WITH THE TELETYPE FLAG ON?
 705         JMP I CTCTST                    /NO
 706 CDIF0,  CDF CIF 0               /YES - GO TO MONITOR
 707         JMP I (7605             /THROUGH THE "DON'T SAVE CORE" RETURN
 708
 709         PAGE
 710 \fBUILD, STA
 711         DCA     SOMTHN
 712         TAD     (-10
 713         DCA     FLDNO
 714         TAD     MAPSKP
 715         DCA     F4SKP   /INITIALIZE ONCE-ONLY SKIP
 716 FLDLP,  TAD     FLDNO
 717         AND     (4
 718         CLL RTL
 719         TAD     (CDF
 720         DCA     CDFX    /STORE A CDF 0 OR CDF 20
 721         TAD     FLDNO
 722         RTR
 723         SZL SPA CLA     /IF FLDNO IS 0 OR 4,
 724         JMP     NOT04   /INITIALIZE LOADXR TO 0
 725 F4SKP,  SKP
 726 F4FLAG, JMP     MAPOVR  /ZEROED IF INFO IN FIELD 2
 727         DCA     F4SKP
 728         STA
 729         DCA     LOADXR
 730 NOT04,  TAD     (-1400
 731         JMS I   (ZTST
 732         SZA CLA         /FIELD EMPTY?
 733         JMP     NONEMP  /NO
 734 FLDISZ, ISZ     FLDNO
 735         JMP     FLDLP
 736 MAPOVR, ISZ     SOMTHN  /WAS THERE ANY INPUT?
 737 MAPSKP, SKP
 738         JMP I   (NULERR
 739         JMS I   (ECRLF
 740         JMS I   (ECRLF
 741         JMS I   (OCLOSE
 742         CDF CIF 0
 743         JMP I   (7605
 744
 745 NONEMP, ISZ     SOMTHN  /HAVE WE OUTPUT ANYTHING YET?
 746         JMP     NOTFST
 747         JMS I   (OOPEN  /NO - OPEN OUTPUT FILE NOW
 748         JMS I   (OTYPE
 749         SNA CLA         /SET MODE OF OUTPUT - /T INVERTS
 750         TAD     (20     /NORMAL TTY/NO TYY DISTINCTION
 751         TAD I   (MPARAM+1
 752         AND     (20
 753         DCA I   (TTOFLG
 754         TAD     (OCHAR
 755         DCA     OUT
 756 NOTFST, JMS I   (EJECT1 /PAGE HEADING
 757         TAD     (-100
 758         DCA     PAGECT
 759 PAGELP, TAD     FLDNO
 760         TAD     (270
 761         JMS I   OUT
 762         TAD     PAGECT
 763         AND     (70
 764         CLL RTR
 765         RAR
 766         TAD     (260    /OUTPUT LOC (HIGH 3 DIGITS) AT LEFT MARGIN
 767         JMS I   OUT
 768         TAD     PAGECT
 769         AND     (7
 770         TAD     (260
 771         JMS I   OUT
 772         TAD     (260
 773         JMS I   OUT
 774         TAD     (260
 775         JMS I   OUT
 776         TAD     (240
 777         JMS I   OUT
 778         DCA     COLCTR
 779         TAD     (-14
 780         JMS I   (ZTST   /IF ALL 64 WORDS ARE ZERO,
 781         SNA CLA
 782         JMP NO1ND0      /DON'T PRINT LINE
 783         TAD     (-4
 784         DCA     SOMTHN
 785 DOBTLP, TAD     (-6
 786         JMS I   (DOBITS /OUTPUT 4 TRIPLEWORDS FOR 64 LOCATIONS
 787         TAD     (-6
 788         JMS I   (DOBITS
 789         TAD     (-4
 790         JMS I   (DOBITS
 791         ISZ     SOMTHN
 792         JMP     DOBTLP
 793 NO1ND0, JMS I   (ECRLF
 794         CLA IAC
 795         AND     PAGECT
 796         SZA CLA
 797         JMS I   (ECRLF  /SKIP A LINE EVERY PDP-8 PAGE
 798         TAD     PAGECT
 799         TAD     (41
 800         SNA CLA
 801         JMS I   (EJECT1 /NEW PAGE AT LOCATION 4000
 802         ISZ     PAGECT
 803         JMP     PAGELP
 804         JMP     FLDISZ
 805 PAGECT, 0
 806 SOMTHN, 0
 807
 808 XCDF,   0
 809 CDFX,   HLT
 810         JMP I   XCDF
 811         PAGE
 812 \fEJECT1,        0
 813         TAD     FLDNO
 814         TAD     (4070
 815         DCA     FLDNUM
 816         TAD     TTOFLG
 817         SZA CLA         /TELETYPE STYLE OUTPUT?
 818         JMP     EJKTTY  /YES
 819         TAD     (214    /NO - FORM FEED
 820         JMS I   OUT
 821 PRTFLD, JMS I   (ERR
 822         TEXT    / BITMAP  V/
 823         *.-1
 824 VERLOC, 60+VERSION^100+SUBVER   /V5A, ETC...
 825         TEXT    /   FIELD/
 826         *.-1
 827 FLDNUM, TEXT    / 0/
 828         JMS     ECRLF
 829         TAD     TTOFLG
 830         SNA CLA         /IF NOT TTY OUTPUT,
 831         JMP EJKLPT      /DON'T PRINT HORIZONTAL GUIDE
 832
 833         JMS I   (ERR
 834         TEXT    /      0000000011111111222222223333333344444444555555556666666677777777/
 835         JMS I   (ERR
 836         TEXT    /      0123456701234567012345670123456701234567012345670123456701234567/
 837 EJKLPT, JMS     ECRLF
 838         JMP I   EJECT1
 839 \fEJKTTY,        TAD     (-13
 840         DCA     EJKTMP
 841         JMS     ECRLF
 842         ISZ     EJKTMP
 843         JMP     ECRLFX
 844         JMS I   (ERR
 845         TEXT    /----/
 846         JMS     ECRLF
 847         JMP     PRTFLD
 848 EJKTMP, 0
 849
 850 ECRLF,  0
 851         TAD     (215
 852         JMS I   OUT
 853 ECRLFX, TAD     (212
 854         JMS I   OUT
 855         JMP I   ECRLF
 856
 857 TTOFLG, 0               /20 IF TTY-STYLE OUTPUT
 858         PAGE
 859 \f       BUFFER=.
 860         $-$-$
 861 \f