A large commit.
[pdp8.git] / sw / os8 / v3d / sources / extensions / dectapes / dectape2 / bload.pa
diff --git a/sw/os8/v3d/sources/extensions/dectapes/dectape2/bload.pa b/sw/os8/v3d/sources/extensions/dectapes/dectape2/bload.pa
new file mode 100644 (file)
index 0000000..4bd98b2
--- /dev/null
@@ -0,0 +1,1560 @@
+/OS8 BASIC LOADER, V5
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1972, 1973, 1974, 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/DEC-S8-LBASA-B-LA
+/
+/COPYRIGHT  C  1972, 1973, 1974
+/
+/DIGITAL EQUIPMENT CORPORATION
+/MAYNARD,MASSACHUSETTS 01754
+/
+/AUGUST 19, 1972
+/
+/HANK MAURER, 1972
+/SHAWN SPILMAN, 1973
+/
+/
+/
+/
+/ASSEMBLE AND LOAD AS FOLLOWS:
+/
+/      .R PAL8
+/      *BLOAD,BLOAD<BLOAD.03
+/      .R ABSLDR
+/      *BLOAD$
+/      .SA SYS BLOAD;7605
+/
+/NOTE DIFFERENCES FROM VERSION 1 BY TRUNCATING
+/THE SOURCE AFTER TAG "IMAGE" AND THEN:
+/
+/      .R SRCCOM
+/      *LPT:<BLOAD.01,BLOAD.03
+/      *
+/
+/ALL CODE FOLLOWING TAG "IMAGE" IS NEW FOR VERSION 3
+/
+       VERSON= 5       /VERSION WORD LOCATED AT TAG "VERLOC"
+                       /LEFT HALF CONTAINS 60+VERSON
+                       /RIGHT HALF CONTAINS PATCH LEVEL (A=01)
+
+/
+/CORRECTIONS MADE FOR V4               J.K 1975
+/ .MADE SWAP ROUTINE A REAL SWAP
+/ ./V FOR VERSION NUMBER
+/ ./C SO NON-BASIC SAVE FILES CAN CHAIN TO BASIC SAVE FILES
+/ .ADJUST JSW FOR /K
+/ .CORRECTED CCB FOR /K
+/ .CALCULATION OF DEFAULT CORE SIZE FOR PDP-8
+/ .TEST FOR BATCH RUNNIG
+/ .CHANGE ORDER OF CISTRT SO A CHAIN CAN BE
+/      CAN BE DONE FROM A .SV FILE WITH A 
+/      FILE STATEMENT
+/
+
+/JR    30-APR-77       UPDATE VERSION AND FIX ERROR IN MAKECI WHEN BATCH NOT 
+/                      RUNNING
+\f      /OS8 BASIC COMPILER POST PROCESSOR
+
+       /AUTO INDEX REGISTERS
+
+       X10=10
+       X11=11
+       X13=13
+       STACK=15
+
+       /DUMMY SECTIONS FOR COMPILER/RUNTIME COMMUNICATIONS
+
+       NOPUNCH
+
+       /BRTS COMMUNICATIONS REGION
+
+       *20
+STCDF, 0
+NSTADR,        0
+NASTAD,        0
+SSTADR,        0
+SASTAD,        0
+CODCDF,        0
+CODBGN,        0
+DATTOP,        0
+DATPTR,        0
+SWPINF,        0
+
+       /BCOMP COMMON REGION
+
+       *40
+VARCNT,        0
+SVCNT, 0
+ACNT,  0
+SACNT, 0
+LOCTRH,        0
+LOCTRL,        0
+BLOCK, 0
+HIFLD, 0
+BRTS,  0
+DLSIZE,        0
+ABORTX,        0
+
+       /PAGE 0 LOCATIONS USED BY LOADER
+
+FREEHI,        0
+FREELO,        0
+TEMP,  0
+TEMP2, 0
+TEMP3, 0
+WORD1, 0
+WORD2, 0
+WORD3, 0
+NCHARS,        0
+SUBHI, 0
+SUBLO, 0
+CODSZ1,        0
+CODSZ2,        0
+LOCHI, 0
+LOCLO, 0
+CODB,  0
+CODF,  0
+ICOUNT,        0
+OCOUNT,        0
+AC1,   0
+AC2,   0
+AC3,   0
+SC,    0
+LINEH, 0
+LINEL, 0
+XLABEL,        0
+CLRFLD,        0
+CLREND,        0
+RESADR,        0
+
+       /MORE COMPILER DEFINITIONS
+
+       SVARST= 1036
+       ARAYST= 2132
+       SARYST= 2332
+       STEMPS= 2560
+       LITRL=  STEMPS+2
+       SLITRL= LITRL+2
+       DATLST= SLITRL+2
+
+       /MISC DEFINES
+
+       STACKA= 7120    /MAIN STACK OF COMPILER
+       EDTBGN= 3212    /START OF EDITOR
+       EDTSIZ= 2100    /SIZE OF EDITOR
+       BRTBGN= 200     /START OF BRTS
+       BRTSIZ= 3400    /SIZE OF BRTS
+       DCB=    7760
+       JSW=    7746    /OS/8 JOB STATUS WORD
+       BIPCCL= 7777    /OS/8 SOFTWARE CORE SIZE AND BATCH FLAGS WORD
+       FSTOP1= 7       /ADDR OF BRTS EXIT ROUTINE
+
+       ENPUNCH         /END OF DUMMY SECTIONS
+\f      /LOADER PROPER
+
+       *400
+LOADER,        JMS I   (IMAGE  /CORE IMAGE FILE PATCH
+       TAD     (7577   /EXECUTION RESUMES HERE
+       DCA     FREELO
+       CIA IAC
+       DCA     SWPINF  /SET SWAPPER FLAG TO INDICATE 17600 IS IN FIELD 1
+       DCA     LINEH   /CLEAR LINE NUMBER
+       DCA     LINEL
+       TAD     STACK   /ANY UNCLOSED FOR'S ?
+       CIA
+       TAD     (STACKA-1
+       SNA CLA
+       JMP     .+3     /NO
+       JMS I   (ERMSG  /YES
+       2506
+       CLA CMA
+       TAD     HIFLD   /NO CDF'S IF ONLY 8K
+       SZA CLA
+       JMP     NOPATCH /NO PATCHES
+       TAD     (PATLST-1
+       DCA     X10
+PATLUP,        TAD I   X10
+       SNA
+       JMP I   (STSTUF
+       DCA     TEMP
+       TAD     (SKP    /ALWAYS TWO WORDS
+       DCA I   TEMP
+       JMP     PATLUP
+NOPATCH,CDF    10
+       TAD I   (DCB    /CHECK FOR TD8E SYSTEM
+       AND     (770    /ED FRIEDMAN GAVE ME THIS CODE
+       TAD     (-210   /AND I'M TAKING IT ON FAITH
+       CDF
+       SNA CLA
+       TAD I   (7612   /IS IT A ROM SYSTEM ?
+       TAD     (-3
+       SZA CLA
+GOTTD, JMP     NOTD8E  /NO TD/8E OR ROM TD/8E
+                       /PREV INSTR NOP'D OUT TO FORCE TD8E (IMAGE)
+       TAD     (7377   /TD8E SYS WASTES 400 WORDS
+       DCA     FREELO
+       STL RAR         /SET SWAP INFO (17600 OUT NOW)
+NOTD8E,        DCA     SWPINF
+       JMS I   (FREEF  /GET CDF TO HIGHEST FIELD
+       DCA     SWPF1   /INTO 2 PLACES
+       TAD     SWPF1
+       DCA     SWPF2
+       JMS     SWAP    /MOVE OS8 OUT
+       TAD     (TAD L6221
+       DCA     TDLIE+1
+       TAD     (TAD L6221
+       DCA     TDLIE+3
+       JMP I   (STSTUF /DO SYMBOL TABLE STUFF
+\fSWAP, 0               /SWAP OS8 RESIDENT
+       CLL CML RAR     /4000
+       AND     SWPINF  /IS IT A TD8E SYS ?
+       SZA CLA
+       JMP     TD8ESYS /YES
+       JMS     SWPSUB  /SWAP 17600 TO/FROM N7600
+       CDF     10
+       7600
+       JMP I   SWAP
+TD8ESYS,JMS    SWPSUB  /SWAP 17600 TO/FROM N7400
+       CDF     10
+       7400
+       JMS     SWPSUB  /SWAP 27600 TO/FROM N7600
+L6221, CDF     20
+L7600, 7600
+TDLIE, CLL CML RTL     /FIX UP 07600 STUFF TO MATCH
+       TAD     SWPF1   /CIF CDF N0
+       DCA I   (7642
+       TAD     SWPF1
+       IAC             /CIF N0
+       DCA I   (7721
+       TAD I   (7721
+       DCA I   (7727
+       JMP I   SWAP
+SWPRET,        CLA
+       CDF             /RETURN IF 8K
+       JMP I   SWAP
+SWPFLAG,0
+
+SWPSUB,        0               /SWAPPER
+       TAD I   SWPSUB  /GET FIELD
+       DCA     SWP1    /TWICE
+       TAD     SWP1
+       DCA     SWP2    /ONCE FOR EACH DIRECTION
+       ISZ     SWPSUB
+       TAD I   SWPSUB  /GET HI FIELD ADDR
+       DCA     TEMP
+       ISZ     SWPSUB
+       TAD     L7600   /GET COUNT/POITER
+       DCA     TEMP2
+SWP1,  HLT
+       TAD I   TEMP2   /GET PART OF RESIDENT
+       DCA     TEMP3
+SWPF1, JMP     SWPRET  /RETURN IF 8K ONLY
+       TAD I   TEMP
+SWP2,  HLT
+       DCA I   TEMP2
+       TAD     TEMP3
+SWPF2, HLT
+       DCA I   TEMP    /INTO HI FIELD
+       ISZ     TEMP    /BUMP POINTER
+       NOP             /JR PROTECT AGAINST WRAP AROUND
+       ISZ     TEMP2   /AND PTR/CTR
+       JMP     SWP1    /LOOP
+       CDF
+       JMP I   SWPSUB
+
+       PAGE
+\fNODATA,       CDF
+       JMS I   (FREEF  /SAVE FIELD
+       CIA
+       DCA     CLRFLD  /FOR ARRAY CLEARING
+       TAD     FREELO  /SAVE THIS ADDR
+       CIA
+       DCA     CLREND  /FOR END OF ARRAY CLEAR
+       ISZ     FREELO  /MAKE IT NEXT FREE + 1
+       TAD     (SVARST-1
+       DCA     X10     /ALLOCATE STRING VARS
+       TAD     (-436
+       DCA     TEMP
+ASVLUP,        CDF     10
+       TAD I   X10     /LOOK FOR DEFINED STRING VAR
+       DCA     TEMP2   /SAVE SYMBOL NUMBER
+       TAD I   X10     /GET SIZE
+       SPA
+       TAD     (4010   /IF UNDEF USE 16 CHARS
+       DCA     TEMP3
+       TAD     TEMP2   /IS IT DEFINED ?
+       CDF
+       SMA CLA
+       JMS     SVSTOR  /YES, CREATE ENTRY
+       ISZ     TEMP    /BUMP COUNT
+       JMP     ASVLUP  /LOOP
+       CDF     10      /ALLOCATE STRING TEMPS
+P6,    TAD I   (STEMPS+1
+       DCA     STEMPF  /INIT FIELD
+       TAD I   (STEMPS /AND POINTER
+       SKP
+STMLUP,        TAD     TEMP    /LOOK AT NEXT ENTRY
+       SNA
+       JMP I   (ALLOCA /DONE GO ALLOCATE ARRAYS
+       TAD     (-1
+       DCA     X10     /GET POINTER
+STEMPF,        CDF     10
+       TAD I   X10     /GET ADDR OF NEXT ENTRY
+       DCA     TEMP    /SAVE IT
+P7,    TAD I   X10     /AND ITS FIELD
+       DCA     STEMPF
+       ISZ     X10     /SKIP TEMP NUMBER
+       TAD I   X10     /GET SYM NUMBER
+       DCA     TEMP2
+       CDF
+       TAD     (110    /GIVE IT MAX SIZE
+       DCA     TEMP3
+       JMS     SVSTOR  /ALOOCATE IT
+       JMP     STMLUP  /LOOP
+SVSTOR,        0               /MAKE ST ENTRY FOR STRING VAR
+       TAD     TEMP2   /FIND ST ADDR
+       CLL RAL
+       TAD     TEMP2
+       TAD     SSTADR
+       DCA     X11
+       TAD     TEMP3   /NUMBER OF CHARS
+       TAD     (3
+       CLL RAR
+       DCA     SUBLO   /NUMBER OF WORDS
+       DCA     SUBHI
+       JMS     SUB     /FREEHI,LO=FREEHI,LO-SUBHI,LO
+       TAD     FREELO  /SAVE ADDR
+       DCA I   X11
+       JMS I   (FREEF  /AND FIELD
+       DCA I   X11
+       TAD     TEMP3   /PUT IN MAX LENGTH
+       CIA             /(NEGATIVE)
+       DCA I   X11
+       JMP I   SVSTOR
+PSN,   0               /PRINT 3 DIGITS DECIMAL
+       DCA     WORD2
+       CLL CMA RTL     /-3
+       DCA     XLABEL
+PRNTSN,        TAD     WORD2   /GET NEXT DIGIT
+       CLL RTL         /INTO THE LOW ORDER
+       RTL             /THREE BITS AND THE LINK
+       DCA     WORD2   /SAVE SHIFTED NUMBER
+       TAD     WORD2   /NOW DO LAST SHIFT
+       RAL
+       AND     (17     /ONLY FOUR BITS
+SPACE, SZA
+       JMP     NOZERO  /NOT A ZERO
+       TAD I   (TTY    /ANY DIGITS YET ?
+       SNA CLA
+       JMP     LEAD0   /NO, ITS A LEADING ZERO
+NOZERO,        TAD     (60     /MAKE IT ASCII
+       JMS I   (TTY    /PRINT DIGIT
+LEAD0, ISZ     XLABEL  /BUMP COUNT
+       JMP     PRNTSN  /MORE DIGIT(S)
+       JMP I   PSN
+SUB,   0               /DOUBLE SUBTRACT
+       TAD     SUBLO   /SUBTRACT LOWER
+       CLL CML CIA
+       TAD     FREELO
+       DCA     FREELO
+       RAL             /GET BORROW
+       TAD     SUBHI
+       CIA
+       TAD     FREEHI  /SUBTRACT UPPER
+       DCA     FREEHI  /SAVE NEW UPPER
+       TAD     FREEHI  /DID IT FIT ?
+       SMA SZA CLA
+       JMP I   SUB     /YUP
+TOOBIG,        DCA     LINEH   /CLEAR LINE NUMBER
+       DCA     LINEL
+       JMS I   (ERMSG  /WRITE MESSAGE
+       2402            /TOO BIG
+       JMP I   (ABORTL /ABORT RUN
+
+TTX,   0               /PRINT CHAR ON TTY
+       TSF             /WAIT FOR PREVIOUS CHAR
+       JMP     .-1
+       TLS             /PRINT THIS ONE
+       CLA
+       JMP I   TTX
+
+       PAGE
+\f/    CAUTION !!!
+/    THIS PAGE AND THE NEXT ONE ARE
+/    OVERLAYED BY THE INPUT BUFFER
+/    AS SOON AS THE ROUTINE "INWORD"
+/    IS CALLED. THIS FIRST HAPPENS
+/    AFTER THE TAG "RELCIT" .
+
+STSTUF,        TAD     FREELO  /SAVE START OF RESIDENT -1
+       CIA             /NEGATED
+       DCA     RESADR  /USED TO COMPUTE AMOUNT OF MOVE
+       TAD     VARCNT  /GET NUMBER OF
+       TAD     (401    /VARIABLES
+       CIA
+       DCA     VARCNT
+       TAD     SVCNT   /STRING VARIABLES
+       TAD     (401
+       CIA
+       DCA     SVCNT
+       TAD     ACNT    /ARRAYS
+       TAD     (41
+       CIA
+       DCA     ACNT
+       TAD     SACNT   /AND STRING ARRAYS
+       TAD     (41
+       CIA
+       DCA     SACNT
+       JMS I   (FREEF  /SAVE HIGH FIELD
+       DCA     STCDF
+       TAD     VARCNT  /SUBTRACT SPACE FOR
+       CLL RAL         /SCALAR TABLE (3 WORDS A PIECE)
+       TAD     VARCNT
+       TAD     FREELO  /DON'T BOTHER WITH A
+       DCA     FREELO  /DOUBLE PREC. SUBTRACTION
+       TAD     FREELO  /SAVE START OF SCALAR TABLE
+       IAC             /FOR INTERPRETER
+       DCA     NSTADR
+       TAD     FREELO  /CLEAR ALL VARIABLES
+       DCA     X10     /IN THE
+       DCA I   X10     /SCALAR TABLE
+       DCA I   X10
+       DCA I   X10
+       ISZ     VARCNT
+       JMP     .-4     /JUST TO BE NICE
+       CDF     10      /PREPARE TO MOVE
+P1,    TAD I   (LITRL+1/THE NUMERIC LITERALS
+       DCA     LFLD    /INTO THE SCALAR TABLE
+       TAD I   (LITRL
+       CDF
+       SKP
+NLLOOP,        TAD     TEMP    /ADDR OF NEXT LITERAL
+       SNA
+       JMP     NONL    /NO MORE NUMERIC LITERALS
+       TAD     (-1
+       DCA     X10
+LFLD,  CDF     10
+       TAD I   X10     /GET ADDR OF NEXT LITERAL
+       DCA     TEMP
+P2,    TAD I   X10     /ALSO ITS FIELD
+       DCA     LFLD
+       TAD I   X10     /NOW ITS VALUE
+       DCA     WORD1
+       TAD I   X10
+       DCA     WORD2
+       TAD I   X10
+       DCA     WORD3
+       TAD I   X10     /NOW THE SYMBOL NUMBER
+       DCA     TEMP2
+       TAD     TEMP2   /TIMES THREE
+       CLL RAL
+       TAD     TEMP2
+       TAD     FREELO  /PLUS START
+       DCA     X11     /GIVES STORE ADDR
+       CDF
+       TAD     WORD1   /NOW PUT LITERAL INTO TABLE
+       DCA I   X11
+       TAD     WORD2
+       DCA I   X11
+       TAD     WORD3
+       DCA I   X11
+       JMP     NLLOOP  /DO NEXT LITERAL
+NONL,  TAD     ACNT    /ALLOCATE ARRAY TABLE
+       CLL RAL
+       CLL RAL         /FOUR WORDS PER
+       TAD     FREELO  /SUBTRACT FROM LOWER END
+       DCA     FREELO
+       TAD     FREELO  /SAVE THIS
+       DCA     NASTAD  /START OF ARRAY TABLE
+       TAD     SVCNT   /ALLOCATE
+       CLL RAL         /STRING VAR TABLE
+       TAD     SVCNT
+       TAD     FREELO  /3 WORDS EACH
+       DCA     FREELO
+       TAD     FREELO  /AND SAVE IT FOR THE INT
+       DCA     SSTADR
+       TAD     SACNT   /NOW SPACE FOR STRING
+       CLL RAL         /ARRAY
+       CLL RAL
+       TAD     FREELO  /TABLE
+       DCA     FREELO
+       TAD     FREELO  /SAVE FOR INT
+       DCA     SASTAD
+       CDF     10      /PREPARE TO MOVE
+P3,    TAD I   (SLITRL+1
+       DCA     SLFLD   /STRING LITERALS
+       TAD I   (SLITRL
+       CDF
+       SKP
+SLLOOP,        TAD     TEMP    /IS NEXT LIT THERE ?
+       SNA
+       JMP I   (NOSL   /NO, END OF THE LINE
+       TAD     (-1
+       DCA     X10
+       JMS     SFLD    /SET THE FIELD
+       TAD I   X10     /GET ADDR OF NEXT
+       DCA     TEMP
+P4,    TAD I   X10     /ALSO FIELD
+       DCA     TEMP2
+       TAD I   X10     /THEN CHAR COUNT
+       DCA     NCHARS
+       JMP I   (SLIT2  /DO REST OF STRING LIT
+SFLD,  0
+SLFLD, CDF     10
+       JMP I   SFLD
+
+       PAGE
+\fSLIT2,        TAD     NCHARS  /COMPUTE WORD COUNT
+       TAD     (3
+       CLL RAR
+       TAD     X10     /TO GET ADDR OF SYMBOL NUMBER
+       DCA     TEMP3
+       TAD I   TEMP3
+       CLL RAL         /SYM NUMBER TIMES 3
+       TAD I   TEMP3
+       TAD     SSTADR  /PLUS BASE
+       DCA     X11     /GIVES ST ADDR
+       TAD     NCHARS  /ALLOCATE SPACE FOR IT
+       IAC
+       CLL CML CMA RAR
+       DCA     TEMP3   /(SAVE NUMBER OF WORDS)
+       TAD     TEMP3
+       CLL
+       TAD     FREELO
+       DCA     FREELO  /BELOW THE SYMBOL TABLES
+       SNL
+       JMP     TMSLIT  /TOO MUCH STRING LITERALS
+       TAD     FREELO
+       TAD     (-END-10
+       SZL CLA
+       JMP     TMSLIT  /DITTO
+       TAD     FREELO  /STICK THE ADDR
+       IAC
+       CDF
+       DCA I   X11     /INTO THE ST ENTRY
+       JMS I   (FREEF  /ALSO THE FIELD
+       DCA I   X11
+       TAD     NCHARS  /ALSO THE SIZE
+       CIA
+       DCA I   X11
+       TAD     FREELO  /THIS IS WHERE IT GOES
+       DCA     X11
+       TAD     NCHARS  /PUT IN THE LENGTH TOO
+       CIA             /(NEGATIVE)
+       JMP     .+4
+MOVSL, JMS I   (SFLD
+       TAD I   X10
+       CDF
+       DCA I   X11     /MOVE THE LITERAL TEXT
+       ISZ     TEMP3
+       JMP     MOVSL
+P5,    TAD     TEMP2   /PUT THE FIELD OF THE NEXT
+       DCA I   (SLFLD  /ENTRY WHERE IT DOES THE MOST GOOD
+       JMP I   (SLLOOP /DO THE NEXT LITERAL
+NOSL,  TAD     FREELO  /SAVE TOP OF DATA LIST
+       DCA     DATTOP
+       TAD     DATTOP  /IF EMPTY MAKE TOP=BOTTOM
+       DCA     DATPTR
+       TAD     DLSIZE
+       SNA             /IS ANY DATA ?
+       JMP I   (NODATA /NO
+       CLL
+       TAD     FREELO  /GET START OF DATA
+       DCA     FREELO
+       SNL
+       JMP     TMDATA  /TOO MUCH DATA
+       TAD     FREELO
+       TAD     (-END-10
+       SZL CLA
+       JMP     TMDATA  /DITTO
+       TAD     FREELO  /SAVE IT
+       DCA     DATPTR
+       TAD     FREELO  /USE X13 TO FILL LIST
+       DCA     X13
+       TAD     (DATLST-1
+       DCA     X10
+       CDF     10
+DATLUP,        TAD I   X10     /ANY MORE DATA ELEMENTS ?
+       SNA
+       JMP I   (NODATA
+       DCA     TEMP    /SAVE ADDR
+P8,    TAD I   X10     /GET NEW FIELD
+       DCA     DATAF1
+P9,    TAD     DATAF1  /TWICE
+       DCA     DATAF2
+       TAD     TEMP    /START WITH NEW ELEMENT
+       DCA     X10
+DATAF1,        CDF     10
+       TAD I   TEMP    /GET COUNT
+       DCA     TEMP
+DATMOV,        TAD I   X10     /GET NEXT WORD
+       CDF
+       DCA I   X13     /MOVE INTO DATA AREA
+DATAF2,        CDF     10
+       ISZ     TEMP
+       JMP     DATMOV
+       JMP     DATLUP  /DO NEXT ELEMENT
+TMDATA,        DCA     LINEL   /ZERO LINE NUMBER
+       DCA     LINEH
+       JMS I   (ERMSG  /PRINT ERROR MESSAGE
+       2404
+       JMP I   (ABORTL
+TMSLIT,        DCA     LINEH   /CLEAR THE LINE NUMBER
+       DCA     LINEL
+       JMS I   (ERMSG  /PRINT MESSAGE
+       2423
+       JMP I   (ABORTL
+
+PATLST,        P1;P2;P3;P4;P5;P6;P7;P8;P9;0
+
+       PAGE
+\fALLOCA,       TAD     ACNT    /ANY ARRAYS ?
+       SNA CLA
+       JMP     ALLOCS  /NO
+       TAD     (ARAYST /ALLOCATE ARRAYS
+       DCA     X10
+       TAD     NASTAD
+       DCA     X11
+DOARAY,        CDF     10
+       TAD I   X10     /GET NEXT ARRAY
+       DCA     TEMP
+       TAD I   X10     /GET FIRST DIM
+       SNA
+       TAD     (12     /USE 10 IF NONE
+       IAC             /ALLOCATE 0TH ELEMENT
+       DCA     TEMP2
+       TAD I   X10     /GET SECOND DIM
+       SNA
+       TAD     (12
+       IAC
+       DCA     TEMP3
+       TAD     TEMP3   /GET READY TO SUBTRACT
+       DCA     SUBLO
+       DCA     SUBHI
+       CDF
+       CLL CML RTR
+       AND     TEMP    /HOW MANY DIMS ?
+       SNA CLA
+       JMP     ONLY1   /ONE
+       TAD     TEMP2   /PRODUCT OF DIMS
+       JMS I   (MUL12
+       JMP     TIMES3  /MULT BY 3
+ONLY1, DCA     TEMP3   /ZERO SECOND DIMENSION
+       TAD     TEMP2
+       DCA     SUBLO
+TIMES3,        TAD     (3      /MULT SIZE BY 3
+       JMS I   (MUL12
+       JMS I   (SUB    /SUBTRACT FROM FREE
+       TAD     FREELO
+       DCA I   X11     /SAVE ADDR IN S.T.
+       JMS I   (FREEF
+       DCA I   X11
+       TAD     TEMP2   /ALSO DIMS
+       DCA I   X11
+       TAD     TEMP3
+       DCA I   X11
+       ISZ     X10     /SKIP SYMBOL NUMBER
+       ISZ     ACNT
+       JMP     DOARAY
+ALLOCS,        TAD     SACNT   /ANY STRING ARRAYS
+       SNA CLA
+       JMP I   (RELCIT /NO
+       TAD     (SARYST+1
+       DCA     X10     /ALLOCATE STRING ARRAYS
+       TAD     SASTAD
+       DCA     X11
+DOSARY,        CDF     10
+       TAD I   X10
+       SNA
+       TAD     (12     /USE 10 FOR DIM
+       IAC
+       DCA     TEMP3
+       TAD I   X10     /GET DIM
+       SNA
+       TAD     (10     /USE 16 IF NO SIZE SPEC
+       DCA     TEMP2
+       TAD     TEMP3
+       DCA     SUBLO   /PREPARE FOR MULT
+       DCA     SUBHI
+       CDF
+       TAD     TEMP2   /GET NUM WORDS PER STRING
+       TAD     (3
+       CLL RAR
+       JMS I   (MUL12  /GET ARRAY SIZE
+       JMS I   (SUB    /DO SUBTRACTION
+       TAD     FREELO  /SAVE ADDR
+       DCA I   X11
+       JMS I   (FREEF
+       DCA I   X11
+       TAD     TEMP2   /AND STRING SIZE
+       CIA             /(SIZES ARE NEG)
+       DCA I   X11
+       TAD     TEMP3   /AND NUMBER OF STRINGS
+       DCA I   X11
+       ISZ     X10     /SKIP NEXT NAME
+       ISZ     X10     /AND NEXT SYM NUMBER
+       ISZ     SACNT
+       JMP     DOSARY
+       JMP I   (RELCIT
+INWORD,        0               /READ FROM CODE FILE
+       ISZ     ICOUNT  /ANYTHING IN BUFFER
+       JMP     NOREAD  /YASSUH!
+       JMS I   (7607   /READ NEXT BLOCK
+       200
+       1000            /NOTE: THIS OVERLAYS USED CODE
+INBLOK,        0
+       JMP I   (IOERR
+       ISZ     INBLOK  /BUMP BLOCK COUNTER
+       TAD     INBLOK-1/RESET BUFFER POINTER
+       DCA     INPTR
+       TAD     (-400   /AND COUNTER
+       DCA     ICOUNT
+NOREAD,        TAD I   INPTR   /GET WORD
+       ISZ     INPTR   /BUMP POINTER
+       JMP I   INWORD
+INPTR, 0
+
+CIPAT, 0       /PATCH TO MAKECI
+       TAD     (1000
+       DCA I   (JSW    /CHANGE JSW
+COPT,  DCA I   (CISTRT+1       /& TAKE CARE OF /C
+       JMP I CIPAT
+
+       PAGE
+\fRELCIT,       TAD     LOCTRL  /FIND START OF CODE
+       CLL IAC
+       DCA     SUBLO   /BY SUBTRACTING
+       RAL
+       TAD     LOCTRH  /AMOUNT FROM FREE
+       DCA     SUBHI
+       JMS I   (SUB
+       TAD     FREELO  /THIS IS THE START OF THE CODE
+       DCA     CODBGN  /MINUS ONE
+       TAD     FREEHI  /THIS IS THE FIELD NUMBER
+       DCA     CODCDF
+       TAD     LOCTRL  /SET UP PROG SIZE COUNT
+       CLL CML CIA
+       DCA     CODSZ1  /LOWER COUNT
+       RAL
+       TAD     LOCTRH
+       CIA
+       DCA     CODSZ2  /UPPER COUNT
+       TAD     BLOCK   /SET UP FOR READ AND WRITE
+       DCA I   (OUBLOK
+       TAD     BLOCK
+       DCA I   (INBLOK
+       TAD     (-401
+       DCA     OCOUNT
+       CLA CMA
+       DCA     ICOUNT
+RELOOP,        JMS I   (INWORD /GET A WORD OF CODE
+       DCA     TEMP
+       TAD     (3000
+       TAD     TEMP    /CHECK FOR OPCODE 5000 (GOTO)
+       AND     (7000
+       SZA CLA
+       JMP     NORELC  /NO JUMP
+       TAD     TEMP    /REMOVE FIELD BITS
+       AND     (340
+       CLL RTR
+       TAD     CDF0
+       DCA     LBLFLD  /FIELD OF LABEL ENTRY
+       TAD     TEMP    /ZERO FIELD BITS
+       AND     (7437
+       DCA     TEMP
+       JMS I   (INWORD /GET REST OF ADDR
+       DCA     TEMP2
+       JMS I   (CHKLBL /CHECK FOR UNDEFINED LABEL
+LBLFLD,        HLT
+       TAD I   TEMP2
+       AND     (7      /GET ADDR TO BE RELOCATED
+       DCA     LOCHI
+       ISZ     TEMP2
+       TAD I   TEMP2
+       CLL
+       TAD     CODBGN  /ADD BASE ADDR
+CDF0,  CDF
+       DCA     LOCLO   /SAVE LOW PART OF JUMP
+       RAL
+       TAD     CODCDF  /GET HIGH PART
+       TAD     LOCHI
+       CLL RTL         /PUT IT INTO CORRECT PLACE
+       RTL
+       RAL
+       TAD     TEMP    /PLUS INSTRUCTION
+       JMS I   (OUTWRD
+       ISZ     CODSZ1  /BUMP COUNTER
+       SKP
+       ISZ     CODSZ2  /CAN'T BE LAST WORD
+       TAD     LOCLO   /OUTPUT LOW ORDER ADDR
+       SKP
+NORELC,        TAD     TEMP    /JUST OUTPUT IT
+RELOUT,        JMS I   (OUTWRD
+       ISZ     CODSZ1  /DOUBLE WORD ISZ BUMP
+       JMP     RELOOP
+       ISZ     CODSZ2
+       JMP     RELOOP
+       JMP I   (LOADIT /DONE RELOCATING, GO LOAD
+
+       /PRINT ERROR MESSAGE
+
+ERMSG, 0               /PRINT ERROR MESSAGE
+       CDF
+       TAD I   ERMSG   /GET CODE
+       CLL RTR         /PRINT FIRST CHAR
+       RTR
+       RTR
+       JMS     TTY
+       TAD I   ERMSG   /PRINT SECOND CHAR
+       JMS     TTY
+       ISZ     ERMSG   /FIX RETURN ADDR
+       TAD     (240    /PRINT SPACE
+       JMS     TTY
+       DCA     TTY     /USE TTY AS A SWITCH
+       TAD     LINEH   /PRINT HIGH ORDER
+       JMS I   (PSN
+       TAD     LINEL   /THEN LOW ORDER
+       JMS I   (PSN    /(LINE NUMBER NATCH !)
+       TAD     (215    /PRINT CARRIAGE RETURN
+       JMS I   (TTX
+       TAD     (212    /PRINT LINE FEED
+       JMS I   (TTX
+       JMP I   ERMSG   /RETURN
+
+TTY,   0               /CONVERT TO ASCII AND PRINT
+       TAD     (240
+       AND     (77
+       TAD     (240
+       JMS I   (TTX    /PRINT CHAR
+       JMP I   TTY     /RETURN
+
+       PAGE
+\fLOADIT,       JMS I   (OUDUMP /DUMP LAST BLOCK
+       TAD     LOCTRL  /SET UP COUNTER
+       CIA CLL CML
+       DCA     CODSZ1
+       RAL
+       TAD     LOCTRH
+       CIA
+       DCA     CODSZ2
+       TAD     CODBGN
+       DCA     TEMP    /CODE BEGIN -1
+       TAD     BLOCK   /SET UP BLOCK NUMBER
+       DCA I   (INBLOK
+       CLA CMA
+       DCA     ICOUNT
+       TAD     CODCDF  /SET UP CODE CDF
+       CLL RTL
+       RAL
+       TAD     (6201
+       DCA     CODCDF
+       TAD     CODCDF
+       DCA     CF
+LODLUP,        ISZ     TEMP    /BUMP POINTER
+       JMP     NOFJMP  /FIELD IS OK
+       TAD     CF      /BUMP THE FIELD
+       TAD     (10
+       DCA     CF
+NOFJMP,        JMS I   (INWORD /GET NEXT WORD
+CF,    HLT
+       DCA I   TEMP    /SAVE THE WORD
+CDFZER,        CDF
+       ISZ     CODSZ1  /MORE CODE ?
+       JMP     LODLUP  /YES
+       ISZ     CODSZ2
+       JMP     LODLUP  /YES
+       TAD     CF      /GET THE FIELD
+       DCA     CLEARF  /AND SAVE IT
+CLRLUP,        TAD     CLREND  /IS THIS THE END OF CLEAR ?
+       TAD     TEMP
+       SZA CLA
+       JMP     MORCLR  /NO, KEEP GOING
+       TAD     CLRFLD  /DO FIELDS MATCH ?
+       TAD     CLEARF
+       SNA CLA
+       JMP     DONCLR  /YES, ARRAYS ARE CLEARED
+MORCLR,        ISZ     TEMP    /BUMP POINTER
+       JMP     CLEARF  /DON'T BUMP FIELD
+       TAD     CLEARF  /DO BUMP FIELD
+       TAD     (10
+       DCA     CLEARF
+CLEARF,        HLT
+       DCA I   TEMP    /CLEAR THE WORD
+       JMP     CLRLUP  /DO MORE
+DONCLR,        TAD     CLEARF  /COPY THE FIELD
+       DCA     STFLDM
+       TAD     TEMP    /GET THE COUNT
+       TAD     RESADR  /OF HOW MUCH SYMBOL TABLE
+       DCA     TEMP2   /TO MOVE
+       TAD     TEMP    /PUT IT INTO AUTO XR'S
+       DCA     X13
+       TAD     X13
+       DCA     X11
+MOVSTL,        CDF
+       TAD I   X11     /GET NEXT WORD OF ST
+STFLDM,        HLT
+       DCA I   X13     /STORE IT
+       ISZ     TEMP2
+       JMP     MOVSTL
+       JMS     MOVFIN  /MOVE FINI PAGE INTO 7000-7177
+       JMP I   (7000   /GO READ BRTS.SV
+\fCHKLBL,       0               /CHECK LABEL FOR UNDEF
+       TAD I   CHKLBL  /GET FIELD
+       DCA     .+1
+       HLT
+       TAD I   TEMP2   /GET FIRST WORD OF LABEL
+       SPA CLA
+       JMP I   CHKLBL  /SIGN BIT IS DEFINED
+       CLL CMA RAL     /GET ADDR OF LINE NUM
+       TAD     TEMP2
+       DCA     XLABEL
+       TAD I   XLABEL  /GET HIGH ORDER LINE
+       DCA     LINEH
+       ISZ     XLABEL
+       TAD I   XLABEL  /GET LOW ORDER
+       DCA     LINEL
+       CDF
+       JMS I   (ERMSG  /PRINT MESSAGE
+       2523
+       JMP I   CHKLBL  /RETURN
+
+FREEF, 0               /MAKE A CDF FROM FREEHI
+       TAD     FREEHI
+       CLL RTL
+       RAL
+       TAD     CDFZER
+       JMP I   FREEF
+
+ABORTL,        JMS     MOVFIN  /PUT FINI PAGE INTO 7000-7177
+                       /AND ABORT THE RUN
+       JMP I   (ABORT-FINI+7000
+
+MOVFIN,        0               /FINI PAGE MOVER
+       CDF
+       TAD     (FINI-1 /MOVE INT READING CODE
+       DCA     X10
+       TAD     (6777   /INTO 7000
+       DCA     X11
+       TAD     (-200
+       DCA     TEMP    /PUT CORRECT COUNT HERE
+       TAD I   X10
+       DCA I   X11     /MOVE CODE
+       ISZ     TEMP
+       JMP     .-3
+       JMP I   MOVFIN
+
+       PAGE
+\fFINI, TAD I   XERMSG  /ANY ERRORS ?
+       SZA CLA
+       JMP     ABORT   /YES, DON'T RUN IT
+       TAD     XINT    /MOVE INT STUFF
+       DCA     FTEMP
+       TAD     M12     /10 KEY LOCATIONS
+       DCA     FCNT
+       TAD     XSAVE   /INTO A SAFE PLACE
+       DCA     FTEMP2
+       TAD I   FTEMP
+       ISZ     FTEMP
+       DCA I   FTEMP2
+       ISZ     FTEMP2
+       ISZ     FCNT
+       JMP     .-5     /MOVE LOOP
+       TAD     BRTS    /READ IN BRTS
+       DCA     BRTSB
+       JMS I   X7607
+       BRTSIZ
+       0
+BRTSB, 0
+       JMP     IOERR
+       TAD     XSAVE
+       DCA     FTEMP
+       TAD     XINT    /MOVE STUFF BACK
+       DCA     FTEMP2
+       TAD I   FTEMP
+       ISZ     FTEMP
+       DCA I   FTEMP2
+       ISZ     FTEMP2
+       ISZ     M12
+       JMP     .-5
+       TAD     (JMP I FSTOP1   /PATCH ^C LOCATIONS
+       DCA I   (7600
+       TAD     (JMP I FSTOP1
+       DCA I   (7605
+       JMP I   (BRTBGN /GO START BRTS
+
+M12,   -12
+XINT,  20
+XERMSG,        ERMSG
+X7607, 7607
+XSAVE, 7001+XSAVE-FINI
+
+MUL12, 0               /MULTIPLY 12BITS AND 24 BITS
+       DCA     AC3     /SAVE 12 BIT THING
+       DCA     AC2     /CLEAR REST OF AC
+       DCA     AC1
+       TAD     (-15    /ONLY TEST 12 BITS
+       DCA     SC
+       JMP     MULBGN
+MULLUP,        SNL             /WAS BIT ON ?
+       JMP     NOADD   /NO, DON'T ADD
+       TAD     SUBLO   /ADD TO HIGH ORDER 2/3'S OF AC
+       TAD     AC2
+       DCA     AC2
+       CML RAL
+       TAD     SUBHI
+NOADD, TAD     AC1     /SHIFT AC RIGHT
+       CLL RAR
+       DCA     AC1
+       TAD     AC2
+       RAR
+       DCA     AC2
+MULBGN,        TAD     AC3
+FTEMP, RAR
+FTEMP2,        DCA     AC3
+FCNT,  ISZ     SC      /BUMP SHIFT COUNTER
+       JMP     MULLUP
+       TAD     AC2     /ANSWER IS LOWER 2/3'S OF AC
+       DCA     SUBHI
+       TAD     AC3
+       DCA     SUBLO
+       JMP I   MUL12
+
+IOERR, DCA     LINEL   /ZERO LINE NUMBER
+       JMS I   XERMSG  /PRINT MESSAGE
+       1117
+ABORT, JMS I   (SWAP   /SWAP OS8 BACK
+       JMS I (200      /CHECK OUT W/ CI BUILDER
+       TAD     (4207   /RESTORE ^C LOCATIONS
+       DCA I   (7600
+       TAD     (6213
+       DCA I   (7605
+       TAD     ABORTX  /CALLED VIA CHAIN ?(FROM EDIT)
+       SNA
+       JMP I   (7600   /NO, RETURN TO OS8
+       DCA     EDTBLK  /YES, SAVE EDITOR START
+       JMS I   X7607   /READ IN EDITOR
+       EDTSIZ          /THIS MUCH
+       0
+OWTEMP,
+EDTBLK,        0
+       JMP I   (7605   /ERROR
+       JMP I   (EDTBGN /GO START EDITOR
+
+OUTWRD,        0               /OUTPUT WORD TO TEMP FILE
+       ISZ     OCOUNT  /ANY ROOM ?
+       JMP     NOWRIT  /YES
+       DCA     OWTEMP  /SAVE WORD
+       JMS     OUDUMP  /WRITE BLOCK
+       ISZ     OUBLOK  /BUMP BLOCK NUMBER
+       TAD     OUBLOK-1/RESET BUFFET POINTER
+       DCA     OUPTR
+       TAD     (-400
+       DCA     OCOUNT  /AND COUNT
+       TAD     OWTEMP  /RESTORE AC
+NOWRIT,        CDF     10
+       DCA I   OUPTR   /INTO BUFFER
+       CDF
+       ISZ     OUPTR
+       JMP I   OUTWRD
+OUPTR, 0
+OUDUMP,        0               /WRITE BLOCK
+       JMS I   X7607   /WRITE BLOCK
+       4210
+       0
+OUBLOK,        0
+       JMP     IOERR
+       JMP I   OUDUMP
+
+       END=FINI+200
+
+       PAGE
+\f      BLDCI=200       /PAGE INTO WHICH MAKECI GETS MOVED
+       LOADBL=357      /LOC WHERE BCOMP LEAVES BLOAD BLOCK #
+
+IMAGE, 0
+       TAD I   (LOADBL /COME HERE TO CREATE CORE IMAGE
+       TAD     (6              /ALREADY HAVE THIS MUCH
+       DCA I   (LDRBLK /INIT BLOAD OVRLY READER
+       CDF 10
+       TAD I   (7644   /TEST FOR /V
+       CDF
+       AND     (4
+       SZA CLA
+       JMS I   (VERNUM
+       CDF 10
+       TAD I   (7643   /GET OPTION BITS
+       CDF
+       DCA     TEMP
+       TAD     TEMP
+       RTR
+       SNL CLA         /HAVE K OPTION?
+       JMP     LSTART  /NO: START LOADER
+       TAD     TEMP
+       RTL
+       SZL CLA         /HAVE B OPTION?
+       DCA I   (FLGRTS /YES: FLAG IT
+       TAD     TEMP    /TEST FOR /C
+       RTL
+       SPA CLA
+       JMP     .+3
+       TAD     (NOP
+       DCA I   (COPT
+       CDF 10
+       TAD I   (7646   /GET =N
+       CDF
+       AND (7          /WIPE ALT MODE
+       SNA
+       CLL CML RTL     /DEFAULT=12K FOR NOW
+       DCA     TEMP
+       CLL CMA
+       TAD     TEMP    /MUST BE >1 HERE
+       SNA CLA
+       ISZ     TEMP
+       TAD     TEMP
+       CLL CMA
+       TAD     HIFLD
+       SNL CLA         /WHICH HAS MORE CORE?
+       JMP     .+3             /TARGET MACHINE: TOUGH
+       TAD     TEMP    /HOST MACHINE
+       DCA     HIFLD   /FAKE OUT LOADER
+       TAD     HIFLD
+       CIA
+       DCA I   (FLDCNT /INIT CI BUILDER
+       TAD I   (FLDCNT
+       DCA I   (MYCORE /AND CI STARTER
+       CDF 10
+       DCA I   (7646   /CLEAR =N BITS
+       DCA I   (7643   /AND EARLY OPTIONS
+       TAD I   (7644   /GET OPTION BITS
+       CDF
+       RTL
+       SZL CLA         /HAVE N SWITCH?
+       JMP     NOTDSY  /NEVER SEES TD8E SYSTEM
+       TAD     HIFLD
+       CLL RAR
+       SNA CLA         /HAVE OVER 8K CORE?
+       JMP     NOTDSY
+       TAD     (NOP
+       DCA I   (GOTTD  /YES: FORCE SYS=TD8E
+       CDF 10          /THE QUESTION IS,
+       TAD I   (DCB    /WAS IT A LITTLE WHITE ONE
+       AND (770        /OR NOT?
+       TAD     (-210
+       CDF
+       SNA CLA
+       TAD I   (7612
+       TAD     (-3
+       SNA CLA
+       JMP     .+3             /IT WAS TRUTH!
+       TAD     (SWAP-LOADER+5600
+       DCA I   (TDLIE  /LIES: MUST LIE TO SWAPPER ALSO
+       CLA IAC
+NOTDSY,        DCA I   (TDFLAG /NOT 0 MEANS HAVE TD8E
+       CMA
+       DCA I   (ERMSG  /FORCE LOAD ABORT
+LSTART,        TAD     (BLDCI-1        /MOVE CI BUILDER
+       DCA     X10             /INTO LOW CORE
+       TAD     (MAKECI-1
+       DCA     X11
+       TAD I   X11
+       DCA I   X10
+       ISZ     ICTR
+       JMP     .-3
+       TAD     HIFLD   /START OF BLOAD V1
+       DCA     FREEHI
+       JMP I   IMAGE   /RETURN TO LOADER
+
+ICTR,  -200
+CCLIST,        0               /1ST 4 WORDS OF CCB
+       6203
+       CISTRT
+       1000            /JOB STATUS WORD
+
+       PAGE
+\f      CCB=1000        /LOC TO START BUILDING CCB
+
+MAKECI,        0               /THIS PAGE GETS MOVED!
+       TSF
+       JMP     .-1             /SEE TAG "ABORT" IN BLOAD V1
+       ISZ I   (ERMSG  /WHY ARE WE HERE?
+       JMP     BOSFIX  /GENUINE ABORTION
+       TAD     (CCB-1
+       DCA     X10
+       TAD     (CCLIST-1
+       DCA     X11
+       TAD I   X11     /1ST FOUR WORDS OF CCB
+       DCA I   X10
+       ISZ     MKCCNT
+       JMP     .-3
+CCSEGS,        TAD     FLDCNT
+       CLL CIA RAL
+       RTL             /THIS FIELD
+       DCA     TEMP
+       TAD     (70
+       AND     CODCDF  /LOWEST FIELD USED
+       CLL CIA
+       TAD     TEMP
+       SNL             /THIS FIELD USED?
+       JMP     NOCODE  /NO: BYPASS IT
+       SZA CLA         /IS IT FULL?
+       JMP     ALLCODE /YES
+       TAD     CODBGN  /PROBABLY NOT
+       AND     (7400
+       DCA     TEMP2
+       TAD     TEMP2
+       CIA
+       CLL RAR
+       TAD     TEMP
+       DCA     TEMP
+       TAD     TEMP2
+ALLCODE,DCA I  X10
+       TAD     FLDCNT
+       IAC
+       TAD     TDFLAG
+       SMA CLA         /NEED TOP PAGE?
+       TAD     (3700   /NO: 37 PAGES
+       TAD     TEMP    /YES: 40 PAGES
+       AND     K3777
+       DCA I   X10
+       ISZ I   (CCB
+NOCODE,        CLA CLL
+       ISZ     FLDCNT  /NEXT FIELD ZERO?
+       JMP     CCSEGS  /NO: LOOP
+       TAD     FLGRTS
+       SZA CLA         /NEED BRTS?
+       TAD     (CISTRT
+       DCA I   X10
+       TAD     FLGRTS
+       SZA CLA
+       TAD     (200-3700
+       TAD     (3700
+       DCA I   X10
+       TAD I   (CCB
+       CMA
+       DCA I   (CCB            /NEGATE SEG COUNT
+       JMS I   (7607   /READ CI STARTER
+KP200, 200             /FROM END OF BLOAD.SV
+       CISTRT          /INTO HI CORE
+LDRBLK,        0               /INIT BY "IMAGE"
+BOSPT1,        7600            /CAN'T GET THIS ERROR
+       JMS I   JCIP
+       TAD     TDFLAG  /PASS TD8E FLAG
+       DCA I   (FLAGTD
+       TAD     FLGRTS
+       DCA I   (RTSFLG /AND BRTS FLAG
+       TAD     MYCORE
+       DCA I   (NOCORE /AND CORE LIMIT
+       TAD     (17             /SAVE 10 KEY LOCATIONS
+       DCA     X10
+       TAD     (KEYLOC-1
+       DCA     X11
+       TAD I   X10
+       DCA I   X11
+       ISZ     MCICNT
+       JMP     .-3
+       JMS I   (7607   /CALL SYS HANDLER
+       4200            /TO WRITE CCB
+       CCB-200         /(AND PRECEDING PG)
+       37              /INTO SCRATCH BLOCK
+K3777, 3777            /CAN'T GET THIS ERROR
+       JMP I   (EXEUIT
+
+MKCCNT,        -4
+MCICNT,        -12
+FLDCNT,        -7
+TDFLAG,        1               /0 MEANS TD8E IS DEATH AT RT
+FLGRTS,        -1              /0 MEANS INCL BRTS IN CI
+
+BOSFIX,        TAD I   (BIPCCL
+       RAL
+       SMA CLA
+       JMP I   MAKECI  /BATCH NOT RUNNING
+       TAD I   (7777
+       AND     (70
+       TAD     CDFZRO
+       DCA     BOSCDF  /CDF TO BATCH FIELD
+BOSLUP,        CDF 10
+       TAD I   BOSPT1  /GET BATCH WRDS
+BOSCDF,        CDF 10
+       DCA I   BOSPT2  /BACK INTO POSITION
+CDFZRO,        CDF
+       ISZ     BOSPT1
+       ISZ     BOSPT2
+       JMP     BOSLUP
+       JMP I   MAKECI
+
+BOSPT2,        7774
+MYCORE,        0
+JCIP,  CIPAT
+
+       PAGE
+\fVERNUM,       0
+       TAD     (VTEXT
+       DCA     TEMP
+MOREV, TAD I   TEMP
+       SNA
+       JMP     VOUT
+       CLL RTR
+       RTR
+       RTR
+       JMS I   (TTY
+       TAD I TEMP
+       JMS I   (TTY
+       ISZ     TEMP
+       JMP     MOREV
+VOUT,  TAD     (215
+       JMS I   (TTX
+       TAD     (212
+       JMS I   (TTX
+       JMP I   VERNUM
+
+VTEXT, TEXT    /BLOAD  V/
+       *.-1
+VERLOC,        100^VERSON+6001
+       0
+
+       PAGE
+\f      *7000
+       BSTART=200      /START ADDR FOR BRTS
+CISTRT,        SKP             /RUNNED
+       JMP CHAIN       /CHAINED
+       TAD (7603
+       DCA X10
+       TAD (NAMLST-1
+       DCA X11
+       CDF     10
+       DCA I   X10     /ZERO EDITOR
+       DCA I   X10     /COMPILER
+       DCA I   X10     /AND LOADER BLOCK #S
+       CDF
+       CIF 10
+       JMS I (7700
+       10              /USRIN
+FINDSV,        TAD I   X11     /LOOKUP SOME SAVE FILES
+       SNA
+       JMP     LUBUF   /GO LOOK FOR BASIC.UF
+       DCA     XXXXSV  /SAVE POINTER TO NAME
+       CLA IAC         /THEY'RE ON SYS
+       CIF     10
+       JMS I   (200
+       2
+XXXXSV,        0
+       0
+       JMS I   (ERRORX /ERROR
+       TAD     XXXXSV  /GET STARTING BLOCK
+       IAC             /PLUS 1
+       CDF     10
+       DCA I   X10     /INTO INFO AREA
+       CDF
+       JMP     FINDSV  /LOOP
+LUBUF, CLA IAC
+       CIF     10
+       JMS I   (200    /LOOKUP BASIC.UF
+       2
+       BUFN            /(USER DEFINED FUNCTIONS)
+       0
+       JMP     .+3     /OK IF NOT THERE
+       TAD     .-3     /GET STARTING BLOCK +1
+       IAC
+       CDF     10
+       DCA I   X10     /INTO INFO BLOCK
+       CDF 0
+       CIF 10
+       JMS I   (200
+       11              /USR OUT
+CHAIN, CDF 10
+       TAD I (7607     /GET BRTS STARTING BLK
+       CDF
+       DCA I   (BRTSST /INTO RTS READER
+       JMP I   (BINIT
+
+NAMLST,        BRTSN
+       BAFN
+       BSFN
+       BFFN
+       0
+BRTSN, FILENAME BRTS.SV
+BAFN,  FILENAME BASIC.AF
+BSFN,  FILENAME BASIC.SF
+BFFN,  FILENAME BASIC.FF
+BUFN,  FILENAME BASIC.UF
+\fCORE, 0
+       TAD I   (BIPCCL
+       AND COR70
+       CLL RAR
+       RTR
+       SZA             /IS THERE A SYSTEM VALUE?
+       JMP I CORE      /YES: USE IT
+COR0,  CDF
+       TAD     CORSIZ
+       RTL
+       RAL
+       AND     COR70
+       TAD     COREX
+       DCA     .+1
+COR1,  CDF
+       TAD I   CORLOC
+COR2,  NOP
+       DCA     COR1
+       TAD     COR2
+       DCA I   CORLOC
+COR70, 70
+       TAD I   CORLOC
+CORX,  7400
+       TAD     CORX
+       TAD     CORV
+       SZA CLA
+       JMP     COREX
+       TAD     COR1
+       DCA I   CORLOC
+       ISZ     CORSIZ
+       JMP     COR0
+COREX, CDF
+       CLA CMA         /HI FIELD IS #FIELDS-1
+       TAD     CORSIZ
+       JMP I CORE
+CORLOC,        CORX
+CORV,  1400
+CORSIZ,        1
+
+       PAGE
+\fGETRTS,       0               /READ BRTS INTO 0-6777
+       TAD BRTS
+       DCA BRTSBB
+       JMS I (7607
+       BRTSIZ
+       0
+BRTSBB,        0
+NOCORE,        -1              /CAN'T GET THIS ERROR
+       JMP I GETRTS
+BINIT, ISZ RTSFLG      /NEED BRTS?
+       JMP BRTSIN      /GOT IT: START IT
+       JMS I   (7607
+       BRTSIZ
+       0
+BRTSST,        0
+SR2,   20              /CAN'T GET THIS ERROR
+BRTSIN,        CDF     10      /WHAT ARE WE RUNNING ON?
+       ISZ EKOUNT
+       TAD I   (DCB    /CHECK FOR TD8E SYSTEM
+       AND     (770    /ED FRIEDMAN GAVE ME THIS CODE
+       TAD     (-210   /AND I'M TAKING IT ON FAITH
+       CDF
+       SNA CLA
+       TAD I   (7642   /IS IT A ROM SYSTEM ?
+       TAD     (-6223
+       SZA CLA
+       JMP PSADJ       /NO TD/8E OR ELSE ROM TD/8E
+       TAD FLAGTD
+       SNA CLA         /IMAGE OK ON TD8E?
+       JMS ERRORX      /NO: DONT RUN IT
+       TAD KEYLOC
+       DCA CDFTOP
+SWPLOOP,CDF 20
+       TAD I TDCTR
+       DCA GETRTS
+CDFTOP,        CDF     70
+       TAD I TDCTR
+       DCA ERRORX
+       TAD GETRTS
+       DCA I TDCTR
+       CDF 20
+       TAD ERRORX
+       DCA I TDCTR
+       ISZ TDCTR
+       JMP SWPLOOP
+       CDF
+       CLL CML RTL
+       TAD CDFTOP      /PATCH MONITOR FIELD STUFF
+       DCA I   (7642   /CDF CIF HI CORE
+       IAC
+       TAD CDFTOP
+       DCA I   (7721   /CIF HI CORE
+       TAD I   (7721
+       DCA  I  (7727
+CCHEK, ISZ EKOUNT
+       JMS I   (CORE   /HOW MUCH CORE DO WE HAVE?
+       TAD NOCORE      /HOW MUCH DO WE NEED?
+       SPA CLA
+       JMS ERRORX      /INSUFFICIENT CORE
+       TAD I SR1       /RESTORE KEY LOCATIONS
+       DCA I SR2
+       ISZ SR1
+       ISZ SR2
+       ISZ SR3
+       JMP .-5
+       TAD (JMP I FSTOP1       /PATCH CTRL/C LOCS
+       DCA I (7600
+       TAD (JMP I FSTOP1
+       DCA I (7605
+       TAD     SWPINF  /TELL BRTS OS/8 PG 17600 OUT NOW
+       RAR
+       STL RAL
+       DCA     SWPINF
+       JMP I   (BSTART /START BRTS
+
+ERRORX,        0
+       CIF 10
+       JMS I (7700
+       7
+EKOUNT,        1
+       JMP I   (7605
+
+EXEUIT,        TAD RTSFLG
+       SNA CLA         /NEED BRTS?
+       JMS GETRTS      /YES: READ IT
+       TAD (4207       /RESTORE ^C HOOKS
+       DCA I (7600
+       TAD (6213
+       DCA I (7605
+       JMP I (7600     /BACK TO OS8
+KEYLOC,        ZBLOCK 12
+SR1,   KEYLOC
+SR3,   -12
+RTSFLG,        -1              /0 MEANS BRTS IS IN CORE
+FLAGTD,        1               /1 IF TD8E IS OK AT RUNTIME
+PSADJ, TAD (4001
+       AND KEYLOC+11
+       TAD (2000
+       DCA KEYLOC+11
+       JMP CCHEK
+TDCTR, 7600
+
+       PAGE
+       $$$$$
+\f