File: MUTOR.PA of Tape: Various/Decus/decus-5
(Source file text)
/ 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
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$