File: BLOAD.03 of Tape: OS8/OS8-V3/dec-s8-uextb-a-ua1
(Source file text)
/OS8 BASIC LOADER, V3 / / / / / / / / / /COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION / / / / / / / / / / /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT /CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY /FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL. / /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. / /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY /DIGITAL. / / / / / / / / / / /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=300 / OS8 BASIC COMPILER POST PROCESSOR X10=10 X11=11 X13=13 STACK=15 STCDF=20 /KEY INTERPRETER LOCATIONS NSTADR=STCDF+1 NASTAD=NSTADR+1 SSTADR=NASTAD+1 SASTAD=SSTADR+1 CODCDF=SASTAD+1 CODBGN=CODCDF+1 DATTOP=CODBGN+1 DATPTR=DATTOP+1 SWPINF=DATPTR+1 VARCNT=40 /LOCATIONS DEFINED BY COMPILER SVCNT=VARCNT+1 ACNT=SVCNT+1 SACNT=ACNT+1 LOCTRH=SACNT+1 LOCTRL=LOCTRH+1 BLOCK=LOCTRL+1 HIFLD=BLOCK+1 BRTS=HIFLD+1 DLSIZE=BRTS+1 ABORTX=DLSIZE+1 FREEHI=ABORTX+1 /LOCATIONS USED BY RELOCATION CODE FREELO=FREEHI+1 TEMP=FREELO+1 TEMP2=TEMP+1 TEMP3=TEMP2+1 WORD1=TEMP3+1 WORD2=WORD1+1 WORD3=WORD2+1 NCHARS=WORD3+1 SUBHI=NCHARS+1 SUBLO=SUBHI+1 CODSZ1=SUBLO+1 CODSZ2=CODSZ1+1 LOCHI=CODSZ2+1 LOCLO=LOCHI+1 CODB=LOCLO+1 CODF=CODB+1 ICOUNT=CODF+1 OCOUNT=ICOUNT+1 AC1=OCOUNT+1 AC2=AC1+1 AC3=AC2+1 SC=AC3+1 LINEH=SC+1 LINEL=LINEH+1 XLABEL=LINEL+1 CLRFLD=XLABEL+1 CLREND=CLRFLD+1 RESADR=CLREND+1 SVARST=1036 /MORE COMPILER DEFINITIONS ARAYST=2132 SARYST=2332 STEMPS=2560 LITRL=STEMPS+2 SLITRL=LITRL+2 DATLST=SLITRL+2 STACKA=7120 /MAIN STACK OF COMPILER EDTBGN=3012 /START OF EDITOR EDTSIZ=1700 /SIZE OF EDITOR BRTBGN=200 /START OF BRTS BRTSIZ=3400 /SIZE OF BRTS DCB=7760 *400 LOADER, JMP I .+1 /CORE IMAGE FILE PATCH... IMAGE TAD (7577 /EXECUTION RESUMES HERE DCA FREELO DCA SWPINF /CLEAR SWAPPER WORD DCA LINEH /CLEAR LINE NUMBER DCA LINEL TAD STACK /ANY UNCLOSED FOR'S ? CIA TAD (STACKA-1 SNA CLA JMP .+3 /NO JMS 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 STSTUF DCA TEMP TAD (7410 /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 7642 /IS IT A ROM SYSTEM ? TAD (-6223 SZA CLA GOTTD, JMP NOTD8E /NO TD/8E OR ROM TD/8E TAD (7377 /TD8E SYS WASTES 400 WORDS DCA FREELO CLL CML RAR /SET SWAP INFO NOTD8E, IAC DCA SWPINF JMS FREEF /GET CDF TO HIGHEST FIELD DCA SWPF1 /INTO 2 PLACES TAD SWPF1 DCA SWPF2 JMS SWAP /MOVE OS8 OUT ISZ SWPFLAG JMP 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 7642 TAD SWPF1 IAC /CIF N0 DCA 7721 TAD 7721 DCA 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 TAD SWPFLAG /WHICH WAY ? SZA CLA JMP SWPF2 /PUT OS8 BACK SWP1, HLT TAD I TEMP2 /GET PART OF RESIDENT SWPF1, JMP SWPRET /RETURN IF 8K ONLY DCA I TEMP /INTO HI FIELD ISZ TEMP /BUMP POINTER ISZ TEMP2 /AND PTR/CTR JMP SWP1 /LOOP CDF JMP I SWPSUB SWPF2, JMP I SWAP /IF 8K JUST RETURN TAD I TEMP /GET WORD OF HI FIELD SWP2, HLT DCA I TEMP2 /BACK WHERE IT BELONGS ISZ TEMP ISZ TEMP2 JMP SWPF2 CDF TAD L6221 /SET UP TO FIX FIELD 0 CDFS DCA SWPF1 JMP I SWPSUB PAGE NODATA, CDF JMS 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 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 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 TTY /ANY DIGITS YET ? SNA CLA JMP LEAD0 /NO, ITS A LEADING ZERO NOZERO, TAD (60 /MAKE IT ASCII JMS 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 ERMSG /WRITE MESSAGE 2402 /TOO BIG JMP ABORTL /ABORT RUN TTX, 0 /PRINT CHAR ON TTY TSF /WAIT FOR PREVIOUS CHAR JMP .-1 TLS /PRINT THIS ONE CLA JMP I TTX / 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" . PAGE 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 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 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 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 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 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 SLFLD /ENTRY WHERE IT DOES THE MOST GOOD JMP 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 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 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 ERMSG /PRINT ERROR MESSAGE 2404 JMP ABORTL TMSLIT, DCA LINEH /CLEAR THE LINE NUMBER DCA LINEL JMS ERMSG /PRINT MESSAGE 2423 JMP 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 MUL12 JMP TIMES3 /MULT BY 3 ONLY1, DCA TEMP3 /ZERO SECOND DIMENSION TAD TEMP2 DCA SUBLO TIMES3, TAD (3 /MULT SIZE BY 3 JMS MUL12 JMS SUB /SUBTRACT FROM FREE TAD FREELO DCA I X11 /SAVE ADDR IN S.T. JMS 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 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 MUL12 /GET ARRAY SIZE JMS SUB /DO SUBTRACTION TAD FREELO /SAVE ADDR DCA I X11 JMS 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 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 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 PAGE RELCIT, TAD LOCTRL /FIND START OF CODE CLL IAC DCA SUBLO /BY SUBTRACTING RAL TAD LOCTRH /AMOUNT FROM FREE DCA SUBHI JMS 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 OUBLOK TAD BLOCK DCA INBLOK TAD (-401 DCA OCOUNT CLA CMA DCA ICOUNT RELOOP, JMS 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 INWORD /GET REST OF ADDR DCA TEMP2 JMS 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 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 OUTWRD ISZ CODSZ1 /DOUBLE WORD ISZ BUMP JMP RELOOP ISZ CODSZ2 JMP RELOOP JMP LOADIT /DONE RELOCATING, GO LOAD 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 SPACE /PRINT SPACE JMS TTY DCA TTY /USE TTY AS A SWITCH TAD LINEH /PRINT HIGH ORDER JMS PSN TAD LINEL /THEN LOW ORDER JMS PSN /(LINE NUMBER NATCH !) TAD (215 /PRINT CARRIAGE RETURN JMS TTX TAD (212 /PRINT LINE FEED JMS TTX JMP I ERMSG /RETURN TTY, 0 /CONVERT TO ASCII AND PRINT AND (77 /SIX BITS ONLY TAD (-40 /WHAT SIDE OF FORTY ? SPA TAD (100 /LOW SIDE TAD (240 /HIGH SIDE JMS TTX /PRINT CHAR JMP I TTY /RETURN PAGE LOADIT, JMS 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 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 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 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 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 M12 DCA FCNT TAD I FTEMP ISZ FTEMP DCA I FTEMP2 ISZ FTEMP2 ISZ FCNT JMP .-5 TAD (5561 /PATCH ^C LOCATIONS DCA 7600 TAD (5561 DCA 7605 JMP 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 SWAP /SWAP OS8 BACK JMS I (200 /CHECK OUT W/ CI BUILDER TAD (4207 /RESTORE ^C LOCATIONS DCA 7600 TAD (6213 DCA 7605 TAD ABORTX /CALLED VIA CHAIN ?(FROM EDIT) SNA JMP 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 7605 /ERROR JMP 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=351 /LOC WHERE BCOMP LEAVES BLOAD BLOCK # IMAGE, TAD LOADBL /COME HERE TO CREATE CORE IMAGE TAD (5 /ALREADY HAVE THIS MUCH DCA LDRBLK /INIT BLOAD OVRLY READER 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 FLGRTS /YES: FLAG IT CDF 10 TAD I (7646 /GET =N CDF AND (7 /WIPE ALT MODE SNA CLL IAC RAL /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 FLDCNT /INIT CI BUILDER TAD FLDCNT DCA 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 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 (7642 TAD (-6223 SNA CLA JMP .+3 /IT WAS TRUTH! TAD (SWAP-LOADER+5600 DCA TDLIE /LIES: MUST LIE TO SWAPPER ALSO CLA IAC NOTDSY, DCA TDFLAG /NOT 0 MEANS HAVE TD8E CMA DCA 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 LOADER+2 /START 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 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 BOSPT1 DCA I X10 /START SAVING HERE TAD CODBGN CIA TAD KP200 AND BOSPT1 CLL RAR TAD TEMP DCA TEMP SKP 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 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 ISZ CCB TAD CCB CIA DCA CCB /NEGATE SEG COUNT JMS 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 TAD TDFLAG /PASS TD8E FLAG DCA FLAGTD TAD FLGRTS DCA RTSFLG /AND BRTS FLAG TAD MYCORE DCA 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 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 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 7777 AND (70 SNA JMP I MAKECI /BATCH NOT RUNNING 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 *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 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 CHAIN, CDF 10 TAD I (7607 /GET BRTS STARTING BLK CDF DCA BRTSST /INTO RTS READER CIF 10 JMS I (200 /USROUT 11 JMP 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 7777 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 NOSWAP=335 /FIRST BRTS CALL TO SWAPPER 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 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 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 7642 /CDF CIF HI CORE IAC TAD CDFTOP DCA 7721 /CIF HI CORE TAD 7721 DCA 7727 CCHEK, ISZ EKOUNT JMS 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 (5561 /PATCH CTRL/C LOCS DCA I (7600 TAD (5561 DCA I (7605 DCA NOSWAP /FOOL BRTS SWAPPER JMP BSTART /START BRTS ERRORX, 0 CIF 10 JMS I (7700 7 EKOUNT, 1 JMP 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 $$$$$