File: BLOAD.PA of Tape: OS8/OS8-V3D/al-4760c-sa-os8-ext-2
(Source file text)
/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. / / / / / / /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 /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 /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 SWAP, 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 NODATA, 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 / 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 SLIT2, 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 ALLOCA, 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 RELCIT, 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 LOADIT, 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 CHKLBL, 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 FINI, 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 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 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 VERNUM, 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 *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 CORE, 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 GETRTS, 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 $$$$$