File BASOS.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/BASIC OS VERSION 3
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1970,1971,1972,1973,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 DOCUMENT.
/
/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.
/
/
/
/
/
/
/
/
/
/

/JULY 29, 1978 RL/EF/HJ/SR/WC /THIS IS A DERIVATION OF OS/8. IT SERVES AS A MONITOR /FOR EDUCOMP AND OS/8 BASIC UNDER ETOS. NO ATTEMPT /HAS BEEN MADE TO REMAIN COMPATIBLE WITH EITHER CCL OR /BATCH. MOST CODE NOT DIRECTLY CONNECTED TO THE NEW COMMANDS /HAS BEEN DELETED WILLIAM CATTEY /THIS PROGRAM WRITES ITSELF OVER THE OLD KEYBOARD MONITOR /BLOCKS ON SYS. UNDER ETOS, MAKE SURE THE RIGHT AREA HAS /BEEN LOOKED UP AS CHN0: UNLESS YOU WANT TO LOSE /OS8.RTS! / SYMBOLIC REFERENCES TO VARIOUS OVERLAYS: CCB=7400 VERSNO=3 PATCHLEV="A / DEFINITIONS OF AREAS THAT ARE NOT ELSEWHERE DEFINED: SHNDLR= 7607 ETOS= 1 MTEMP= 0027 JFIELD= 7744 JSBITS= 7746 JSTART= 7745 MSTADR= 7775 MSWITC= 7764 MREAD= 7757 OLDT9= 0007 HNDLAD= WRCTLB SVLNBF= 1645 MSTCDF= 7772
*0 VERSNO KMONER, CLA TAD [7605 DCA ERRET JMS I [PRMESG TEXT /SYSTEM ERR/ /THE FOLLOWING REGISTERS ARE SET TO VITAL INITIAL VALUES. TO ALTER /THESE VALUES IS TO BRING DISASTER DOWN UPON YOUR HEAD! LXR, PMSRST-1 X1, MSWITC /THESE TWO ARE USED AT INITIALIZATION. ADR1, RUN8-1 ADR2, RUN8&177+7377 /USED DURING R, AND RUN COMMANDS XR, AMFLAG, 0 /1 MEANS SAW ALTMODE /MUST NOT MOVE FOR CCL AND BATCH *20 RBFLAG, 0 /MUST BE AT LOCATION 20 TEMP2, -7 SYSTEM, 7700 PCH, PRINT GLINE, XGLINE GNAME, GETNAM DEVHND, 7607 FUDJMP, MSTCDF&177+5200 P6203, 6203 TMP, PATCHLEV /MONITOR PATCH LEVEL MUST BE AT LOC 31 FOR CCL PGTOUT, GETOUT ERRET, PCRLF /MUST BE AT 33 FOR CCL /THE FOLLOWING LOCS. ARE TEMPORARIES. HOWEVER, THERE IS NOW /VITAL ONCE ONLY CODE TO HELP THE BATCH PROCESSOR. THIS CODE IS /READ IN EVERY TIME THE KEYBOARD MONITOR IS RE-READ. NM1, 203 /THIS MUST BE A 203! NM2, JMS I [7607 NM3, 610 NM4, 0 TEMP1, 13 TM1, SKP CLA TMP1, JMP BCHGO NMCT, DCA I KM1 PN, JMP KMONER PRDSW, KM1, 7777 BCHGO, RUNSW, CIF CDF 0 DIGFLG, JMP I .+1 SENTER, KMINIT PAGE
/KEYBOARD MONITOR FOR BASIC OS SYSTEM FIELD 0 MTHREE=CLA CLL CMA RTL *200 IFNDEF ETOS < PRINT, JMP I PRNAME JMP .+3 TSF JMP .-1 TLS CLA TAD [7000 DCA PRINT+1> IFDEF ETOS < /JMP TO 400 TO BUILD OS/8 PRINT, JMP I PRNAME TLS CLA > JMP I PRINT GETNAM, 0 /CLEAR NAME TEMPS DCA NM1 DCA NM2 DCA NM3 DCA NM4 TAD [NM1 /GET ADDR. OF NAME TEMPS DCA PN /POINT TO NEXT CLA CMA /AC=-1 DCA PRDSW /YES WE WANT TO CHECK FOR PERIODS GTNMX, DCA NMCT /SET NAME COUNT TAD I LXR /GET NEXT TYPED CHAR TAD [-240 /IS IT A SPACE SNA JMP .-3 /YES-IGNORE TAD [240 /CORRECT TO ASCII SKP /CHAR ALREADY IN AC GTNMLP, TAD I LXR /GET NEXT CHAR DCA TMP TAD TMP TAD [-256 /IS IT A PERIOD SNA JMP PERIOD /YES TAD [-2 /SET UP FOR NEXT TEST CLL TAD [-12 /IS IT A VALID NON ALPHA? SNL CLA JMP NINSRT /YES TAD [-301 /SET UP FOR NEXT ALPHA TEST TAD TMP CLL CML TAD [-32 /IS IT A VALID ALPHA SNL CLA JMP EONAME /NO-MUST BE EHD OF NAME NINSRT, TAD NMCT /GET NUMBER OF CHARS TAD [-6 /IS IT GREATER THAN 6? SMA CLA JMP GTNMLP /YES IGNORE SUPERFLUOUS SPEC TAD NMCT /GET NAME COUNT CLL RAR /DIVIDE BY TWO TAD PN /GET NAME ADDR DCA TEMP1 /POINT TO IT TAD TMP /GET CHAR AND [77 /CONVERT TO SIXBIT SZL /DOES THIS GO TO THE HI ORDER? JMP .+4 /NO RTL /SHIFT IT UP RTL RTL TAD I TEMP1 /GET PREVIOUS CHAR IF ANY DCA I TEMP1 /STORE NEW VALUE ISZ NMCT /INDICATE NEW CHAR ADDED JMP GTNMLP /GET NEXT CHAR PERIOD, ISZ PRDSW /DO WE WANT AN EXTENSION? JMP EONAME /NO ISZ PN /POINT TO NEXT TAD [4 /FUDGE NMCT TO WAIT FOR ONLY 2 CHARS JMP GTNMX /GET EXTENSION CHARS EONAME, TAD NMCT /GET NUMBER OF CHARS SZA CLA /DID WE GET ANY? ISZ GETNAM /YES! SKIP RETURN JMP I GETNAM /NO-"ERROR"RETURN
PRNAME, 4000 /ONCE ONLY POINT TO OS/8 BUILDER TAD NM1 /GET 1ST 2 CHARS JMS PRWD /PRINT THEM TAD NM2 /NEXT JMS PRWD TAD NM3 /NEXT JMS PRWD TAD NM4 /GET EXTENSION SNA CLA /IS THERE ONE? JMP I PRNAME /NO-RETURN TAD [256 /YES-PRINT A DOT JMS PCHAR TAD NM4 /THEN THE EXTENSION JMS PRWD JMP I PRNAME PRINLP, JMS PRWD /PRINT 6BIT PAIR ISZ PRMESG /INCREMENT POINTER SKP PRMESG, 0 CLA TAD I PRMESG /GET PAIR SZA /ZERO????? JMP PRINLP /NO-PRINT THEM TSF /YES-WAIT FOR TTY FLAG JMP .-1 JMP I ERRET /GO TO KBM AT 401 PRWD, 0 DCA TMP /STORE PAIR IN TEMPORARY TAD TMP RTR /MOVE 1ST 6 BITS TO LOW ORDER RTR RTR JMS PCHAR /PRINT THE 1ST CHAR TAD TMP /GET PAIR JMS PCHAR /PRINT 2ND CHAR JMP I PRWD /RETURN PCHAR, 0 AND [77 /GET THE LOW ORDER AC SNA /IS IT ZERO? JMP I PCHAR /YES-PRINT NOTHING TAD [240 /NO-CORRECT TO STANDARD ASCII AND [77 TAD [240 JMS I PCH /PRINT THE CHAR JMP I PCHAR /RETURN
PRINTQ, JMS PRMESG /PRINT A QUESTION MARK TEXT /?/ /THEN GO TO KBM AT 401 0 CRLF, 0 TAD [215 JMS I PCH /PRINT A CARRIAGE RETURN TAD [212 JMS I PCH /THEN A LINEFEED JMP I CRLF PAGE
*400 KMNTRY, JMP I HANDAD /JUMP TO ONCE ONLY INIT AT 1001 PCRLF, JMS I [CRLF KEYMON, JMS I GLINE /GET LINE OF USER INPUT TAD [BEGLN-1 /POINT TO 1ST USER CHAR DCA LXR JMS I GNAME /GET FIRST SPEC JMP I [PRINTQ /NONE-ERROR! JMS I [SRCH /IS IT A COMMAND? IFDEF ETOS < -1417; LOGOUT /LOG THE USER OUT > -2324; START /JUMP TO ADDRESS SPECIFIED IN CCB -0411; DIRECT /SHORT FORM DIRECTORY LIST -1005; HELP /PRINT TEXT FILE .HL IFDEF ETOS < -0310; CHN3 /OPEN CHN3 TO A USER AREA -0317; CORE /CHANGE USER CORE ALLOCATION > 0 /NOT A LEGAL COMMAND-TRY AND *RUN* IT R, TAD P6203 /JS BITS: USE 0-7777,10000-17777 JMS I [RESET /RESET MONITOR I/O TABLES TAD [SHNDLR /READ FROM SYS DCA HANDAD CLA IAC /AC=0001 JMP RGETPG /NOW GET PROGRAM TO BE RUN GDEVNO, 0 /GET DEV NUM VIA USR JMS I [MINCOR /LOCK USR INTO CORE JMS I GNAME /GET SPEC JMP I [KMER4 /NONE-"TOO FEW ARGS" TAD NM1 /MOVE DEV NAME TO ARG BLOCK DCA ASNM1 TAD NM2 DCA ASNM1+1 TAD HNDLAD /POINT TO SYS HANDLER DCA HANDAD CIF 10 JMS I SYSTEM /GOTO USR 1 /AND GET DEVICE NUMBER ASNM1, 0;0 HANDAD, KMINIT /INITIAL POINT TO ONCE ONLY INIT JMP I [KMER1 /NO SUCH DEVICE- ERROR TAD ASNM1+1 /PUT DEV NUMBER IN AC JMP I GDEVNO /RETURN IFDEF ETOS < /STATUS WORDS NORMAL, 4372 /ETOS ECHO, ^C,^O,^S,^Q,^U,^P, NO ^V, RUB 0207 /BREAK ON LF,VT,FF,CR,RUB,ESC,ANY CTRL CHAR 7605 /^C TO 7605 7605 /^P TO 7605 ANYSET, 0372 /USER ECHO, ^C,^O,^S,^Q,^U,^P, NO ^V, RUB 4000 /BREAK ON ANY 7605 /^C TO 7605 7605 /^P TO 7605 >
RGETPG, JMS RSCOMN /GET FILENAME JMS I [MINCOR /LOCK USR IN CORE TAD SENTER /GET DEV NUMBER CIF 10 JMS I SYSTEM /CALL USR 2 /LOOKUP FILE PGNAME, NM1 /WHOSE NAME STARTS IN NM1 0 JMP I [KMER2 /NOT FOUND-ERROR! JMP I [RLOADR /NOW LOAD THE PROGRAM RSCOMN, 0 DCA SENTER /STORE DEV NUMBER IN TEMP TAD HANDAD /READ FROM SYS DCA DEVHND TAD NM4 /GET EXTENSION SNA /NONE?? TAD [2326 /NONE-SET TO .SV DCA NM4 JMP I RSCOMN /RETURN WRCTLB, 7001 /WRITE OVERLAY AND CCB JMS I [SHNDLR /CALL SYSTEM HANDLER 4600 /WRITE 6PGS FROM FIELD 0 6200 /STARTING AT 6200 MTEMP+6 /TO BLOCK 35 JMP KMONER /ERROR RETURN-"SYSTEM ERR" JMP I WRCTLB /NORMAL RETURN
IFDEF ETOS < CHANIO= 6100 /CHANNEL THREE LOOKUP FUNCTION CHN3, DCA USERN /JUST IN CASE... TAD I LXR /GET A CHARACTER TAD [-270 /IS IT BETWEEN 0 AND 7? CLL TAD [10 MQL /SAVE IT FOR A MOMENT SNL JMP TESTA /NO-END OF NUMBER TAD USERN /GET OLD NUMBER CLL RAL RTL /SHIFT 3 PLACES LEFT MQA /'OR' IN THE DIGIT JMP CHN3 TESTA, TAD USERN CLL TAD [-20 SZL JMP I [PRQMRK+1 TAD [7720 /MAKE IT [77,CN] DCA USERN TAD [6000 DCA LUKARG+1 /INITIALIZE DEVICE... TAD [1403 MQL CHANIO /CLOSE CHN3: CLA /FOR EXPANSION... LOOK, TAD [503 /LOOKUP ON CHN3 MQL TAD [LUKARG-1 CHANIO SNA CLA JMP I [7605 /WE'VE GOT IT! CLA CLL IAC BSW /L0100 TAD LUKARG+1 DCA LUKARG+1 TAD LUKARG+1 AND [300 SZA CLA JMP LOOK /TRY NEXT DISK UNIT JMP I [KMER1+1 /ALL FAILED-ERROR! LUKARG, DEVICE DK0 USERN, 0 TEXT /OS8DISKDSK/ > PAGE
*600 START, DCA TEMP1 /START ROUTINE...CLEAR TEMPS DCA TEMP2 TAD I [JFIELD /GET STARTING FIELD DCA I [MSTCDF TAD I [JSBITS /GET JOB STATUS WORD AND [1000 /CAN WE SAFELY RESTART? SZA CLA JMP I [KMER3 /"NO!!" TAD I [JSBITS /GET JOB STATUS WORD JMS I [RESET /RESTE I/O TABLES TAD I [JSTART /GET STARTING ADDRESS STCOMN, DCA I [MSTADR TSF JMP .-1 /WAIT FOR PRINTER TO FINISH JMS I PGTOUT /KICK USR OUT OF CORE TAD I [JSBITS /GET JOB STATUS WORD SPA CLA /DO WE USE 0-1777? JMP I [MSTCDF /NO-JUST JUMP TAD [SHNDLR /YES-RESTORE PROPER CONTENTS DCA I [MREAD-1 /FUDGE CALL TO SYS HANDLER TAD [1000 /READ 10 PAGES INTO FIELD 0 DCA I [MREAD+1 DCA I [MREAD+2 /START AT 0000 TAD [MTEMP+4 /FROM BLOCK 33 DCA I [MREAD+3 TAD FUDJMP /NOW FUDGE THE JUMP TO THE USER PROG DCA I [MSWITC /DO IT! JMP I [MREAD
MINCOR, 0 /ROUTINE TO LOCK USR IN CORE CIF 10 JMS I SYSTEM /CALL USR 10 /LOCK FUNCTION CDF 10 DCA I [OLDT9 /ZERO OUT "DIRECTORY IN CORE" KEY CDF 0 TAD [200 /POINT TO 200 DCA SYSTEM /AS USR CALL ADDRESS JMP I MINCOR /RETURN RLOADR, RUN1, TAD I [PGNAME /POINT TO STARTING BLOCK OF FILE DCA FILE JMS I DEVHND /GO GET IT! 0101 /READ IN 10 PGS TO FIELD ZERO CCB /INTO THE SCRATCH AREA FOR THE CCB FILE, 0 /READ IN THE HEADER BLOCK JMP KMONER /ERROR WHILE READING HEADER BLOCK TAD I [CCB /GET FIRST WORD JMS I [CCBTST /TEST FOR VALID CORE CONTROL TAD I [CCB+1 /GET FIELD OF STARTING ADDRESS DCA I [MSTCDF TAD I [CCB+2 /GET THE STARTING ADDRESS DCA I [MSTADR TAD I [CCB+1 /DO IT AGAIN DCA I [JFIELD /PUT SAME STUFF INTO A DIFFERENT TAD I [CCB+2 /SET OF TEMPORARIES DCA I [JSTART /THAT ARE USED FOR A DIFFERENT FUNCTION TAD I [CCB+3 /SET UP THE JOB INFORMATION AREA JMS I [RESET /AND CLEAR INFORMATION ABOUT "RUN" HANDLER TAD FUDJMP DCA I [MSWITC /SET MSWITC TO INHIBIT LOADING 7400
RUN2, TAD I [CCB CLL CMA RAL /POINT TO LAST DOUBLEWORD IN CCB TAD [CCB+4 DCA TM1 /TM1 POINTS TO SEG. ADDRESS TAD I TM1 /STORE ADDRES TO READ POSSIBLE OVERLAY DCA I [MREAD+2 ISZ TM1 /POINT TO SEGMENT CONTROL WORD TAD DEVHND /IF THE HANDLER IS IN 7600, OR TAD [200 /IF THE SEGMENT DOES NOT LOAD OVER CLA RAL /7000, NO OVERLAY IS NEEDED. ALSO IF TAD I TM1 /THE SEGMENT IS IN FIELDS 1-7. AND [77 RUN5A, SZA CLA JMP I [RUN6 /NO PROBLEMS.. READ STUFF IN TAD I [MREAD+2 /SEE IF WE OVERLAY 7000 CLL CML RAR TAD I TM1 /ADD IN CONTROL WORD TAD [300 SPA /IF NEGATIVE, 7000 IS NOT OVERLAYED JMP RUN5A TAD [7600 /GETS 0, 100, 200, OR 300 SMA /IF POSITIVE READ 3 PAGE OVERLAY ISZ I [PGNAME+1 /POINT TO NEXT TO LAST RECORD TAD [300 DCA RDCNT TAD I [PGNAME+1 CMA /GET RECORD TO READ OVERLAY FROM TAD FILE DCA R7000 JMS I DEVHND /READ OVERLAY FROM THE FILE INTO PAGES RDCNT, 0 /BEFORE CCB 6200 /THEN WRITE THE WHOLE MESS OUT R7000, 0 JMP I [RERR JMS I [WRCTLB /WRITE OUT THE OVERLAY+CCB DCA .-1 /BUT ONLY ONCE!! ISZ RUNSW DCA I [MSWITC /ENABLE READ OF OVERLAY TAD RDCNT /SEE IF THIS SEG IS EXHAUSTED CIA TAD I TM1 SPA SNA ISZ I [CCB /ARE WE DONE ALL SEGMENTS? SKP /NOT YET. LOOP UNTIL DONE JMP I [MSWITC RUN5, DCA I TM1 /SAVE ALTERED CONTROL WORD JMP RUN2
KMER1, JMS I [PRNAME /DEVICE NOT AVAILABLE JMS I [PRMESG TEXT / NOT AVAILABLE/ PAGE
*1000 /MUST BE AT 1000 FOR BATCH BEGLN, 0 /LINE BUFFER KMINIT, CDF 10 /INITIALIZATION - DESTROYED BY LINE BUFFER ISZ I [7700 /LOC 17700=7777 IF I/O MONITOR IS KNOWN JMP .+3 /TO BE IN CORE, SO SET UP TAD [200 /THE INITIAL POINTER FOR CALLS TO THE MONITOR DCA SYSTEM /ACCORDINGLY CDF 0 TAD I LXR /MOVE FIRST SEGMENT OF RELOCATED CODE DCA I X1 /FROM PMSRTST TO MSWITC ISZ TEMP2 JMP .-3 IFDEF ETOS < /ETOS DATE INITIALIZER CLA CLL IAC /AC=1 FOR TOD CALL MQL TAD [ETOD-1 SYSCAL CLA CLL CML IAC RAL /AC=0003 AND ETOD+3 /IS YEAR MULTIPLE OF 4? SNA CLA ISZ FEB /ADD 1 IF LEAP YEAR TAD ETOD+3 /GET YEAR TAD M3662 /SUBTRACT 1970 FROM IT AND K30 /PULL OFF HI ORDER OFFSET CLL RTL RTL /MOVE IT INTO THE RIGHT BITS MQL TAD I KDWD /GET EXTENSION WORD AND K7177 /CLEAR OUR BITS FOR SAFETY MQA /PUT OFFSET THERE DCA I KDWD /STORE IT! CLA CLL IAC /ADD 1 TO DAYS DALOOP, ISZ MONPNR ISZ MONTH TAD ETOD+2 /GET DAY WORD TAD I MONPNR /ADD IN DAYS OF THIS MONTH SZA /LAST DAY OF MONTH? JMP .+4 ISZ MONPNR /YES, KLUDGE! ISZ MONTH TAD I MONPNR DCA ETOD+2 /STORE NEW VALUE SNL /IS THIS THE RIGHT MONTH? JMP DALOOP /NO-GO BACK FOR NEXT ONE TAD MONTH CIA TAD K15 /CORRECT TO RIGHT NUMBER FOR MONTH CLL RTL /SHIFT UP AND MAKE ROOM RTL /FOR DAY BITS RAL TAD ETOD+2 /GET DAY CLL RTL /MAKE ROOM FOR YEAR RAL MQL /SAVE 'TILL WE GET YEAR TAD ETOD+3 /GET ETOS YEAR TAD M3662 AND [7 /GET LO ORDER OFFSET MQA /PUT IT ALL TOGETHER CDF 10 /AND PUT THE FINAL DCA I [7666 /DATE WORD WHERE IT BELONGS CDF 0 > JMP I ERRET /JUMP TO KBM AT 401 IFDEF ETOS < K7666, 7666 K7177, 7177 K15, 15 K34, 34 M3662, -3662 K30, 30 MONTH, 0 MONPNR, DECEMB-1 > RTWTPT, RUNTWT KDWD, 7777 /START PMSRST, SHNDLR&177+4200 /JMS SHNDLR 0300 7000 MTEMP+6 HLT CDF CIF 0 TCF /END
*1112 IFDEF ETOS < /CORE ASSIGNMENT COMMAND /ENTER HIGHEST MEMORY FIELD YOU WANT CORE, TAD I LXR /GET USER CHAR TAD [-270 /CHECK FOR BETWEEN 1 AND 7 CLL TAD (7 SNL JMP I [PRQMRK+1 /OUTSIDE OF LIMITS-ERROR IAC /ADD ONE SO THAT CORE COMMAND MQL /GETS RIGHT ARG FROM AC TAD (22 /CORE SYSCAL FUNCT. SWP /PUT ARGS IN RIGHT PLACES SYSCAL /DO IT! SNA /DID WE GET AS MUCH AS WE WANTED? JMP I [7605 /YES-REBOOT CIA /NO TELL USER HOW MUCH HE DIDN'T GET TAD (260 TLS CLA JMP I [KMER1+1 /"X NOT AVAILABLE" / SYSCAL= 6200 LOGOUT, TAD [14 /FUNCTION: LOGOUT MQL SYSCAL /DO IT! /THIS CODE IS VITAL TO THE ETOS DATE INIT ETOD, 0 0 0 0 DECIMAL DECEMB, 31 /DECEMBER 30 /NOVEMBER 31 /OCTOBER 30 /SEPTEMBER 31 /AUGUST 31 /JULY 30 /JUNE 31 /MAY 30 /APRIL 31 /MARCH FEB, 28 /FEBRUARY 31 /JANUARY OCTAL > PAGE
/NOTE: XR=AMFLAG ! *1200 /TELETYPE INPUT ROUTINE XGLINE, KEYMON+1 IFDEF ETOS < TAD KNRM /SET NORMAL KEYBOARD STATUS SETSTAT /FOR ETOS > TAD [". /PRINT THE MONITOR DOT! JMS I PCH DCA RBFLAG /CLEAR THE RUBOUT FLAG TAD [BEGLN-1 /CLEAR THE USER INPUT BUFFER CHLM1, DCA LXR DCA AMFLAG /ZERO ALTMODE FLAG CHLOOP, KSF JMP CHLOOP TAD [200 KRS DCA NM1 KCC JMS SRCH -225;RBSPCL /CLEAR BUF IF ^U -215;CARRET -377;RUBOUT -375;ALTMOD -376;ALTMOD -233;ALTMOD -212;LFEED -200;CHLOOP -217;CHLOOP /IGNORE ^O -203;RBSPCL /^C; MUST BE JUST BEFORE 0 0 JMS PRNT /ECHO THE CHAR IF NECESSARY CINSRT, TAD NM1 /INSERT THE USER'S CHAR INTO THE BUFFER DCA I LXR TAD LXR /IS THE BUFFER FULL YET? TAD [-BEGLN-110 SPA CLA JMP CHLOOP /NOT YET GET MORE CARRET, JMS I [CRLF /COMES HERE IF BUFFER FULL OR CR TYPED TAD LXR /POINT TO USER'S TEXT TAD [1-BEGLN SNA CLA /ANY TEXT? JMP XGLINE+1 /NO START AGAIN DCA I LXR /PAD BUFFER WITH ZEROS DCA I LXR JMP I XGLINE /PARSE THE LINE
IFNDEF ETOS < PRNT, 0 /STAND ALONE ECHO ROUTINE ISZ RBFLAG /IS RUBOUT FLAG SET? JMP .+3 /NO-ECHO NORMALLY TAD ["\ /YES-PRINT BACKSLASH JMS I PCH DCA RBFLAG /CLEAR RUBOUT FLAG TAD NM1 /ECHO CHAR JMS I PCH JMP I PRNT /RETURN > IFDEF ETOS < SETSTAT= 6047 PRNT, 0 /ETOS ECHO ROUTINE ISZ RBFLAG /IS RUBOUT FLAG SET JMP NOTRUB /NO-ETOS ECHOS CHAR TAD ["\ /YES-TYPE A BACKSLASH JMS I PCH TAD NM1 /AND ECHO THE CHAR JMS I PCH TAD KNRM /RESET TO NORMAL BREAK AND ECHO SETSTAT NOTRUB, DCA RBFLAG /CLEAR THE FLAG JMP I PRNT /AND RETURN > RBSPCL, JMS I [CRLF /CLEAR BUFFER AND START AGAIN JMP XGLINE+1 ALTMOD, TAD ["$ /CHANGE USER CHAR TO DOLLAR SIGN DCA NM1 JMS PRNT /AND ECHO IT ISZ AMFLAG /NOTE ALTMODE JMP CARRET+1 /NOW ACT AS IF HE TYPED CR IFNDEF ETOS < RUBOUT, TAD LXR /STAND ALONE RUBOUT ROUTINE > /JUST ECHO CHAR IFDEF ETOS < RUBOUT, TAD KANY /ETOS-RESET SYSTEM STATUS SETSTAT /NOW WE ECHO CHAR AND BREAK ON ANY TAD LXR /GET POINTER > TAD [1-BEGLN /ANY CHARS LEFT? SNA CLA JMP RBSPCL /NO-START AGAIN TAD ["\ /PREPARE TO TYPE BACKSLASH ISZ RBFLAG /SHOULD WE? JMS I PCH /YES! CLA CMA /NO DCA RBFLAG /SET RUB FLAG TAD LXR /POINT TO DELETED CHAR DCA TEMP1 TAD I TEMP1 JMS I PCH /PRINT IT AS IT GOES AWAY LBCKUP, CLA CMA /DELETE IT NOW! TAD LXR JMP CHLM1 IFDEF ETOS < KNRM, NORMAL /POINTERS TO STATUS WORDS KANY, ANYSET >
SRCH, 0 /COMMAND SEARCH ROUTINE TAD I SRCH /POINT TO TABLE OF KEY WORDS ISZ SRCH SNA /ZERO IN TABLE? JMP I SRCH /YES-RETURN TAD NM1 /NO-COMPARE WITH USER CHARS SNA CLA /MATCH? JMP SFND /YES-JUMP TO ADDRESS IN TABLE AFTER KEY ISZ SRCH /NO-TRY NEXT KEY WORD JMP SRCH+1 SFND, TAD I SRCH /GET ADDRESS DCA TEMP1 JMP I TEMP1 /JUMP TO IT LFEED, JMS I [CRLF /LINEFEED FUNCTION DCA I LXR /PAD BUFFER TAD [". /TYPE A DOT JMS I PCH TAD [BEGLN-1 /THEN THE CONTENTS OF THE BUFFER DCA XR TAD I XR SNA /HAVE WE HIT THE PADDING? JMP LBCKUP /YES-CONTINUE INPUT JMS I PCH /NO-KEEP TYPING JMP .-4 PRQMRK, JMS I [PRNAME /PRINT THE OFFENDING SPEC JMP I [PRINTQ /THEN A QUESTION MARK
*1373 /MICRO DIRECT V6 DIRECT, JMS I [GDEVNO /GET DEVICE NUMBER JMS I [RSCOMN /SET UP HANDLER CALL JMS I [MINCOR /LOCK USR IN CORE CLA IAC /AC=1 DCA SEG /READ ONE SEGMENT RDNXT, TAD SEG SNA CLA /IS SEG ZERO? JMP I [7605 /YES-RETURN TO KBM JMS I DEVHND /NO-READ IN NEXT SEGMENT 0200 /READ 1BK INTO FLD 0 BUFST, BUFR /ST AT 400 BKNO, 0001 /ONE BLOCK INITIALLY JMP KMONER /ERROR RETURN TAD [BUFR-1 /POINT TO START OF BUFFER DCA LXR TAD I LXR DCA FILCNT /GET NUMBER OF ENTRIES ISZ LXR /SKIP OVER ST BLK # TAD I LXR /GET LINK TO NEXT SEGMENT DCA SEG ISZ LXR /SKIP OVER FLAG WORD TAD I LXR /GET # OF ADDITIONAL INFO WORDS DCA INFOWD TEMPTY, TAD I LXR /GET FIRST WORD OF ENTRY SNA /IS IT ZERO? JMP NEWFIL /YES-THIS IS AN EMPTY FILE DCA NM1 /NO-PUT NAME INTO TEMPS TAD I LXR DCA NM2 TAD I LXR DCA NM3 TAD I LXR DCA NM4 NEXFIL, TAD INFOWD /SET NUMBER OF WORDS TO SKIP DCA INFCNT CLA TAD I LXR /SKIP OVER A WORD ISZ INFCNT /DONE ALL SKIPPING? JMP .-3 /NO-GO BACK AGAIN SNA CLA /IS IT ZERO? JMP NEWFIL+1 /YES-DON'T PRINT IT! JMS I [PRNAME JMS I [CRLF NEWFIL, ISZ LXR /YES-SKIP OVER FILE LENGTH ISZ FILCNT /DONE ALL FILES THIS SEGMENT? JMP TEMPTY /NO-GO AND PROCESS NEXT ENTRY ISZ BKNO /YES-READ IN NEXT BLOCK JMP RDNXT / SEG= TEMP1 FILCNT= TM1 INFOWD= TMP1 INFCNT= TMP BUFR= 400 /BLOWS AWAY SOME OF KBM!!! /
/HELP ROUTINE V4 HELP, JMS I GNAME /GET FILENAME JMP SETNAM /NO NAME-SET IT TO HELP.HL SETEXT, TAD NAMST+3 /FORCE EXTENSION TO .HL DCA NM4 JMS I [MINCOR /LOCK USR IN CORE CLA CLL IAC /AC=1 CIF 10 JMS I SYSTEM /CALL USR 2 /LOOKUP FILE FSTBLK, NM1 /WHOSE NAME IS IN NM1 - NM4 0 JMP I [KMER2 /"NOT FOUND" TAD FSTBLK /POINT TO STARTING BLOCK NUMBER DCA FILPNR NEXTBK, JMS I [SHNDLR 0200 /READ 1 BK INTO FLD 0 BUFR /START AT 400 FILPNR, 0 JMP KMONER /"SYSTEM ERR" TAD [BUFR-1 /POINT TO START OF TEXT DCA LXR TAD [-401 /READ THROUGH 400 WORDS DCA COUNTR NEXTPR, JMS GETWRD /GET A 12 BIT WORD MQL /SAVE IT IN THE MQ MQA JMS COMMON /PRINT THE LO ORDER 8 BITS JMS GETWRD /GET NEXT 12 BIT WORD DCA CHRTMP /SAVE IT IN CHRTMP TAD CHRTMP JMS COMMON /PRINT LO ORDER 8BITS TAD CHRTMP /GET IT BACK AND [7400 /PULL OFF HI ORDER 4 BITS CLL RTR /SHIFT THEM DOWN RTR SWP /SWAP WITH MQ AND [7400 /GET ITS HI ORDER 4 BITS MQA /COMBINE THEM CLL RTR /AND MOVE THE 8 BITS TO THE RTR /LO ORDER AC JMS COMMON /AND PRINT IT OUT JMP NEXTPR /GO BACK FOR ANOTHER 3 CHARACTERS / SETNAM, TAD NAMST /SET NM1-NM3 TO HELP DCA NM1 TAD NAMST+1 DCA NM2 TAD NAMST+2 DCA NM3 JMP SETEXT /SET NM4 TO HL NAMST, 1005 /HE 1420 /LP 0000 1014 /HL / GETWRD, 0 TAD I LXR /GET A 12 BIT WRD ISZ COUNTR /DONE WHOLE BLOCK? JMP I GETWRD /NO-RETURN ISZ FILPNR /YES-GET ANOTHER BLOCK JMP NEXTBK / COUNTR= INFCNT CHRTMP= INFOWD /SAVE SPACE AND USE TEMPS IN DIRECT / COMMON, 0 AND [377 TAD [-232 /CTRL/Z?? SNA JMP I [7605 /YES-EXIT TAD [232 /CORRECT FOR AFTERMATH OF TEST JMS I PCH /PRINT THE CHARACTER JMP I COMMON /AND RETURN PAGE
*1600 KMER4, JMS I [PRMESG TEXT /TOO FEW ARGS/ CCBTST, 0 /EXAMINE COUNT WORD OF CCB FOR VALIDITY /ASCII AND BINARY FILES USUALLY FAIL THIS TEST CMA AND [7740 SNA CLA JMP I CCBTST /IT WAS VALID TAD [7605 DCA ERRET /RELOAD MONITOR ON THIS ERROR JMS I [PRMESG /IT WASN'T - TELL THE USER TEXT /BAD CORE IMAGE/ GETOUT, 0 /SUBROUTINE TO KICK MONITOR OUT IF NECESSARY TAD I [JSBITS RAR CLA TAD SYSTEM SZL SPA CLA /IS THE SYSTEM IN CORE AND SHOULD IT BE? JMP I GETOUT CIF 10 /YES AND NO - KICK IT OUT JMS I SYSTEM 11 /BYE BYE TAD [7700 DCA SYSTEM JMP I GETOUT
KMER2, JMS I [PRNAME JMS I [PRMESG TEXT / NOT FOUND/ RESET, 0 DCA I [JSBITS /MARK AREAS FOR I/O OPTOMIZATION JMS I [MINCOR /LOCK USR IN CORE CIF 10 JMS I SYSTEM /CALL USR 13 /RESET DEVICE HANDLERS AND OUTPUT FILES CDF 0 JMP I RESET KMER3, JMS I [PRMESG TEXT /NO!!/ RUN6, TAD I TM1 /STORE CONTROL WORD FOR LAST SEG. DCA I [MREAD+1 TAD I RFILE /GET STARTING BLOCK NUMBER RUN7, IAC /SKIP OVER CCB DCA RUNFIL /STORE STARTING BLOCK NUMBER TAD DEVHND /GET STARTING ADDR OF HANDLER DCA I [MREAD-1 /STORE IT WHERE WE WILL USE IT TAD DEVHND DCA RUNHND /STORE HANDLER ENTRY IN THIS PAGE TAD I ADR1 DCA I ADR2 ISZ ADCNT JMP .-3 JMP I .+1 /AND GO TO IT RUN8&177+7400 RFILE, FILE ADCNT, RUN8&177+7600
RUN8, ISZ I R7400 /IS THIS THE LAST PARAMETER PAIR? JMP RUN9 /NO - KEEP LOADING TAD RUNFIL DCA I RMRD3 /MOVE THE RECORD NUMBER INTO THE FINAL READ TSF RUNTWT, JMP .-1 /WAIT FOR THE TELETYPE TO DIE DOWN (RF08 IS FAST!) JMP I .+1 MREAD /READ THE LAST SEGMENT AND START UP RUN9, TAD I RUNADR DCA RADR /SET UP THE LOADING ADDRESS OF THE CURRENT SEGMENT ISZ RUNADR TAD I RUNADR DCA RCTL /AND THE READ CONTROL WORD JMS I RUNHND RCTL, 0 RADR, 0 RUNFIL, 0 JMP RERR /INPUT ERROR READING THE PROGRAM TAD RCTL JMS ROTAT /GET THE BLOCK LENGTH OF THIS SEGMENT TAD RUNFIL DCA RUNFIL /UPDATE THE BLOCK NUMBER FROM IT ISZ RUNADR JMP RUN8 /BACK FOR ANOTHER ONE RERR, CIF 10 JMS I RU7700 7 0 /TOTALLY MEANINGLESS RUNADR, CCB+4 R7400, 7400 RMRD3, MREAD+3 RU7700, 7700 RUNHND, 0 IFNZRO ROTAT-SVLNBF-112&4000 <ERROR> *1765 /MUST BE AT TOP OF PAGE ROTAT, 0 CLL RTR RTR RTR AND RU37 SNA TAD RU37 IAC CLL RAR JMP I ROTAT RU37, 37
*4000 /THIS ROUTINE ENABLES THE PROGRAM TO COVER THE OS/8 KEYBOARD /MONITOR WITH ITSELF ON SYS. /WARNING! IF WORKING UNDER ETOS, MAKE SURE THAT THE RIGHT /DEVICE HAS BEEN LOOKED UP ON CHN0: OTHERWISE OS8.RTS WILL BE ALTERED. / WRITE= JMS I SYSHND / WRITE; 5001; 0000; 07; JMP BERR /WRITE NEW KBM JMS I [PRMESG TEXT /KBM OVERLAY COMPLETE/ BERR, JMS I [PRMESG TEXT /ERROR WRITING KBM OVERLAY / SYSHND, 7607 / /AT LAST, THE END $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search