File MUTOR.PA (PAL assembler source file)

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

/ M U T O R

/PROF. HEINZ STEGBAUER
/HTL-MOEDLING, MAY 1976

/MULTIUSER VERSION OF 'A U T O R',
/MY OWN TEXT EDITOR MADE IN 1973.

VERSION=4+6060	/LAST CHANGES 22-JAN-79

SPL=6102

L0001=CLA CLL IAC
L0002=CLA STL RTL
L0003=CLA STL IAC RAL
L0004=CLA CLL IAC RTL
L0006=CLA STL IAC RTL
L0100=CLA CLL IAC BSW
L2000=CLA STL RTR
L4000=CLA STL RAR
L7777=CLA CLL CMA
L7776=CLA CLL CMA RAL
L7775=CLA CLL CMA RTL
L3777=CLA CLL CMA RAR
L5777=CLA CLL CMA RTR


	FIELD 0
	PAGE 0

	0
	JMP I .+1	/TO INTERRUPT HANDLER
	INTRPT
	RECOVR		/JUMP HERE AFTER POWER FAILURE
USER,	0		/INTERRUPT USER COUNTER
SIN,	0		/INTERRUPT TEMPORARY
ITM,	0		/     --- " ---
FLAG,	0		/INTERRUPT EQUIV. OF 'LOOK'

XREG,	0		/INTERRUPT AUTOINDEX REGISTERS
XREG2,	0
XREG3,	0

SWPBEG=. /BEGIN OF SWAP AREA AXREG, 0 /AUTOINDEX REGISTERS AXREG2, 0 AXREG3, 0 AXIN, 0 /INPUT POINTER AXOUT, 0 /OUTPUT POINTER IBYTE, 0 /PACK BYTE SWITCH ADD, 0 /TEMPORARY IN 'PACKC' OBYTE, 0 /UNPACK BYTE SWITCH TGET, 0 /TEMPORARY IN 'GETC' CHAR, 0 /CHARACTER TEMP, 0 /TEMPORARY REGISTERS PT1, 0 PT2, 0 CNTR, 0 /GENERAL COUNTER TABCNT, 0 /TABULATION COUNTER RUBST, 0 /RUBOUT PROTECTION PC, RUN /RESTART ADDRESS XIOT, U0KRB /USER KRB IOT XFIELD, U0CDF /CDF TO USER BUFFER IPTRI, U0BEG+40 /INPUT BUFFER FILL IPTRO, U0BEG+40 /INPUT BUFFER EMPTY IPTR0, U0BEG+40 /START OF BUFFER OPTRI, U0BEG /OUTPUT BUFFER FILL OPTRO, U0BEG /OUTPUT BUFFER EMPTY BUFR, U0BEG+153 /NEXT LOC. IN TEXT BUFFER LIMIT, U0END /UPPER END OF TEXT BUFFER ALINE0, U0BEG+151 /ADDRESS OF DUMMY LINE LINENO, 0 /LINE NUMBER LINE1, 0 /LINE ARGUMENTS IN COMMANDS LINE2, 0 THISLN, 0 /ADDRESS OF CURRENT LINE LASTLN, 0 /ADDRESS OF PRECEDING LINE AUTOLN, 0 /LINE NUMBER (AUTOMATIC MODE) LNPSW, 0 /LINE NUMBER PRINT SWITCH NUMBER, 0 /HOLDS BCD-DIGIT TELSW, 0 /TELEPRINTER BUSY FLAG SILENT, 0 /NO ECHO SWITCH FOR 'READC' OUTPUT, 0 /0=ECHO, 7777=NO ECHO USCH, HLT /SAVES EDIT SEARCH CHARACTER NAME, ZBLOCK 3 /FILENAME EX, 0 /EXTENSION GETC=JMS I . /UNPACK A CHARACTER AGET, XGETC /OR XGETF PRINTC=JMS I . /OUTPUT A CHARACTER APUT, XPRINT /OR XPUTF /NOTE: POINTERS FOR 'GETC' AND 'PRINTC' MUST BE IN SWAP AREA / BECAUSE THEY ARE SWITCHED FROM NORMAL TO FILE I/O! SWPEND=. /END OF SWAP AREA SWPLEN=SWPEND-SWPBEG /LENGTH OF SWAP AREA
DECK=XFIELD DIRBUF=6400 /DIRECTORY BUFFER DTBUFR=7000 /DECTAPE I/O-BUFFER ENTRIES,0 /DIRECTORY ENTRIES PER SEGMENT BLOCK, 0 /BLOCK NO. OF FIRST FILE FILEN, 0 /-LENGTH OF FILE WASTE, 1 /NO. OF ADDITIONAL INFO WORDS SEGMENT,0 /DIRECTORY BLOCK# OF OPEN FILE AENTRY, 0 /POINTER TO TENTATIVE FILE ENTRY LENT, 0 /LAST LOC USED IN A SEGMENT LOOK, USER0-1 /POINTER TO RUNNING USER STATUS WORD DTLOOK, 0 /POINTER TO DECTAPE USER STATUS WORD LOOKST, USER0-1 /TO RESET LOOK MLOOKE, -USER0-N+1 /LAST STATUS WORD P77, 77 /RIGHT MASK M100=. P7700, 7700 /LEFT MASK C240, 240 /ASCII FOR SPACE C260, 260 /ASCII FOR ZERO MCR, -215 M4, -4 /LISTS OF SPECIAL CHARACTERS: M1LIST=. 214 /FORM FEED CBELL, 207 /BELL CLF, 212 /LINE FEED S1LIST=. BAR, 337 /BACK ARROW E1LIST=. CCR, 215 /CARRIAGE RETURN HLT /TO INSERT SEARCH-CHARACTER (EDIT!) M77, -77 /NEGATIVE LIST TERMINATOR Z232, 232 /EOF MARK /MACRO - INSTRUCTIONS: GETLN=JMS I . /FORM A LINE NUMBER XGETLN FINDLN=JMS I . /SEARCH FOR A GIVEN LINE XFIND DELETE=JMS I . /REMOVE A LINE OF TEXT XDELET ENDLN=JMS I . /UPDATE LINE POINTERS XENDLN PACKC=JMS I . /PACK A CHARACTER XPACKC IGNORE=JMS I . /SKIP ON NONPRINTING CHARACTER AXIGNO, XIGNOR TESTN=JMS I . /RECOGNIZE NUMBERS XTESTN BRANCH=JMS I . /IDENTIFY A CHARACTER AND BRANCH XBRANC READC=JMS I . /READ ONE CHARACTER AND PRINT IT XREADC FREE2=JMS I . /DISMISS IF LESS THEN 2 BUFFER LOC'S FREE XFREE2 FREE13=JMS I . /DISMISS IF LESS THAN 13 BUFFER LOC'S FREE XFREE3 PRNTLN=JMS I . /PRINT A LINE NUMBER XPRNTL CRTEST=JMS I . /SKIP ON CARRIAGE RETURN XCRTST ERROR=JMS I . /PRINT ERROR MESSAGE XERROR DECTAPE=JMS I . /DECTAPE OPERATION IFDEF TC08 <DTAPE> IFDEF RK8E <DISK> GETCAT=JMS I . /READ DIRECTORY SEGMENT XGETCAT PUTCAT=JMS I . /WRITE DIRECTORY SEGMENT XPUTCAT LOOKUP=JMS I . /LOCATE A PERMANENT FILE XLOOKUP ENTER=JMS I . /ENTER A TENTATIVE FILE XENTER CLOSE=JMS I . /MAKE A FILE PERMANENT XCLOSE BUMPXR=JMS I . /BUMP 'AXREG' (AC)+WASTE WORDS AINFOS PRINT2=JMS I . /PRINT 2 PACKED ASCII'S PRITWO SCRATCH=JMS I . /CLEAR TEXT STORAGE XSCR UDF=JMS . /CHANGE TO USER DATA FIELD XUDF, 0 UCDF, HLT JMP I XUDF DTINT, 0 /CHECK INTERRUPT FROM DECTAPE 0 /DTSF JMP I DTINT JMP I DTOP DTOP, 0 /VARIABLE POINTER TO SERVICE ROUTINE DRET, 0 /RETURN ADDRESS AFTER SEARCH CXGETC, XGETC /CONSTANT POINTER TO GETC /INITIALISATION OF PROGRAM: *170 BEGIN, CLA CLL DCA AUTOLN /SWITCH TO MANUAL MODE TAD M4 DCA LNPSW /ENABLE LINE NUMBER PRINTING FREE2 TAD CCR PRINTC
START, CLA JMS COMIN TAD AUTOLN SNA /AUTOMATIC MODE? JMP .+4 DCA LINENO /YES FREE13 PRNTLN /PRINT NEW LINENUMBER INPUT, READC /INPUT A LINE OF TEXT PACKC BRANCH S1LIST-1 / _ , CR S2LIST-S1LIST /START-3, GO JMP INPUT GO, PACKC /CARRIAGE RETURN PACKC /IS PACKED TWICE JMS COMOUT TAD AUTOLN SNA /AUTOMATIC LINE NUMBERS? JMP .+3 DCA LINENO /YES JMP .+4 TESTN /DOES LINE BEGIN WITH A NUMBER? JMP COMAND /NO --- SHOULD BE A COMMAND! GETLN /YES, GET THE LINENUMBER TAD BUFR /REINIT TEXTPOINTERS DCA AXIN /FOR INPUT (TO TEXT-BUFFER) DCA IBYTE TAD LINENO UDF DCA I AXIN /STORE LINENUMBER CDF SKP GETC INSERT, PACKC /STORE ENTIRE LINE CRTEST JMP .-3 DELETE /DELETE OLD LINE IF ANY ENDLN /UPDATE LINE INDEXES JMP START COMAND, L7777 DCA CNTR TAD CHAR /STORE COMMAND CHARACTER MQL /TEMPORARILY DCA LINE1 DCA LINE2 GETC /PASS OVER REST OF COMMAND WORD CRTEST /RECOGNIZE END SKP /OF COMMAND LINE JMP COMGO TESTN JMP .-5 GETLN /GET EVENTUAL LINE LIMITS TAD LINENO ISZ CNTR JMP COMAND+5 JMP COMAND+4 COMGO, MQA CLA BRANCH /IDENTIFY COMMAND COMLIST-1 /AND BRANCH TO COMADDR-COMLIST /RESPECTIVE ROUTINE ERR01, ERROR /UNRECOGNIZED COMMAND COMLIST,215 /C.R. 301 /AUTOMATIC 314 /LIST 320 /PUNCH 305 /EDIT 304 /DELETE 313 /KILL 315 /MOVE 322 /RESEQUENCE 324 /TAPE 303 /CATALOG 307 /GET 317 /OLD 316 /NEW 323 /SAVE 325 /UNSAVE 306 /FILENAME 302 /BYE M240, -240 COMIN, 0 TAD (37 TAD IPTR0 /INITIALIZE TEXTPOINTERS DCA AXIN /FOR INPUT (TO INPUT-BUFFER) DCA IBYTE TAD AXIN /RUBOUT PROTECTION! DCA RUBST L7777 DCA E1LIST+1 /NO SEARCH CHAR. (EDIT ONLY!) JMP I COMIN COMOUT, 0 TAD (37 TAD IPTR0 /SET TEXTPOINTERS DCA AXOUT /FOR OUTPUT (OF INPUT-BUFFER) DCA OBYTE GETC TAD AUTOLN SNA CLA /AUTOMATIC LINE NUMBERS? TAD CHAR /NO TAD M240 /IGNORE LEADING SPACES! SNA CLA JMP .-6 JMP I COMOUT RUN, IOF /ONCE ONLY STARTUP CODE L7777 TAD ALINE0 DCA AXREG UDF DCA I AXREG /SETUP DUMMY LINE DCA I AXREG /AND CLEAR TEXTBUFFER CDF MUTOR, JMS I (IERROR /PRINT IDENTIFIER USING 'IERROR' ION /SO WE CLEAR THE I/O-BUFFERS TOO! JMP BEGIN PAGE
XPUNCH, L7777 DCA NUMBER TAD M100 DCA CNTR FREE2 L4000 PRINTC ISZ CNTR JMP .-4 ISZ NUMBER JMP START-5 DCA LNPSW /=0...DON'T PRINT LINE NUMBERS YLIST, TAD LNPSW TAD I (TABS DCA TABCNT TAD LINE2 /CORRECT GIVEN LINE LIMITS SNA /TO TAD LINE1 /0,4095 ... LIST ALL SNA /M,M ...... LIST LINE M CMA /M,N ...... LIST LINES M TO N DCA LINE2 TAD LINE1 DCA LINENO /GET LOWER LIMIT FINDLN /FIND LINE NOP NEXTLN, TAD THISLN DCA AXOUT DCA OBYTE UDF TAD I AXOUT /GET LINE NUMBER DCA LINENO CDF TAD LINENO SNA /DUMMY LINE (LN=0) ? JMP LN0 /YES, PASS OVER! CIA CLL TAD LINE2 SNL CLA /STILL IN LIMITS? JMP FINISH TAD LNPSW /YES SNA CLA JMP .+5 FREE13 PRNTLN /THIS ONLY FOR 'LIST' TAD (40 PRINTC GETC FREE13 PRINTC /PRINT THE LINE CRTEST JMP .-4 LN0, UDF TAD I THISLN /GET ADDRESS OF NEXT LINE CDF SNA /ZERO? JMP FINISH /MEANS LAST LINE! DCA THISLN JMP NEXTLN FINISH, TAD LNPSW SZA CLA /'LIST' OR 'PUNCH' ? JMP START-3 JMP XPUNCH+1 /PUNCH SOME INCH OF TRAILER XEDIT, DCA LNPSW /'EDIT' DOESN'T PRINT LINE NUMBERS TAD LINE1 SNA JMP ERR03 /LINE NOT SPECIFIED! DCA LINENO FINDLN ERR03, ERROR /LINE NOT FOUND! TAD BUFR /SET TEXTPOINTERS FOR INPUT DCA AXIN /(THOSE FOR OUTPUT ARE SET DCA IBYTE /BY 'FINDLN') TAD LINENO UDF DCA I AXIN /COPY LINE NUMBER CDF TAD AXIN DCA RUBST /RUBOUT PROTECTION! GTCHAR, FREE2 TAD CBELL /REQUEST SEARCH CHARACTER PRINTC DCA SILENT /NO ECHO! READC TAD CHAR DCA E1LIST+1 /GET & STORE SEARCH CHARACTER SCHAR, GETC FREE13 PRINTC /PLAYBACK THE LINE UP TO BRANCH /SEARCH CHAR. OR C.R. E1LIST-1 E2LIST-E1LIST PACKC JMP SCHAR RESTLN, FREE2 TAD CCR /RESTART LINE PRINTC TAD BUFR IAC DCA AXIN DCA IBYTE MODIFY, READC /INSERT NEW CHARACTERS BRANCH /AND\OR PERFORM EDIT FUNCTIONS M1LIST-1 /F.F.,BELL,_,CTRL-C,LF,C.R. M2LIST-M1LIST FOUNDC, PACKC JMP MODIFY PAGE
XDEL, TAD LINE2 /CHECK AND CORRECT LIMITS SNA TAD LINE1 SNA JMP I (ERR03 /NO LINE SPECIFIED! DCA LINE2 TAD LINE1 /FIRST LINE XDEL1, DCA LINENO TAD LINENO /GET LINE NUMBER CIA CLL TAD LINE2 /COMPARE WITH UPPER LIMIT SNL CLA /ALL DONE? JMP START-3 TAD BUFR DCA AXIN /MARK END OF TEXT DELETE /NO, DELETE THE LINE UDF TAD I LASTLN CDF SNA CLA /LAST LINE OF TEXT? JMP START-3 ISZ THISLN /NO, UDF TAD I THISLN /GET NUMBER OF NEXT LINE CDF JMP XDEL1 XMOVE, TAD LINE2 SNA CLA JMP I (ERR03 /LINE ARGUMENTS MISSING! TAD LINE1 DCA LINENO FINDLN /SEARCH FOR GIVEN LINE JMP I (ERR03 /LINE DOESN'T EXIST! TAD BUFR DCA AXIN /SET TEXTPOINTERS FOR INPUT DCA IBYTE TAD LINE2 UDF DCA I AXIN /STORE NEW LINE NUMBER CDF SKP PACKC GETC /GET AND STORE OLD TEXT CRTEST JMP .-3 DELETE /REMOVE OLD LINE TAD LINE2 DCA LINENO CHAIN, TAD M4 /INSERT NEW LINE DCA LNPSW /(USED BY EDIT ALSO!) FREE2 PRINTC JMP I LINSERT XRESEQ, TAD LINE1 /GET INCREMENTAL STEP SNA /IF ZERO IAC /ASSUME A STEP OF 1 DCA LINE1 DCA LINENO L7777 DCA PT1 /USED AS A SWITCH TAD ALINE0 XRLOOP, DCA THISLN TAD PT1 SZA CLA /ON FIRST TRY DON'T ACTUALLY JMP .+7 /CHANGE LINE NUMBERS TAD THISLN DCA AXREG TAD LINENO UDF DCA I AXREG CDF TAD LINENO TAD LINE1 SZL /CHECK FOR LINE NUMBER EXCESS ERR04, ERROR /STEP WAS TOO LARGE! DCA LINENO UDF TAD I THISLN CDF SZA /DONE ALL LINES? JMP XRLOOP DCA LINENO /YES, BUT WAS IT ISZ PT1 /THE ACTUAL RESEQUENCE? JMP START-3 /YES JMP XRLOOP-1 XAUTO, TAD LINE1 /GET INCREMENTAL STEP SNA /IF ZERO OR NOT SPECIFIED IAC /ASSUME A STEP OF 1 DCA LINE1 JMS AUTAUT JMP START-3 XTAPE, TAD (TWT DCA PC JMP I (NULL /DISMISS US FOR THE MOMENT TWT, TAD TELSW SZA CLA /TTY BUSY? - WAIT! JMP XTAPE L7777 DCA OUTPUT /SWITCH ECHO OFF KLUDGE, TAD LINE1 SZA CLA /WANT AUTO LINE NUMBERS? JMS AUTAUT /YES JMP START-3 AUTAUT, 0 /FIND FIRST AUTO LINE NUMBER L7777 DCA LINENO FINDLN /GET NUMBER OF LAST LINE LINSERT,INSERT /ACTUALLY STORED ISZ THISLN UDF TAD I THISLN CDF DCA AUTOLN TAD AUTOLN CIA STL /COMPUTE THE SMALLEST TAD LINE1 /LINE NUMBER GREATER SNA SZL /THEN THE LAST ONE JMP .-2 /USING THE GIVEN STEP TAD AUTOLN DCA AUTOLN /STORE IT IN 'AUTOLN' SZL JMP I (ERR02 /LINE NUMBER EXCEEDS RANGE! JMP I AUTAUT PAGE
XDELET, 0 /UNCHAIN A LINE AND RECOVER THE SPACE FINDLN JMP I XDELET /LINE DOESN'T EXIST, RETURN TAD ALINE0 CIA TAD THISLN SNA CLA /DUMMY LINE? JMP I XDELET /DON'T DELETE IT! JMS I CXGETC /PASS OVER THE LINE CRTEST /TO MEASURE ITS LENGTH JMP .-2 TAD AXOUT CMA TAD THISLN DCA CNTR /HOLDS NEG. LENGTH NOW UDF TAD I THISLN /DISCONNECT INDEXES DCA I LASTLN TAD ALINE0 /START AT TOP OF TEXT UPDATE, DCA PT2 TAD I PT2 /GET ADDRESS OF NEXT LINE SNA /LAST LINE? JMP COLLECT /YES, DO TEXT COLLECTION! DCA PT1 /NO, SAVE ITS ADDRESS TAD THISLN CLL CIA TAD PT1 SZL CLA /PAST DELETED LINE? TAD CNTR /YES, CORRECT ADDRESS TAD PT1 /NO, DON'T CHANGE IT DCA I PT2 /RESTORE ADDRESS TAD PT1 JMP UPDATE COLLECT,L7777 /SET AUTOINDEXREGISTER TO FETCH TAD THISLN DCA AXREG TAD CNTR /SET AUTOINDEXREGISTER TO STORE CMA TAD THISLN DCA AXREG2 TAD AXIN /HOW MANY LOC'S TO COLLECT? CMA TAD AXREG2 DCA PT1 TAD CNTR /CORRECT TEXT POINTER TAD AXIN DCA AXIN TAD CNTR /CORRECT END OF BUFFER TAD BUFR DCA BUFR TAD I AXREG2 /WRAP UP ALL DCA I AXREG ISZ PT1 JMP .-3 CDF JMP XDELET+1 /RESET 'THISLN' & 'LASTLN' XFIND, 0 /**********FIND A GIVEN LINE*********** UDF TAD ALINE0 /BEGIN AT FIRST LINE DCA LASTLN TAD ALINE0 SEARCH, DCA THISLN /SAVE ADDRESS OF NEXT LINE TAD THISLN DCA AXREG /PUT IT IN AUTO-INDEX-REG. TAD LINENO /GIVEN LINE NUMBER CIA CLL /IS COMPARED WITH TAD I AXREG /NUMBER OF NEXT LINE SNA /FOUND IT? JMP FOUND /YES SZL CLA /ANY CHANCE TO GET IT? JMP FOUND+1 /NO, JUST PAST IT TAD THISLN DCA LASTLN /UPDATE POINTER TAD I THISLN SZA /END OF TEXT? JMP SEARCH SKP FOUND, ISZ XFIND /EXIT AT CALL+2 = FOUND CDF TAD THISLN /EXIT AT CALL+1 = NOT FOUND IAC DCA AXOUT /SET TEXTPOINTERS DCA OBYTE /FOR OUTPUT JMP I XFIND XENDLN, 0 /****INSERT NEW LINE, UPDATE POINTERS**** UDF TAD I LASTLN /ADDRESS OF LOGICAL NEXT LINE DCA I BUFR /STORED AT TOP OF NEW LINE TAD BUFR DCA I LASTLN /POINT TO NEW LINE TAD ADD SZA /SOME REST OF C.R.? DCA I AXIN CDF TAD AXIN IAC CLL /COMPUTE NEW END OF BUFFER DCA BUFR TAD AUTOLN SZA /AUTOMATIC MODE? TAD LINE1 /YES, INCREMENT LINE NUMBER DCA AUTOLN SNL /CHECK FOR OVERFLOW JMP I XENDLN JMP I (ERR02 /LINE NUMBER TOO LARGE! PAGE
XGETLN, 0 /********FORM A LINE NUMBER******** TAD NUMBER /PUT FIRST DIGIT DCA LINENO /IN 'LINENO' GETC /NEXT CHARACTER TESTN /A DIGIT? JMP LNZERO /NO TAD LINENO /YES, THEN MULTIPLY CLL RAL /LINE NUMBER BY 10 SNL /AND ADD NEW DIGIT CLL RAL SNL /ALWAYS CHECK FOR OVERFLOW! TAD LINENO SNL CLL RAL SNL TAD NUMBER SNL JMP XGETLN+2 CLA JMP ERR02 /LINE NUMBER > 4095 ! LNZERO, TAD LINENO SNA CLA ERR02, ERROR /LINE NUMBER 0 IS ILLEGAL! JMP I XGETLN S2LIST, START-3 GO XPACKC, 0 /********CHARACTER PACK ROUTINE******** TAD CHAR TAD M377 SNA /CHARACTER IS RUBOUT? JMP RUBIT TAD P166 SZA /CHECK FOR CTRL-TAB TAD M4 SNA CLA /AND C.R.! JMP EXTEND IGNORE /CHECK FOR LEGAL CHARACTER JMS PACKIT /PACK IT JMP I XPACKC /AND RETURN EXTEND, TAD P37 JMS PACKIT /INSERT EXTENSION CODE 77 JMP .-4 M377, -377 P166, 166 P37, 37 PACKIT, 0 SNA TAD CHAR TAD C240 /CODE TRANSFORMATION AND P77 ISZ IBYTE /WHERE TO PACK? JMP LEFT TAD ADD /RIGHT HALF, ADD PREVIOUSLY UDF DCA I AXIN /PACKED LEFT HALF, STORE BOTH CDF DCA ADD TAD AXIN CMA TAD ALINE0 SNA CLA ERR14, ERROR /LINE TOO LONG (80 CHARS MAX!) TAD LIMIT CLL CIA /CHECK FREE BUFFER SPACE TAD AXIN SNL CLA JMP I PACKIT ERR05, ERROR /TEXTBUFFER IS FULL! LEFT, BSW DCA ADD /STORE LEFT HALF TEMPORARILY L7777 DCA IBYTE /CORRECT PACK SWITCH JMP I PACKIT RUBIT, TAD IBYTE SZA CLA JMP .+6 TAD AXIN CIA TAD RUBST SMA CLA /RUBOUT PROTECTION JMP I XPACKC FREE2 TAD BAR /PRINT A BACK ARROW FOR PRINTC /EACH DELETED CHARACTER TAD AXIN DCA PT2 ISZ IBYTE /WHICH HALF? JMP RUB1 UDF TAD I PT2 /RIGHT HALF---LAST CHAR. IN 'ADD' AND P77 TAD M77 SZA CLA /EXTENSION CODE? JMP RUB3 RUB2, L7777 DCA IBYTE /CORRECT PACK SWITCH L7777 TAD AXIN DCA AXIN /BACKUP POINTER TAD I PT2 AND P7700 RUB3, CDF DCA ADD /RESET 'ADD' JMP I XPACKC RUB1, L0100 /LEFT HALF UDF TAD I PT2 AND P7700 SZA CLA /EXTENSION CODE? JMP RUB2 DCA I PT2 /SAVE CORRECTION JMP RUB2+1 PAGE
XGETC, 0 /********CHARACTER UNPACK ROUTINE******** JMS GET1 /GET 6 BITS OF PACKED CODE L0100 /ADD 240 TAD C140 /OR 140 ONLY IF EXTENDED CODE TAD CHAR DCA CHAR /NOW FULL ASCII IN 'CHAR' JMP I XGETC GET1, 0 ISZ OBYTE /WHICH HALF? JMP GET2 TAD TGET /RIGHT ONE GETIT, AND P77 /MASK OUT 6 BITS DCA CHAR TAD CHAR TAD M77 SZA CLA /EXTENSION CODE 77 ? JMP I GET1 ISZ GET1 /YES, POINT TO 2ND EXIT JMP GET1+1 /GET PROPER CHARACTER GET2, UDF TAD I AXOUT /FETCH A NEW WORD CDF DCA TGET /STORE IT TEMPORARILY L7777 DCA OBYTE /RESET UNPACK SWITCH TAD TGET BSW /GET FIRST HALF JMP GETIT C140, 140 XIGNOR, 0 /********SELECT CODES 240-336******** SNA TAD CHAR /THIS WAY: TAD M277 /277 IS MIDMOST CHARACTER SMA SZA /MAXIMUM CODE DIFFERENCE = 37 CIA TAD (37 SPA CLA /IN THE LIMITS? ISZ XIGNOR /NO, TAKE 2ND EXIT! JMP I XIGNOR /YES, NORMAL RETURN M277, -277 XTESTN, 0 /********SKIP ON DIGIT*********** TAD CHAR /GET THE CHARACTER TAD M260 /SUBTRACT 260 TO HAVE DCA NUMBER /THE BINARY DIGIT TAD NUMBER SPA CLA /COULD BE A DIGIT? JMP I XTESTN /NO, EXIT AT CALL+1 TAD CHAR /YES, MAKE SURE TAD M271 SPA SNA CLA ISZ XTESTN /YES IT IS! JMP I XTESTN M260, -260 M271, -271 COMADDR,START /ADDRESSES OF COMMAND ROUTINES XAUTO YLIST XPUNCH XEDIT XDEL XKILL XMOVE XRESEQ XTAPE XCAT XGET XOLD XNEW XSAVE XUNSAV XFILE XBYE XBRANC, 0 /********COMMAND BRANCHER********* SNA /USE CONTENTS OF AC IF #0 TAD CHAR /OTHERWISE 'CHAR' CIA DCA PT2 /STORE COMPLEMENT TAD I XBRANC /GET ADDRESS OF LIST -1 ISZ XBRANC DCA AXREG2 /IN AUTO INDEX REG. TAD I AXREG2 /GET NEXT ELEMENT SPA /RUNNING OUT OF LIST? JMP NOT /YES, EXIT TAD PT2 /COMPARE CODES SZA CLA /IDENTIFIED? JMP .-5 /NO, TRY ANOTHER TAD AXREG2 /YES, CURRENT ADDRESS PLUS TAD I XBRANC /DIFFERENCE OF LISTS DCA PT2 /GIVES POINTER TO DESTINATION TAD I PT2 /ADDRESS. GET ITSELF DCA PT2 /AND JMP I PT2 /JUMP TO THAT ADDRESS! NOT, ISZ XBRANC /EXIT AT CALL+3 CLA CLL /IF BRANCH ITEM JMP I XBRANC /WAS NOT IN LIST XNEW, L7777 /SCRATCH PROGRAM AREA AND XFILE, DCA LINE2 /GIVE A FILENAME FREE13 JMS I (QNAME /(SEE 'XOLD' FOR COMMENTS) JMS I (COMIN READC PACKC CRTEST JMP .-3 PACKC JMS I (COMOUT JMS I (XGETNAM ISZ LINE2 /"NEW" OR "FILE"? JMP START-3 SKP /DON'T DESTROY THE FILENAME XKILL, DCA NAME /CLEAR THE FILENAME SCRATCH JMP I (KLUDGE XSCR, 0 /CLEAR TEXT STORAGE UDF DCA I ALINE0 /CLEAR ADDRESS OF FIRST LINE CDF L0002 TAD ALINE0 DCA BUFR /RESET TO START OF TEXTBUFFER JMP I XSCR PAGE
XPRNTL, 0 /******** PRINT A LINE NUMBER ********* L4000 AND APUT /IF FILE OUTPUT (XPUTF<0!) TAD (4000 /OMIT LEADING ZEROES DCA LZSW TAD M4 DCA CNTR /SET 4-DIGIT COUNTER TAD PTDEC DCA PT2 /POINTER TO DECIMAL POWERS DCA CHAR /START WITH ZERO TAD LINENO /GET LINE NUMBER SKP ISZ CHAR /COUNT UNITS DCA PT1 /STORE TEMPORARELY DIGIT, TAD PT1 /GET IT AGAIN CLL /IMPORTANT FOR CHECKING! TAD I PT2 /SUBTRACT DECIMAL POWER SZL /ANOTHER 10^N ? JMP DIGIT-2 /YES ISZ PT2 /NO, NEXT DECIMAL POWER CLA TAD CHAR /GET DIGIT TAD LZSW /CHECK FOR LEADING ZERO SZA /SUPPRESS IT? JMP .+3 ISZ TABCNT /YES, BUT CORRECT TABS JMP .+6 AND P77 /FORM ASCII-CODE OF DIGIT TAD C260 PRINTC /AND PRINT IT L4000 DCA LZSW /ALL FURTHER DIGITS ARE VALID! DCA CHAR /RESET TO ZERO ISZ CNTR /DONE 4 DIGITS? JMP DIGIT /NO JMP I XPRNTL /YES, RETURN LZSW, 0 /LEADING ZERO SWITCH PTDEC, .+1 DECIMAL -1000 -100 -10 -1 OCTAL XCRTST, 0 TAD CHAR TAD MCR SNA CLA /IS CHAR. CARRIAGE RETURN? ISZ XCRTST /YES, EXIT AT CALL+2 JMP I XCRTST /NO, EXIT AT CALL+1 M2LIST, SCHAR GTCHAR SCHAR-1 RESTLN E2LIST, CHAIN FOUNDC XFREE2, 0 JMS XFREE JMP .+3 NOP JMP I XFREE2 /2 OR MORE FREE, OK TAD XFREE2 JMP FREEWT XFREE3, 0 JMS XFREE FREEC, 14 /NOP SKP JMP I XFREE3 /14 OR MORE FREE, OK TAD XFREE3 FREEWT, DCA PC /SAVE RESTART ADDRESS JMS I (XOR /AND DISMISS 2000 /SET O WAIT BIT XFREE, 0 /CHECK BUFFER STATUS UDF TAD I OPTRI CDF SZA CLA /ANY ROOM? JMP I XFREE /NO, EXIT 1 TAD OPTRI CIA TAD OPTRO SPA SNA TAD (40 CIA /-FREE BUFFER LOC'S IAC SNA JMP I XFREE /1 LOC FREE, EXIT 1 IAC SNA JMP I XFREE /2 LOC'S FREE, EXIT 1 ISZ XFREE /3 TO 13 FREE, EXIT 2 TAD FREEC SPA SNA CLA ISZ XFREE /14 OR MORE FREE, EXIT 3 JMP I XFREE PAGE
INTRPT, DCA UAC /SAVE CONTENTS OF MAJOR REGISTERS RAL DCA ULK MQA DCA UMQ SPL /POWER OKAY? JMP POK /YES RIB /INTERRUPT BUFFER GETS LOST ON POWER FAIL! DCA UFS /SAVE INSTR. & DATA FIELD TAD 0 DCA UPC /STORE BREAK ADDRESS DCA 0 /0=NOP ISZ 1 /POINT TO RECOVER ROUTINE HLT /DEAD! POK, TAD XREG3 /SAVE OTHER IMPORTANT LOC'S: DCA UXREG3 TAD ITM DCA UITM TAD I AXFREE DCA UXFREE TAD I AXIGNO DCA UXIGNO TAD XUDF DCA UXUDF JMS DTINT /CHECK DECTAPE FLAG DCA USER /START WITH USER 0 TAD (TAD UIOTS DCA WHO /FORM A 'TAD TSK' AT WHO WHO, HLT DCA XTSK /GET AND INSERT THE TSK IOT XTSK, HLT /THIS ONE REQUESTING? JMP NOTHE L7775 /YES, FORM AND INSERT: TAD XTSK DCA XTCF /TCF L7777 TAD XTCF DCA XTSF /TSF XTSF, HLT /INTERRUPT FROM TELEPRINTER? JMP .+4 XTCF, HLT /YES, CLEAR FLAG JMS I (TTY SKP JMS I (KEY NOTHE, ISZ USER /PREPARE FOR NEXT USER ISZ WHO JMP WHO END, TAD I LOOK JMS I (UCHECK TAD UXUDF /RESTORE IMPORTANT LOC'S DCA XUDF TAD UXIGNO DCA I AXIGNO TAD UXFREE DCA I AXFREE TAD UITM DCA ITM TAD UXREG3 DCA XREG3 6652 /KILL EVENTUAL PLOTTER INTERRUPTS 6662 TAD UMQ /RESTORE MAJOR REGISTERS MQL TAD ULK CLL RAR TAD UAC RMF /RESTORE FIELDS ION JMP I 0 /RESUME OPERATION /SAVE VALUES: UAC, 0 ULK, 0 UMQ, 0 UFS, 0 UPC, 0 UXREG3, 0 UITM, 0 UXFREE, 0 UXIGNO, 0 UXUDF, 0 AXFREE, XFREE UIOTS, U0KRB+7 /USER 0 TSK IOT IFNZRO U1KRB<U1KRB+7> IFNZRO U2KRB<U2KRB+7> IFNZRO U3KRB<U3KRB+7> IFNZRO U4KRB<U4KRB+7> IFNZRO U5KRB<U5KRB+7> IFNZRO U6KRB<U6KRB+7> IFNZRO U7KRB<U7KRB+7> JMP END /TERMINATES IOT LIST /(LOOK AT XTSK WHAT HAPPENS!) RECOVR, TFL /RECOVER HERE AFTER POWER FAILURE TAD (JMP I 2 /RESET INTERRUPT POINTER DCA 1 TAD UFS /RESET DATA FIELD AND (7 CLL RAL RTL TAD (CDF DCA RCDF TAD UMQ /RESTORE MAJOR REGISTERS MQL TAD ULK CLL RAR TAD UAC RCDF, CDF ION JMP I UPC /RESUME OPERATION PAGE
KEY, 0 /KEYBOARD SERVICE ROUTINE TAD USER JMS I (USWAP /SWAP USER IN TAD XIOT DCA .+1 /INSERT HIS KRB IOT HLT AND (177 SNA JMP I KEY /IGNORE CODE 0 AND 200 TAD (200 /FORCE PARITY BIT ON DCA SIN /SAVE CHARACTER TAD SIN TAD (-203 SNA CLA /CTRL-C? JMP BREAK /YES TAD SILENT /ECHO? SNA CLA JMP SPEC /NO ECHO, ALL CHAR'S ALLOWED TAD SIN TAD MCR SNA JMP SPEC-2 /CR IAC SZA TAD (2 SNA JMP SPEC /FF & LF IAC SNA JMP ECHO /TAB TAD (2 SZA TAD (-130 SNA JMP SPEC-2 /BELL & BACK ARROW TAD (-40 SNA CLA JMP SPEC /RUBOUT TAD SIN IGNORE SKP JMP I KEY /IGNORE ILLEGAL CHARACTERS ECHO, TAD SIN JMS I (OUTL /ECHO THE CHARACTER JMS STORE /AND STORE IT TAD IPTRO CIA TAD IPTRI SPA SNA TAD (40 TAD (-12 SPA CLA /AT LEAST 10 CHAR'S IN BUFFER? JMP I KEY /NO, EXIT ISTAT, L3777 /YES, CLEAR I WAIT BIT AND I FLAG DCA I FLAG JMP I KEY TAD SIN JMS I (OUTL SPEC, L7777 /RESET FOR ECHO DCA SILENT JMS STORE JMP ISTAT BREAK, JMS I (IERROR JMP I KEY STORE, 0 UDF TAD I IPTRI /ROOM IN BUFFER? SZA CLA ERR06, JMS I (IERROR /NO!!! UDF TAD SIN DCA I IPTRI CDF ISZ IPTRI /INCREMENT POINTER TAD IPTRI CIA TAD (40 TAD IPTR0 SZA CLA JMP I STORE TAD IPTR0 /RESET POINTER DCA IPTRI JMP I STORE XREADC, 0 /READC ROUTINE UDF CIF /DISABLE INTERRUPTS UNTIL 'JMP' TAD I IPTRO /GET CHAR DCA CHAR /SAVE IT DCA I IPTRO /EMPTY BUFFER LOC. CDF TAD CHAR SNA CLA /WAS THERE A CHARACTER? JMP LEAVE /NO, GIVE OTHERS A CHANCE! ISZ IPTRO /YES, BUMP BUFFER TAD IPTRO CIA TAD (40 TAD IPTR0 SZA CLA JMP .+3 /OK TAD IPTR0 DCA IPTRO /RESET BUFFER POINTER JMP I XREADC LEAVE, L7777 TAD XREADC DCA PC /SET TO RETRY THE ROUTINE JMS I (XOR /SET I WAIT BIT AND DISMISS 4000 PAGE
TTY, 0 /PRINTER SERVICE ROUTINE TAD USER JMS I (USWAP /SWAP USER IN DCA TELSW /CLEAR BUSY FLAG UDF TAD I OPTRO SNA /CHARACTER READY? JMP ROOM /NO JMS XOUTL /YES, PRINT IT UDF DCA I OPTRO /CLEAR AND ISZ OPTRO /BUMP BUFFER TAD OPTRO CIA TAD IPTR0 SZA CLA JMP ROOM /OK TAD IPTR0 TAD (-40 DCA OPTRO /RESET BUFFER POINTER ROOM, JMS I (XFREE /ROOM AVAILABLE? NOP JMP I TTY /NOT ENOUGH! L5777 /YES, CLEAR O WAIT BIT AND I FLAG DCA I FLAG JMP I TTY /EXIT OUTL, 0 SNA /USE (CHAR) IF AC=0 TAD CHAR TAD (-211 SNA /TABULATION? JMP TABL TAD (211 /NO JMS XOUTL /DO OUTPUT TAD XREG3 TAD MCR SNA CLA /WAS IT A CR? JMP NEWLIN TAD XREG3 IGNORE /NONPRINTING CHARACTER? ISZ TABCNT /NO, COUNT CHARACTER JMP I OUTL JMP TABSTOP NEWLIN, TAD CLF /APPEND A LF JMS XOUTL TAD LNPSW /SETUP TAB COUNTER TABSTOP,TAD TABS DCA TABCNT JMP I OUTL TABL, TAD C240 /PRINT NUMBER OF SPACES JMS XOUTL ISZ TABCNT JMP .-3 JMP TABSTOP XOUTL, 0 CDF DCA XREG3 /SAVE CHAR TAD OUTPUT SZA CLA JMP NOECHO TAD TELSW /BUSY? SZA CLA JMP SOFT /YES TAD (10 TAD XIOT DCA .+2 /INSERT USERS TLS IOT TAD XREG3 HLT DCA TELSW /SET BUSY JMP I XOUTL SOFT, UDF TAD I OPTRI SZA CLA /ROOM IN BUFFER? ERR07, JMS I (IERROR /NO!!! UDF TAD XREG3 DCA I OPTRI /ENTER CHARACTER ISZ OPTRI /INCREMENT POINTER TAD OPTRI CIA TAD IPTR0 SZA CLA JMP .+4 /OK TAD IPTR0 TAD (-40 DCA OPTRI /RESET POINTER NOECHO, CDF JMP I XOUTL XPRINT, 0 /PRINTC ROUTINE IOF JMS OUTL ION JMP I XPRINT TABS, -10 /DISTANCE OF TABSTOPS PAGE
/ S C H E D U L E R NULL, ION CDF TAD LOOK TAD MLOOKE /CHECK STATUS WORD POINTER SPA CLA JMP .+4 /OK, LOOK AT NEXT CIF /NO INTERRUPT UNTIL LOOK IS ISZ'D TAD LOOKST DCA LOOK /RESET POINTER ISZ LOOK TAD I LOOK /GET STATUS WORD AND P7700 SZA CLA JMP NULL /NO 'GO' FOR THIS ONE TAD I LOOK IOF JMS USWAP /SWAP IN THIS USER ION JMP I PC /RESTART HIM USWAP, NULL /USER SWAP ROUTINE AND (7 DCA SIN /SAVE # OF NEW USER TAD DECK CIA TAD SIN SNA CLA /JUST HE'S IN? JMP DTCHECK /OK, SAVED SOME WORK TAD DECK /NO JMS UFIND /LOCATE OLD ONE TAD UCDF DCA XFIELD TAD E1LIST+1 DCA USCH TAD I XREG2 DCA I XREG /SWAP OUT OLD JMS DTINT ISZ FLAG JMP .-4 TAD SIN JMS UFIND /LOCATE NEW USER NEWUSR, TAD I XREG DCA I XREG2 /SWAP IN NEW JMS DTINT ISZ FLAG JMP .-4 TAD USCH DCA E1LIST+1 TAD XFIELD DCA UCDF TAD SIN DCA DECK TAD LOOKST IAC TAD DECK DCA FLAG /POINT TO STATUS WORD DTCHECK,JMS DTINT JMP I USWAP *2677 UFIND, NEWUSR ENTRY, CMA /S T A R T I N G A D D R.: 2700 DCA FLAG TAD (SWAP0-SWPLEN-1 TAD (SWPLEN ISZ FLAG JMP .-2 DCA XREG TAD (SWPBEG-1 DCA XREG2 TAD (-SWPLEN /SWAP COUNT DCA FLAG JMP I UFIND /USER STATUS WORDS: USER0, 0 USER1, 1 USER2, 2 USER3, 3 USER4, 4 USER5, 5 USER6, 6 USER7, 7 XOR, 0 /OR TO USER STATUS WORD TAD I XOR CMA AND I LOOK TAD I XOR DCA I LOOK JMP NULL UCHECK, 0 /CHECK WAIT BITS AND P7700 SZA CLA JMP I UCHECK TAD I LOOK JMS USWAP JMP I UCHECK PAGE
/ E R R O R H A N D L I N G IERROR, 0 /COMING FROM INTERRUPT ROUTINE L7777 TAD (-40 TAD IPTR0 DCA XREG3 TAD (-40 DCA ITM UDF DCA I XREG3 /CLEAR OUTPUT BUFFER ISZ ITM JMP .-2 CDF TAD OPTRI DCA OPTRO TAD IERROR /SAVE ERROR ADDRESS DCA XERROR TAD LOOK CIA TAD FLAG SZA CLA /RUNNING USER? JMP .+4 /NO IERRO1, CDF /YES TAD (NULL DCA IERROR /PREPARE FOR DISMISS TAD XERROR DCA SILENT JMS I (IERDTA L3777 AND I FLAG DCA I FLAG TAD (ERRORX DCA PC JMP I IERROR XERROR, 0 /COMING FROM MAINLINE IOF CLA JMP IERRO1 ERRORX, TAD I LOOK /CLEAR ERROR FLAG AND (7767 DCA I LOOK TAD I (DTQ1 /CLEAR DECTAPE QUEUE DCA ITM /(IF NECESSARY) TAD DECK CMA TAD I ITM SNA CLA /USING THE DECTAPE? JMS I (DTFREE /RELEASE THE TAPE TAD CXGETC /SWITCH TO NORMAL I/O DCA AGET TAD (XPRINT DCA APUT DCA OUTPUT /RESET ECHO L7777 TAD IPTR0 DCA XREG3 TAD (-40 DCA ITM UDF DCA I XREG3 /CLEAR INPUT BUFFER ISZ ITM JMP .-2 CDF TAD IPTRI DCA IPTRO TAD (ERRLST-1 DCA XREG3 DCA LINENO SKP ISZ LINENO TAD I XREG3 TAD SILENT SZA CLA JMP .-4 TAD LINENO SNA JMP CTRLC CLL RTL RAL TAD (ERR-1 DCA AXOUT /POINT TO MESSAGE TAD (-10 DCA CNTR /ALWAYS 10 WORDS! TAD CCR PRINTC TAD CBELL PRINTC /RECLAIME ATTENTION TAD I AXOUT PRINT2 ISZ CNTR JMP .-3 TAD CBELL PRINTC JMP .+3 CTRLC, TAD (3603 /"^C" PRINT2 TAD CCR PRINTC JMP BEGIN ERRLST, -1-BREAK -1-ERR01 -1-ERR02 -1-ERR03 -1-ERR04 -1-ERR05 -1-ERR06 /CHAR TYPED IN TO FAST -1-ERR07 /OUTPUT OVERLOAD, CHAR LOST -2-DXIT /DECTAPE ERROR -1-ERR09 /ILLEGAL FILENAME -1-ERR10 /FILE DOESN'T EXIST -1-ERR11 /MISSING LINE NO. IN OLD -1-ERR12 /NO ROOM ON TAPE -1-ERR13 /NOTHING TO SAVE -1-ERR14 /LINE TOO LONG -1-MUTOR /I D E N T I F I E R PAGE
DTQ, ZBLOCK 10 /DECTAPE QUEUE DTQ1, DTQ /QUEUE EMPTY POINTER DTQ2, DTQ /QUEUE FILL POINTER DTGET, 0 /GET THE DECTAPE JMS DTCHK /USER ALREADY HAS THE TAPE? DCA I DTQ2 /NO, MAKE ENTRY IN QUEUE TAD DTQ2 IAC /BUMP POINTER AND (7607 DCA DTQ2 TAD DTQ1 /WAS THE QUEUE EMPTY? CLL CMA TAD DTQ2 AND (7 SNA CLA JMP DTG1 /YES, GIVE THIS JOB THE TAPE TAD DTGET /NO, SAVE RESTART ADDRESS DCA PC JMS I (XOR /SET DT WAIT BIT AND DISMISS DT1000, 1000 DTG1, ION /RETURN TO THE JOB JMP I DTGET /(WITH THE DECTAPE) DTCHK, 0 IOF L0001 TAD DECK /GET USER# + 1 DCA DTUSR /STORE IT TEMPORARELY TAD I DTQ1 /GET QUEUE ENTRY CIA TAD DTUSR SNA CLA /THIS ONE REQUESTIND? JMP DTG1 /YES, GIVE HIM THE TAPE TAD DTUSR /NO JMP I DTCHK DTUSR, 0 DTFREE, 0 /RELEASE THE DECTAPE DCA I DTQ1 /CLEAR QUEUE SLOT TAD DTQ1 IAC /BUMP QUEUE POINTER AND (7607 DCA DTQ1 TAD I DTQ1 /IS THERE ANOTHER REQUEST? SNA JMP I DTFREE /NO, ALL DONE TAD LOOKST /YES, POINT TO STATUS WORD DCA ITM TAD I ITM AND (6777 DCA I ITM /CLEAR DT WAIT BIT JMP I DTFREE IERDTA, 0 /COMING FROM ERROR ROUTINE TAD I FLAG /GET STATUS WORD AND DT1000 SNA CLA /DECTAPE WAIT? JMP IEREND /NO TAD DECK CMA /-(USER# + 1) DCA IERR2 TAD DTQ1 DCA IERR3 TAD I IERR3 TAD IERR2 SNA CLA /IS HIS ENTRY AT THE TOP JMP IEREND /YES SQUQU, DCA IERR4 /REMOVE QUEUE ENTRY OF TAD I IERR3 /USER IN ERROR DCA IERR5 /AND SQUISH THE QUEUE TAD IERR4 DCA I IERR3 TAD IERR5 TAD IERR2 SNA CLA JMP IERFIN TAD IERR3 IAC AND (7607 DCA IERR3 TAD IERR5 JMP SQUQU IERFIN, TAD DTQ1 /BUMP QUEUE POINTER IAC AND (7607 DCA DTQ1 TAD I FLAG /CLEAR DT WAIT BIT AND (6777 DCA I FLAG IEREND, TAD I FLAG AND (3767 TAD (10 /SET ERROR BIT DCA I FLAG JMP I IERDTA IERR2, 0 /-(USER# + 1) IERR3, 0 /=DTQ1 IERR4, 0 /TEMP'S FOR SQUISH IERR5, 0 DTDIS, TAD LOOK /DECTAPE DISMISS SEQUENCE DCA DTLOOK /POINT TO STATUS OF DECTAPE USER TAD I DTLOOK AND (6777 TAD DT1000 /SET DT WAIT BIT DCA I DTLOOK TAD (DXIT /SAVE RETURN ADDRESS DCA PC JMP I (NULL /AND DISMISS DTEND, CDF TAD I DTLOOK AND (6777 DCA I DTLOOK /CLEAR DT WAIT BIT JMP DTINT+2 /FINISH INTERRUPT PAGE
IFDEF TC08 < /DECTAPE SERVICE ROUTINE DTXA=6764 DTLB=6774 DTRB=6772 DTRA=6761 DTCA=6762 DTLA=6766 DTSF=6771 WC=7754 CA=7755 DTAPE, 0 IOF TAD (CDF CIF 0 RDF /SAVE CALLING FIELD DCA DXIT+1 TAD I DTAPE /GET OS/8-STYLE ARGUMENTS CLL RAL AND DT7600 DCA DWDS /NUMBER OF WORDS TO TRANSFER CML RAL TAD (DR128 DCA DRET /READ-WRITE RETURN AFTER SEARCH TAD I DTAPE AND (70 DCA DTFLD /BUFFER FIELD ISZ DTAPE L7777 TAD I DTAPE DCA DCORE /BUFFER ADDRESS - 1 ISZ DTAPE TAD I DTAPE CLL RAL /*2 FOR STANDARD BLOCKS DCA DTEM /STARTING BLOCK NUMBER ISZ DTAPE TAD (DTSF DCA DTINT+1 /PUT DTSF IN SKIP CHAIN DTS1, CDF TAD (DTBLK /CA=DTBLK DCA I (CA TAD (DINT-1 /INTERRUPT RETURN ADDRESS DCA DTOP TAD (1614 /SEARCH NORMAL REVERSE DTLA DTLB /DTBLK IS IN FIELD 0! JMP I (DTDIS /DISMISS DXIT, DCA DTINT+1 /ZAP DTSF IN SKIP CHAIN HLT JMP I DTAPE DR128, TAD (20 /WRITE (NOT READ) 40-20 TAD (32 /READ NORMAL, CANCEL SEARCH 20+10 DTXA TAD DCORE CDF DCA I (CA /CA=BUFFER ADDRESS-1 TAD DTFLD DTLB /FIELD OF BUFFER ISZ DTOP /INTERRUPT RETURN FOR READ-WRITE DTGO, TAD DT7600 DCA I (WC /WC=-128 DR127, TAD (2 /EXIT OF DECTAPE SERVICE DTXA JMP DTINT+2 JMP DTS3A DINT, DTRB /READ STATUS B SPA CLA /ANY ERROR? JMP DER1 TAD DWDS /BUMP COUNT TAD DT7600 DCA DWDS TAD DWDS SZA CLA /MORE? JMP DTGO TAD (602 /COMPLEMENT MOTION & DIRECTION DTXA JMP I (DTEND DTS3A, TAD I DTLOOK AND (10 /LOOK AT ERROR FLAG SZA CLA JMP DTKILL /CTRL-C OR ERROR STOPS SEARCH DTRB RTL SPA CLA /END ZONE? JMP DTURNX /YES, TURN (MOTION BIT =0) DTRB SPA CLA /DECTAPE ERROR? JMP DER1 DTRA RTL RTL /FOR-REV BIT IN LINK DT7600, 7600 /CLA TAD DTBLK CIA TAD DTEM SNA /FOUND THE BLOCK? JMP DTFIND /YES CIA /NOT YET SNL /ANY CHANCE TO GET IT? IAC /2 MORE BLOCKS FOR TURNAROUND SNL CLA DTURN, TAD (400 /NO, TURN JMP DR127 /YES, GO ON SEARCHING DTFIND, SNL CLA /HOW ABOUT DIRECTION? JMP DR127 JMP I DRET /OKAY! DO READ OR WRITE DTURNX, TAD (576 /REVERSE OUT OF END ZONE JMP DR127 DER1, TAD (ERROR DCA DXIT+1 DTKILL, DCA DTINT+1 /ZAP DTSF IN SKIP CHAIN DTRA AND (774 DTXA JMP I (DTEND DWDS, 0 /NO. OF WORDS DTFLD, 0 /FIELD OF BUFFER DCORE, 0 /ADDRESS OF BUFFER DTEM, 0 /TEMP FOR BLOCK# DTBLK, 0 /ACTUAL BLOCK# PAGE >
IFDEF RK8E < /DISK SERVICE ROUTINE /(SIMPLIFIED - READS OR WRITES / ONLY 1 BLOCK OF 256 WORDS) DSKP=6741 DCLR=6742 DLAG=6743 DLCA=6744 DRST=6745 DLDC=6746 DISK, 0 IOF L4000 AND I DISK /GET READ-WRITE BIT DCA RK8RW TAD (CDF CIF 0 RDF /SETUP RETURN FIELD DCA DXIT+1 TAD I DISK AND (70 DCA RK8FLD /BUFFER FIELD ISZ DISK L7777 TAD I DISK /BUFFER ADDRESS - 1 DCA RK8BUF ISZ DISK TAD I DISK DCA RK8BLK /STARTING BLOCK (DISK ADDRESS) ISZ DISK TAD (DSKP /PUT DSKP IN SKIP CHAIN DCA DTINT+1 TAD (RK8INT /SETUP RETURN AFTER DONE ADDRESS DCA DTOP TAD RK8BUF /SPECIFY BUFFER ADDRESS DLCA TAD RK8RW /SETUP COMMAND REGISTER TAD RK8FLD TAD (400 DLDC TAD RK8BLK /LOAD ADDRESS AND GO DLAG JMP I (DTDIS /DISMISS US RK8INT, DRST /READ DISK STATUS CLL RAL SZA CLA /ANY ERROR? JMP RK8ERR /YES DCLR /OKAY, STOP DISK JMP I (DTEND /AND LEAVE DXIT, DCA DTINT+1 /ZAP DSKP IN SKIP CHAIN HLT JMP I DISK RK8ERR, DCLR /STOP ALL TAD (ERROR /INSERT ERROR RETURN DCA DXIT+1 DCA DTINT+1 /ZAP DSKP IN SKIP CHAIN JMP I (DTEND RK8RW, 0 RK8FLD, 0 RK8BUF, 0 RK8BLK, 0 PAGE >
CATNEX, 0 /GET NEXT DIRECTORY SEGMENT IF ANY TAD I (DIRBUF+2 SNA JMP I CATNEX /NO NEXT SEGMENT SKP /YES, RETURN TO GETCAT+1 XGETCAT,0 SNA /ENTERED WITH SEGMENT NO.? L0001 /NO, ASSUME FIRST SEGMENT DCA CATBLK DECTAPE 0200 /READ 2 PAGES (=SEGMENT), FIELD 0 ADIRBUF,DIRBUF CATBLK, 1 JMS SHEADR /PROCESS SEGMENT HEADER JMP I XGETCAT XPUTCAT,0 TAD CATBLK DCA .+4 DECTAPE 4200 /WRITE OUT ONE SEGMENT DIRBUF 0000 JMS SHEADR JMP I XPUTCAT SHEADR, 0 TAD I ADIRBUF DCA ENTRIES /NO. OF ENTRIES IN THIS SEGMENT TAD I (DIRBUF+1 DCA BLOCK /BLOCK NO. OF FIRST FILE TAD I (DIRBUF+4 CIA CLL DCA WASTE /ADDITIONAL INFORMATION WORDS TAD (DIRBUF+4 DCA AXREG /READ DIRECTORY POINTER JMP I SHEADR XCAT, TAD CLF /LIST THE DIRECTORY PRINTC TAD M4 /4 COLUMNS DCA LINE1 JMS I (DTGET /GET THE TAPE GETCAT /READ IN 1ST SEGMENT CATLP, FREE13 /MAKE ROOM TO PRINT TAD I AXREG /GET 1ST WORD OF ENTRY SNA /EMPTY FILE? JMP EMPTY PRINT2 /NO, PRINT CHAR'S 1&2 TAD I AXREG PRINT2 /3&4 TAD I AXREG PRINT2 /5&6 OF NAME TAD (". PRINTC TAD I AXREG PRINT2 /EXTENSION BUMPXR ELEN, PRINT2 /2 SPACES TAD I AXREG CIA /LENGTH OF FILE DCA LINENO FREE13 PRNTLN ISZ LINE1 /END OF LINE? JMP .+6 /NO TAD CCR /YES, DO A C.R. PRINTC TAD M4 /AND RESET THE COLUMN COUNTER DCA LINE1 JMP .+3 PRINT2 /4 SPACES BETWEEN COLUMNS PRINT2 ISZ ENTRIES /DONE THIS SEGMENT? JMP CATLP /NO JMS CATNEX /YES, READ IN NEXT JMS I (DTFREE /RETURN TO GETCAT+1 TAD CCR /OR HERE IF DONE LAST ONE PRINTC JMP START-3 EMPTY, TAD (7405 /PRINT "<EMPTY>" PRINT2 TAD (1520 PRINT2 TAD (2431 PRINT2 TAD ("> PRINTC PRINT2 JMP ELEN AINFOS, 0 /PASS OVER ADDITIONAL INFO WORDS TAD WASTE TAD AXREG DCA AXREG JMP I AINFOS PRITWO, 0 /PRINT 2 STRIPPED ASCII'S (AC) DCA TEMP TAD TEMP BSW JMS PRIONE TAD TEMP JMS PRIONE JMP I PRITWO PRIONE, 0 /UNPACK AND PRINT 6-BIT ASCII AND P77 SNA TAD C240 /PRINT NULLS AS SPACES! TAD C240 AND P77 TAD C240 PRINTC JMP I PRIONE PAGE
QNAME, 0 /REQUEST A FILENAME TAD (-5 DCA CNTR TAD (NAMEX-1 DCA AXOUT TAD I AXOUT PRINT2 ISZ CNTR JMP .-3 JMP I QNAME PTNAME, 0 /ADDRESS OF FILENAME XGETNAM,0 /PACK NAME.EX TAD (NAME /CLEAR NAME DCA PTNAME TAD PTNAME DCA PT1 TAD M4 DCA CNTR DCA I PT1 ISZ PT1 ISZ CNTR JMP .-3 DCA EXT2 /FIRST SET FOR NAME PACKING SKP /1ST CHAR GOT IN 'COMOUT' NLOOP, GETC TESTN JMS ALPHA SKP /COME HERE WITH A-Z OR 0-9 JMP NDONE /".", CR OR ERROR EXT2, 0 /OR L7776 FOR .EX TAD (-6 TAD CNTR SMA CLA JMP NLOOP /ONLY 6 CHAR'S VALID! TAD CNTR CLL RAR TAD PTNAME DCA PT1 /POINT INTO NAME TAD CHAR AND P77 SNL /WHICH HALF? BSW TAD I PT1 /ADD IN DCA I PT1 ISZ CNTR /COUNT CHAR'S JMP NLOOP XGETEXT,L0006 DCA CNTR TAD (L7776 /ALLOW 2 EXTRA CHAR'S DCA EXT2 JMP NLOOP NDONE, TAD CNTR SNA CLA JMP ERR09 TAD CHAR TAD (-". SNA /FOLLOWS EXTENSION? JMP XGETEXT /YES TAD (".-215 SZA CLA ERR09, ERROR /0 OR ILLEGAL CHAR'S IN FILENAME JMP I XGETNAM ALPHA, 0 /SKIP ON NON-ALPHA TAD CHAR TAD (-"Z-1 CLL TAD ("Z+1-"A SNL CLA ISZ ALPHA JMP I ALPHA XLOOKUP,0 /LOOKUP FOR NAME.EX JMS DIRSRCH ERR10, ERROR /NAME.EX DOESN'T EXIST! JMP I XLOOKUP DIRSRCH,0 TAD (NAME DCA PTNAME GETCAT /GET FIRST SEGMENT SRCHLP, TAD I AXREG SNA CLA /EMPTY FILE? JMP SKPEMT L7777 /NO, RESET POINTER TAD AXREG DCA AXREG TAD M4 /NAME.EX PACKED = 4 WORDS DCA WDS4 L7777 TAD PTNAME /POINT TO NAME DCA AXREG2 TAD I AXREG2 CIA TAD I AXREG SZA CLA /MATCH? JMP NXTFIL /NO ISZ WDS4 /4TH OF FOUR? --- FOUND! JMP .-6 BUMPXR /YES, PASS ADD. WORDS TAD I AXREG SNA /PERMANENT FILE? JMP SKPEMT+4 DCA FILEN /YES, GET LENGTH OF FILE ISZ DIRSRCH /TAKE FOUND RETURN TAD BLOCK /WITH STARTING BLOCK NO. IN AC JMP I DIRSRCH NXTFIL, TAD WDS4 CMA BUMPXR SKPEMT, TAD I AXREG /COUNT BLOCKS CIA TAD BLOCK DCA BLOCK ISZ ENTRIES /ALL ENTRIES? JMP SRCHLP JMS I (CATNEX /YES, GET NEXT SEGMENT JMP I DIRSRCH /NOT FOUND EXIT WDS4, -4 PAGE
XGET, TAD (GNAME-NAME /SWITCH TO 'GET'-FILENAME XOLD, DCA LINE2 FREE13 /MAKE ROOM TO PRINT JMS I (QNAME /"NAME.EX---" JMS I (COMIN /SET FOR INPUT READC /FILENAME.EXTENSION PACKC CRTEST JMP .-3 PACKC JMS I (DTGET /NOW GET THE TAPE JMS I (COMOUT TAD LINE2 JMS I (XGETNAM /PACK NAME.EX OS/8-LIKE TAD LINE2 SNA /OLD OR GET? SCRATCH /OLD --- CLEAR TEXT STORAGE LOOKUP /LOCATE THE FILE DCA IBLOCK DCA BP /INITIALIZE 'GETF' DCA C3 TAD LINE1 SZA CLA /AUTOMATIC LINE NUMBERS? JMS I (AUTAUT /YES TAD (XGETF /SWITCH TO FILE INPUT DCA AGET OLDLIN, GETC TAD AUTOLN DCA LINENO TAD AUTOLN SZA CLA /AUTO LINE NUMBERS? JMP ALN /YES CRTEST /INITIAL CR? - IGNORE SKP JMP OLDLIN TAD CHAR TAD (-240 SNA CLA /LEADING SPACES? JMP OLDLIN /YES TESTN ERR11, ERROR /HAVE TO SPECIFY AUTO LINE NO. GETLN ALN, TAD BUFR DCA AXIN DCA IBYTE TAD LINENO UDF DCA I AXIN CDF SKP GETC PACKC CRTEST JMP .-3 DELETE ENDLN JMP OLDLIN OLDEX, TAD CXGETC DCA AGET JMP I (DONE XGETF, 0 CLA CLL ISZ C3 /3RD CHAR OF 3? JMP G12 /NO L7775 /YES, RESET 3-WAY SWITCH DCA C3 L7776 /BACK UP POINTER TAD BP DCA BP TAD I BP /GET FIRST HALF ISZ BP AND (7400 CLL RTL RTL DCA CHAR TAD I BP /GET SECOND HALF AND (7400 TAD CHAR /COMBINE RTL RTL RAL JMP GEXIT G12, TAD BP /MORE OF BUFFER? AND (377 C12M32, SZA CLA SMA SNL /=7760=12-32 JMP GET12 /YES TAD (DTBUFR /NO, RESET POINTER DCA BP DECTAPE 0200 /READ 2 PAGES = 1 BLOCK DTBUFR IBLOCK, 0 ISZ IBLOCK L7776 /HANDLE 3-WAY SWITCH DCA C3 GET12, TAD I BP /GET 1ST AND 2ND CHAR GEXIT, ISZ BP AND (177 SNA JMP XGETF+1 /IGNORE NULLS TAD (-12 CLL RTR SNA JMP XGETF+1 /LF'S AND FF'S RTL TAD C12M32 SNA /END OF FILE? JMP OLDEX /YES, TAKE EOF-RETURN TAD Z232 /I LIKE PARITY BIT ON! DCA CHAR JMP I XGETF C3, -3 /3 CHAR UNPACK SWITCH BP, DTBUFR /DECTAPE BUFFER POINTER PAGE
XENTER, 0 /ENTER "NAME.EX" AS TENTATIVE FILE DCA SEGMENT /INITIALIZE FOR SEARCHING DCA AENTRY /THE LARGEST EMPTY FILE DCA LEMPTY DCA SBLOCK DCA PASS /0=SEARCHING, 1=FOUND GETCAT /READ IN FIRST DIRECTORY SEGMENT JMS I (CONSOL /CONSOLIDATE IT (YOU NEVER KNOW!) MLOOP, TAD I AXREG SNA CLA /EMPTY FILE? JMP EMTF /YES L0003 /NO, PASS OVER BUMPXR TAD I AXREG /GET LENGTH BLOOP, CIA TAD BLOCK /ADD IT IN DCA BLOCK ELOOP, ISZ ENTRIES /AT END OF THIS SEGMENT? JMP MLOOP TAD PASS /YES, BUT WHICH PASS? SZA CLA JMP TENT /JUST FOUND, DO REAL ENTER JMS I (CATNEX /STILL SEARCHING, GET NEXT SEGMENT, /RETURN TO GETCAT+1 IF ANY TAD SEGMENT /SEARCHED THROUGH ENTIRE DIRECTORY SNA /RESULT? ENTREX, JMP I XENTER /NO EMPTY AT ALL - VERY BAD! ISZ PASS /OKAY, NOW DO 2ND PASS ISZ I (XGETCAT /THIS TO SKIP CONSOLIDATION JMP I (XGETCAT+3/REREAD DIRECTORY SEGMENT WITH /LARGEST EMPTY, RETURN TO GETCAT+2 EMTF, TAD PASS /WHICH PASS? SNA CLA JMP .+3 ISZ AXREG /2ND, HURRY UP TO END OF SEGMENT JMP ELOOP TAD I AXREG /1ST PASS, DCA XEMPTY /SAVE LENGTH OF EMPTY TAD LEMPTY CIA CLL TAD XEMPTY SZL CLA /LARGER THEN BEST? JMP SBLC /NO, NOTHING TO DO TAD XEMPTY /YES, MAKE THIS TO NEW BEST EMPTY DCA LEMPTY L7776 TAD AXREG DCA AENTRY /SAVE POINTER TO BEST EMPTY TAD I (CATBLK DCA SEGMENT /AND SEGMENT BLOCK NO. TAD BLOCK DCA SBLOCK /AND STARTING BLOCK SBLC, TAD XEMPTY JMP BLOOP TENT, TAD AXREG DCA LENT L0004 BUMPXR TAD AXREG /SEGMENT MUST HAVE ROOM TAD WASTE /FOR ONE MORE FILE ENTRY TAD (-DIRBUF-372/AFTER THIS FILE IS ENTERED SMA CLA /HOW ABOUT THAT? JMP I (DLINK /BAD - MUST LINK TO NEXT SEGMENT TLOOP, TAD I LENT /OKAY, MAKE A HOLE FOR NEW ENTRY DCA I AXREG L7776 TAD AXREG DCA AXREG L7777 TAD LENT DCA LENT TAD LENT CIA STL TAD AENTRY SZL SNA CLA /PUSHED UP ALL? JMP TLOOP TAD AENTRY /YES, NOW INSERT: DCA AXREG TAD NAME /NAME.EX DCA I AXREG TAD NAME+1 DCA I AXREG TAD NAME+2 DCA I AXREG TAD EX DCA I AXREG CDF 10 TAD I (7666 /GET SYSTEM DATE CDF DCA I AXREG /0=NO DATE L7777 BUMPXR /OVER ADD. INFOS (-DATE WORD) DCA I AXREG /FILE LENGTH = 0 TAD AXREG DCA I (DIRBUF+3 /SAVE POINTER TO LENGTH WORD L7777 TAD I (DIRBUF DCA I (DIRBUF /INCREASE FILE COUNT PUTCAT /WRITE OUT CHANGED SEGMENT TAD SBLOCK /TAKE OKAY-EXIT WITH ISZ XENTER /STARTING BLOCK NO. IN AC JMP I XENTER LEMPTY, 0 /-LENGTH OF LARGEST EMPTY SBLOCK, 0 /STARTING BLOCK NO. PASS, 0 /FOR LOGIC XEMPTY, 0 /-LENGTH OF CHECKED EMPTY GNAME, ZBLOCK 4 /TEMPORARY FILENAME (GET-COMMAND) NAMEX, TEXT /NAME.EX---/ PAGE
DLINK, TAD I (DIRBUF+2 /DIRECTORY LINK ROUTINE SNA CLA /IS IT LAST SEGMENT? JMP DIREXT /YES, EXTEND DIRECTORY ISZ I (DIRBUF /LAST ENTRY SHALL BE LINKED PUTCAT /WRITE OUT THIS SEGMENT JMS SKIPF /POINT AT END OF SHORTENED DIRECTORY DCA CWORDS /PREPARE TO MOVE LAST ENTRY TAD (DTBUFR-1 /(ANY FREE BUFFER IS GOOD!) DCA AXREG2 TAD I AXREG /SAVE IT IN BUFFER DCA I AXREG2 ISZ CWORDS /COUNTING WORDS TAD AXREG CIA TAD LENT SZA CLA /UP TO END OF LAST ENTRY JMP .-7 TAD I LENT DCA MOVLEN /SAVE LENGTH OF MOVED ENTRY TAD I (DIRBUF+2 GETCAT /READ IN NEXT SEGMENT TAD BLOCK TAD MOVLEN /UPDATE FILE ORIGIN DCA I (DIRBUF+1 JMS SKIPF /FIND LAST LOC IN NEW SEGMENT DLOOP, TAD AXREG /PUSH UP ALL ENTRIES DCA PT1 TAD AXREG TAD CWORDS DCA PT2 TAD I PT1 DCA I PT2 L7777 TAD AXREG DCA AXREG TAD AXREG TAD (-DIRBUF-4 SZA CLA /ARE WE THROUGH? JMP DLOOP TAD (DTBUFR-1 /YES, NOW MOVE IN SAVED SEGMENT DCA AXREG L7777 TAD I (DIRBUF DCA I (DIRBUF /INCREASE NO. OF ENTRIES TAD CWORDS CIA DMOVE, DCA CWORDS TAD (DIRBUF+4 DCA AXREG2 TAD I AXREG /THE VERY MOVE IN! DCA I AXREG2 ISZ CWORDS JMP .-3 JMS I (SHEADR JMS SKIPF TAD AXREG DCA LENT /=LAST USED LOC IN SEGMENT TAD AXREG TAD WASTE TAD (-DIRBUF-372 SMA CLA /NOW THIS SEGMENT TOO BIG? JMP DLINK /HELP ME GOD! PUTCAT /OKAY, WRITE IT OUT JMP I (XENTER+1 CWORDS, 0 /=-2(EMPTY) OR 5+WASTE MOVLEN, 0 /-LENGTH OF FILE / NO. OF BLOCKS IN SEGM. NEWENT, -10 IAC DIREXT, TAD NEWENT /NO. OF ENTRIES WE WANT TO MOVE DCA PT1 /INTO NEW LAST SEGMENT TAD PT1 /(10 IF POSSIBLE) CIA TAD I (DIRBUF SMA /WERE THERE AT LEAST (PT1)+1? JMP DIREXT-1 /NO, TRY ONE LESS DCA I (DIRBUF /YES, ADJUST LENGTH OF OLD SEGMENT JMS I (SHEADR JMS SKIPF /LAST LOC OF SHORTENED SEGMENT L0001 /LINK THE OLD LAST SEGMENT TAD I (CATBLK /TO THE NEWLY CREATED ONE DCA I (DIRBUF+2 TAD I (DIRBUF+2 TAD (-7 SMA CLA /JUST USING ALL OF 6 SEGMENTS? JMP I (ENTREX /YES --- ERROR EXIT PUTCAT /WRITE OUT NEXT TO LAST SEGMENT JMS SKIPF /(AXREG IS HIT BY PUTCAT) ISZ I (CATBLK /BUMP BLOCK NO. TO WRITE LAST ONE TAD PT1 /SET NO. OF ENTRIES DCA I (DIRBUF TAD MOVLEN /AND FILE ORIGIN CIA TAD I (DIRBUF+1 DCA I (DIRBUF+1 DCA I (DIRBUF+2 /AND MARK AS LAST SEGMENT TAD AXREG TAD (-DIRBUF-377 JMP DMOVE SKIPF, 0 /FIND LAST LOC USED IN A SEGMENT DCA MOVLEN /ALSO: # OF BLOCKS USED BY A SEGM. TAD I AXREG SNA CLA JMP SKEMTY L0003 BUMPXR SKEMTY, TAD I AXREG /ALWAYS GET LENGTH WORD TAD MOVLEN /AND ADD IT IN DCA MOVLEN ISZ ENTRIES JMP SKIPF+2 JMP I SKIPF /AXREG=ADDR OF LAST LENGTH WORD PAGE
XCLOSE, 0 /MAKE "NAME.EX" A PERMANENT FILE DCA CLOSLEN /SAVE ACTUAL LENGTH OF FILE JMS I (DIRSRCH /SEARCH FOR THE OLD COPY JMP NODLET /NO OLD COPY! L7776 TAD AXREG DCA AXREG L7775 TAD I (DIRBUF+4 JMS SQUISH /REMOVE 3+WASTE WORDS DCA I AXREG2 /MAKE REST AN EMPTY, SAME LENGTH TAD SEGMENT SNA /IS THERE A TENTATIVE FILE? JMP EOCLOS /NO, FINISH CIA TAD I (CATBLK SNA CLA /PERHAPS IN THE SAME SEGMENT? JMP .+4 JMS CONSOL /NO, CLEAN UP THIS SEGMENT PUTCAT /AND WRITE IT OUT JMP NODLET TAD I (DIRBUF+3 /YES, BUT ENTRY TO BE CLOSED CIA CLL /COULD BE ABOVE THE ONE TAD AXREG2 /WE JUST DELETED? SZL CLA JMP NODLET+2 L7775 /INDEED - MOVE POINTER DOWN TAD I (DIRBUF+4 JMP NODLET+2 NODLET, TAD SEGMENT GETCAT /READ IN SEGMENT WITH OPEN FILE TAD I (DIRBUF+3 DCA AENTRY TAD CLOSLEN /INSERT LENGTH OF FILE CIA DCA I AENTRY ISZ AENTRY ISZ AENTRY TAD CLOSLEN TAD I AENTRY DCA I AENTRY /AND CORRECT LENGTH OF REMAINING EMPTY EOCLOS, JMS CONSOL PUTCAT /WRITE OUT SEGMENT DCA SEGMENT /SIGNAL NO OPEN FILE JMP I XCLOSE /AND RETURN CLOSLEN,0 /ACTUAL FILE LENGTH (OS/8 BLOCKS) CONSOL, 0 /DIRECTORY CONSOLIDATOR (DELETES JMS I (SHEADR /EMPTIES OF LENGTH 0, COMBINES EMPTIES) CONLP, TAD I AXREG SNA CLA /EMPTY FILE? JMP CONMTF L0003 /NO, PASS OVER TO LENGTH OF FILE BUMPXR TAD I AXREG SZA CLA /NULL FILE? JMP CONLPT /NO, CHECK NEXT ENTRY TAD (-5 /YES, REMOVE IT ENTIRELY TAD I (DIRBUF+4 /INCLUDING THE ADD. WORD(S) CONSQ, JMS SQUISH ISZ I (DIRBUF /CORRECT NO. OF ENTRIES JMP CONSOL+1 /REPEAT CONSOLIDATION (2 EMPTIES /MAY HAVE BEEN BROUGHT TOGETHER) CONLPT, ISZ ENTRIES /MORE FILES? JMP CONLP /YES CONEX, JMS I (SHEADR /DONE! JMP I CONSOL CONMTF, TAD I AXREG /-LENGTH OF EMPTY SNA /NULL EMPTY? JMP CONSQ0 /YES, SQUISH IT OUT DCA CONT1 /NO, SAVE ITS LENGTH TAD AXREG DCA CONT2 /AND THE POSITION OF LENGTH WORD ISZ ENTRIES /IS IT THE LAST FILE? SKP JMP CONEX /YES, LET IT BE TAD I AXREG /NO SZA CLA /ADJACENT EMPTY? JMP CONLP+3 /NO, REENTER LOOP TAD I AXREG /YES, ADD LENGTHS TAD CONT1 DCA I CONT2 /AND STORE IN 1ST LENGTH WORD CONSQ0, L7776 JMP CONSQ /SQUISH OUT 2 WORDS CONT1, 0 /TEMPORARIES CONT2, 0 SQUISH, 0 /REMOVE -(AC) WORDS PRECEDING (AXREG) TAD AXREG DCA AXREG3 TAD AXREG3 DCA AXREG2 /SAVE POINTER TO SQUISHED FILE TAD I AXREG /MOVE DOWN ONE WORD DCA I AXREG3 TAD AXREG TAD (-DIRBUF-377 SZA CLA /AT END? JMP .-5 /NO, KEEP GOING JMP I SQUISH PAGE
XPUTF, 0 SNA TAD CHAR /USE (CHAR) IF AC=0 TAD (-211 /MUST REPEAT OUTL-ROUTINE SNA /(SEE THERE FOR COMMENTS) JMP PTABL TAD (211 JMS XPUT1 TAD PREG3 TAD MCR SNA CLA JMP PNEWLN TAD PREG3 IGNORE ISZ TABCNT JMP I XPUTF JMP PTABST PNEWLN, TAD CLF JMS XPUT1 TAD LNPSW PTABST, TAD I (TABS DCA TABCNT JMP I XPUTF PTABL, TAD C240 JMS XPUT1 ISZ TABCNT JMP .-3 JMP PTABST PREG3, 0 /TEMPORARY (CAN USE XREG3??) XPUT1, 0 DCA PREG3 TAD PREG3 ISZ O3 /3RD CHAR OF THREE? JMP PUT12 /NO DCA ITM L7776 /YES, RESET BUFFER POINTER TAD OP DCA OP JMS PUT3L /INSERT LEFT 4 BITS JMS PUT3R /AND RIGHT 4 BITS L7775 DCA O3 /RESET 3-WAY SWITCH TAD OP AND (377 SZA CLA /DECTAPE BUFFER FILLED? JMP I XPUT1 /NO ISZ MBLOCKS /YES, BUT GOING TOO FAR? SKP /(MBLOCKS=LEMPTY-1 INITIALLY) JMP I (ERR12 /DANGER - COULD DESTROY ANOTHER FILE! DECTAPE 4200 /WRITE 2 PAGES FROM FIELD 0 DTBUFR OBLOCK, 0 ISZ OBLOCK TAD (DTBUFR DCA OP JMP I XPUT1 PUT12, AND (377 DCA I OP ISZ OP JMP I XPUT1 PUT3L, /TWO NAMES - SAME ROUTINE! PUT3R, 0 TAD ITM CLL RTL RTL DCA ITM TAD ITM AND (7400 TAD I OP DCA I OP ISZ OP JMP I PUT3R O3, -3 /3 CHAR PACK SWITCH OP, DTBUFR /DECTAPE BUFFER POINTER MBLOCKS,0 /MAXIMAL BLOCKS XSAVE, TAD NAME SZA CLA /DID USER SPECIFY A FILENAME? JMP I (SAVEGO /OKAY - ACTION! SKP /NO, REQUEST ONE XUNSAV, L7777 DCA LINE2 FREE13 JMS I (QNAME JMS I (COMIN READC PACKC CRTEST JMP .-3 PACKC JMS I (COMOUT JMS I (XGETNAM ISZ LINE2 JMP I (SAVEGO JMS I (DTGET DCA SEGMENT /FOR SAFETY! CLOSE DONE, JMS I (DTFREE FREE2 TAD (0417 /PRINT "DONE" PRINT2 FREE2 TAD (1605 PRINT2 JMP BEGIN PAGE
SAVEGO, UDF TAD I ALINE0 CDF SNA CLA ERR13, ERROR /NOTHING TO SAVE! JMS I (DTGET /GET THE TAPE ENTER /OPEN "NAME.EX" FOR OUTPUT ERR12, ERROR /NO ROOM ON TAPE OR FULL DIRECTORY DCA I (OBLOCK /INSERT STARTING BLOCK NO. L7777 TAD I (LEMPTY /GET LENGTH OF EMPTY DCA I (MBLOCKS /=LEMPTY-1 L7775 DCA I (O3 /INITIALIZE OUTPUT POINTERS TAD (DTBUFR DCA I (OP TAD (XPUTF /SWITCH TO FILE INPUT DCA APUT TAD LINE1 SNA CLA /SUPPRESS LINE NUMBERS? DCA LNPSW /YES TAD LNPSW /INITIALIZE TAB-COUNTER TAD I (TABS DCA TABCNT TAD ALINE0 DCA THISLN /POINT TO DUMMY LINE (#0) SAVLIN, UDF TAD I THISLN /ADDRESS OF NEXT LINE CDF SNA JMP SAVEND /=0 MEANS LAST LINE DONE DCA THISLN TAD THISLN DCA AXOUT /POINT TO TEXT DCA OBYTE UDF TAD I AXOUT /GET NUMBER OF THIS LINE CDF DCA LINENO TAD LNPSW SZA CLA /LINE NUMBERS WANTED? PRNTLN GETC /NO PRINTC /WRITE THIS LINE CRTEST JMP .-3 JMP SAVLIN SAVEND, DCA CHAR TAD Z232 /WRITE A CTRL-Z (EOF MARK) PRINTC /THEN PAD LAST BLOCK WITH NULLS TAD (DTBUFR CIA TAD I (OP SZA CLA JMP .-5 L7777 /COMPUTE ACTUAL LENGTH OF FILE TAD I (LEMPTY CIA TAD I (MBLOCKS CLOSE /CLOSE THE FILE TAD (XPRINT /RESTORE NORMAL I/O DCA APUT JMP I (DONE XBYE, UDF DCA I ALINE0 /CLEAR USERS OWN BUFFER CDF L0002 /RESET 'BUFR' - HE MIGHT CHANGE TAD ALINE0 /IDEA AND CONTINUE WITH MUTOR DCA BUFR /TYPING CTRL/C TRY, JMS I (DTGET /NOW GET THE TAPE TAD (SWAP0+22 /(ONCE HERE, WE ARE SURE DCA AUCDF /TO HAVE NO DECTAPE MOTION!) TAD (SWAP0+32 DCA AULN0 TAD (-N /NOW CHECK, IF ALL USERS DCA CNTR /HAVE A CLEAR BUFFER BYLOOP, TAD I AUCDF DCA .+3 TAD I AULN0 DCA ULINE0 UDF TAD I ULINE0 CDF SZA CLA /THIS ONE CLEAR? JMP WAIT TAD AUCDF /YES, LOOK AT NEXT TAD (SWPLEN DCA AUCDF TAD AULN0 TAD (SWPLEN DCA AULN0 ISZ CNTR /SEEN ALL USERS? JMP BYLOOP /NO IOF /YES, BYE MUTOR JMP I (7605 /WE LEAVE FOR OS/8. WAIT, JMS I (DTFREE /RELEASE THE TAPE TAD (TRY DCA PC JMP I (NULL /AND WAIT FOR BETTER TIMES AUCDF, 0 /POINTERS INTO SWAP AREAS AULN0, 0 /(TO XFIELD AND ALINE0) ULINE0, 0 PAGE
/U S E R S W A P A R E A S : SWAP0, ZBLOCK 20 RUN U0KRB U0CDF U0BEG+40 U0BEG+40 U0BEG+40 U0BEG U0BEG U0BEG+153 U0END U0BEG+151 ZBLOCK 20 XGETC XPRINT SWAP1, ZBLOCK 20 RUN U1KRB U1CDF U1BEG+40 U1BEG+40 U1BEG+40 U1BEG U1BEG U1BEG+153 U1END U1BEG+151 ZBLOCK 20 XGETC XPRINT SWAP2, ZBLOCK 20 RUN U2KRB U2CDF U2BEG+40 U2BEG+40 U2BEG+40 U2BEG U2BEG U2BEG+153 U2END U2BEG+151 ZBLOCK 20 XGETC XPRINT SWAP3, ZBLOCK 20 RUN U3KRB U3CDF U3BEG+40 U3BEG+40 U3BEG+40 U3BEG U3BEG U3BEG+153 U3END U3BEG+151 ZBLOCK 20 XGETC XPRINT SWAP4, ZBLOCK 20 RUN U4KRB U4CDF U4BEG+40 U4BEG+40 U4BEG+40 U4BEG U4BEG U4BEG+153 U4END U4BEG+151 ZBLOCK 20 XGETC XPRINT SWAP5, ZBLOCK 20 RUN U5KRB U5CDF U5BEG+40 U5BEG+40 U5BEG+40 U5BEG U5BEG U5BEG+153 U5END U5BEG+151 ZBLOCK 20 XGETC XPRINT SWAP6, ZBLOCK 20 RUN U6KRB U6CDF U6BEG+40 U6BEG+40 U6BEG+40 U6BEG U6BEG U6BEG+153 U6END U6BEG+151 ZBLOCK 20 XGETC XPRINT SWAP7, ZBLOCK 20 RUN U7KRB U7CDF U7BEG+40 U7BEG+40 U7BEG+40 U7BEG U7BEG U7BEG+153 U7END U7BEG+151 ZBLOCK 20 XGETC XPRINT
ERR=7400-10 /E R R O R M E S S A G E S : *ERR+10 TEXT %ILLEGAL COMMAND % *ERR+20 TEXT %# OUT OF RANGE % *ERR+30 TEXT %CAN'T FIND LINE % *ERR+40 TEXT %STEP TOO LARGE % *ERR+50 TEXT %TEXTBUFFER FULL % *ERR+60 TEXT %INPUT TOO FAST % *ERR+70 TEXT %OUTPUT OVERLOAD % *ERR+100 IFDEF TC08 <TEXT %DECTAPE ERROR %> IFDEF RK8E <TEXT %DISK FAILURE %> *ERR+110 TEXT %INVALID FILENAME% *ERR+120 TEXT %FILE NOT FOUND % *ERR+130 TEXT %NEED LINE NUMBER% *ERR+140 TEXT %NO ROOM ON TAPE % *ERR+150 TEXT %NOTHING TO SAVE % *ERR+160 TEXT %LINE TOO LONG % *ERR+170 TEXT %M U T O R V% *.-1 VERSION $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$



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