Trailing-Edge
-
PDP-10 Archives
-
bb-k345a-sb
-
sos.mac
There is 1 other file named sos.mac in the archive. Click here to see a list.
TITLE SOS - SON OF STOPGAP %21(122)
;COPYRIGHT (C) 1973,1978,1979 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SUBTTL DEFINITIONS
WHOSOS==0 ;LAST EDITED BY TAH
VERSOS==21
PATSOS==0 ;PATCH LEVEL
MODSOS==122 ;EDIT LEVEL
; EDITOR FOR THE DISK -- WORKS BY RECOPYING FILES USED
MLON ;MULTI-LINE THINGIES
SALL ;SUPPRESS MACRO XPANSIONS
.HWFRMT ;READABLE LISTING
IFNDEF LSTSW,<LSTSW==1 ;FOR L COMMAND>
IFNDEF JUSTSW,<JUSTSW==0 ;FOR TEXT JUSTIFICATION>
IFNDEF RENTSW,<RENTSW==1 ;FOR RE-ENTRANT VERSION>
IFNDEF CCLSW,<CCLSW==1 ;FOR CCL FEATURES>
IFNDEF TEMPC,<TEMPC==1 ;FOR TEMPCORE FEATURE>
IFNDEF CRYPSW,<CRYPSW==0 ;FOR ENCRYPTED FILES>
IFNDEF EXTEND,<EXTEND==1 ;FOR EXTENDED FEATURES>
IFNDEF PPNTSW,<PPNTSW==0 ;FOR PRETTY PRINT FEATURES>
IFN RENTSW,< TWOSEG
RELOC 400000 >
INTERN .JBVER
.JBVER==137
LOC .JBVER
BYTE (3)WHOSOS (9)VERSOS (6)PATSOS (18)MODSOS
RELOC
OPDEF OCRLF [OUTSTR [BYTE (7)15,12]]
OPDEF ONECHO [SETSTS TTY,1]
OPDEF OFFECHO [SETSTS TTY,201]
;I/O CHANNELS
TTY==1 ;CHL FOR TTY
IN==2
OUT==3
LPT==4
ALTDV==5 ;THE OTHER INPUT DEVICE (COPY AND TRANSFER)
IND==6 ;INDIRECT CHL FOR "@" CMD
OPT==7 ;CHL FOR OPTION FILE
;ACS USED
JF=0 ;TEMP FLAGS FOR JUSTIFY & PRETTY PRINT
T1=1 ;TEMP REGISTERS
T2=2
T3=3
T4=4
T5=5
FL=10 ;FLAG REGISTER
FL2=11
ALTP=12 ;POINTER FOR ALTER MODE
CS=13 ;CHARACTER TABLE BITS
SINDEX=14 ;LINE TO FIND, USED ALSO BY THE VARIOUS ROUTINES
PNTR=15 ;POINTS AT CURRENT PLACE IN BUFFER
C=16 ;CHARACTER RETURNED HERE BY GNCH
P=17 ;PUSHDOWN LIST
;FLAGS (RIGHT HALF)
BOF==1 ;NOW ON FIRST RECORD OF FILE
EOF==2 ;HAVE READ END OF FILE BUT NOT NECESSARILY BUT IN BUFFER
EOF2==4 ;LAST WORD OF FILE IS IN CURRENT BUFFER
ADDL==10 ;USED IN COMMAND SCANNING--LINE NUMBER + INC
SUBL==20 ;LINE NUMBER - INC
IDF==40 ;SCAN HAS SEEN AN IDENTIFIER
NUMF==100 ;SCAN HAS SEEN A NUMBER
TERMF==200 ;SCAN SAW A TERMINATOR (LF OR ALTMODE)
LINSN==400 ;THE COMMAND INPUT ROUTINES SAW A LINE NUMBER
PGSN==1000 ;THEY SAW A PAGE NUMBER
NEWFL==2000 ;NEW FILE NAME SEEN BY END CODE
ORDF==4000 ;LINES OUT OF ORDER (USED BY NUMBER)
BGSN==10000 ;BIGGEST PAGE HAS BEEN SEEN
M37F==20000 ;THIS IS A MODEL 37
CNTF==40000 ;COMMAND USING !
DPYF==100000 ;THIS IS A DISPLAY
READOF==200000 ;THIS FILE IS BEING USED IN READ ONLY MODE
EXTOG==400000 ;ON FOR SHORT ERROR MESSAGES
;SPECIAL FLAGS FOR PARSE CODE
F.LAHD==1 ;LOOK-AHEAD FLAG
F.PER==2 ;PERIOD SEEN
F.SLSH==4 ;SLASH SEEN
F.CDSN==10 ;CODE SEEN
F.PPN==20 ;PPN SEEN
F.COLN==400 ;COLON SEEN
F.EQL==1000 ;EQUAL SIGN SEEN
F.ANY==2000 ;ANY ATOM SEEN BEFORE EOL
P.FLGS==F.LAHD!F.PER!F.SLSH!F.CDSN!F.PPN!F.COLN!F.EQL!F.ANY
CODMAX==^D20 ;MAX CHARS IN CODE
SFDLVL==6 ;MAX SFD LVL
D==PNTR
S1==PNTR ;SPECIAL ACS
S2==SINDEX
;FLAGS (LEFT HALF)
NEGF==1 ;SEARCH HAS SEEN A
DEMCHR==2 ;SEARCH MUST SEE ANOTHER CHARACTER
ASSMF==4 ;SEARCH HAS ASSUMED SEARCH CONTINUATION
ALTSRF==10 ;HE WANTS TO DO A SEARCH AND EDIT
NUMSRF==20 ;HE ONLY WANTS NUMBERS OF LINES FOUND
ARBITG==40 ;WE ARE DOING CURRENTLY, DO NOT ALLOW ANOTHER
EXCTSR==100 ;WANTS TO SEARCH EXACTLY (NOT IGNORE CASE)
COPFIL==200 ;WE ARE COPYING FROM ANOTHER FILE
ISCOP==400 ;WE ARE DOING A COPY
NOPRN==1000 ;DO NOT PRINT WHILE DOING SUBSTITUTE
DECID==2000 ;ALLOW USER TO DECIDE IF LINE IS OK
EXCTS1==4000 ;ANOTHER EXACT SEARCH FLAG FOR SUBS
QMODF==10000 ;DO NOT TREAT ? AS A SPECIAL CASE ON INPUT
GCOM==20000 ;DOING A G COMMAND INSTEAD OF E
SRCOP==40000 ;DOING A SEARCH OF SECOND FILE
TRANFL==100000 ;THIS IS A TRANSFER COMMAND WHICH HAS DELETED LINES
TECOF==200000 ;THIS IS A TECO FILE
FSTOPF==400000 ;THIS IS THE FIRST READ OP ON THIS FILE
;FLAGS IN FL2 (RIGHT)
STARF==1 ;WE HAVE SEEN A * FOR THE LAST LINE
RUBF==2 ;WE ARE DOING RUBOUT IN INTRA-LINE EDIT
ALTDUP==4 ;DUPLEX CHARACTERS IN ALTER MODE
RUBF2==10 ;DOING DELETE TYPE RUBOUT IN ALTER MODE
SVIT==20 ;WE ARE DOING A "W" COMMAND (SAVE WORLD)
NONUMF==40 ;SUPPRESS LINE NOS FOR P,R,I CMDS
ACONST==100 ;ADD CONSTANT FOR R COMMAND
MONOF==200 ;MONOTONIC RENUMBERING - NO REST AT P.M.
;UNUSED (400)
SUPN==1000 ;SUPPRESS LISTING OF LINE NUMBERS
;UNUSED (2000)
;UNUSED (4000)
QSEPF==10000 ;TREAT . % $ AS SEPARATORS
COMFLF==20000 ;READ COMMANDS FROM FILE
;FLAGS IN FL2 (LEFT)
PDECID==1 ;PERM DECIDE MODE FOR S
UARWF==2 ;UP ARROW (^) SEEN FOR FIRST LINE
;UNUSED (4)
NORENT==10 ;DON'T ALLOW REENTER
RENTF==20 ;REENTER COMMAND TYPED
BELLF==40 ;ALLOW <BELL><BELL>
BELLSN==100 ;<BELL> SEEN
AUTOF==200 ;AUTO SAVE IN PROGRESS
DSKCK==400 ;CHECK DISK QUOTAS
SLPSW==1000 ;SLEEPING UNTIL DISK SPACE APPEARS
DOENDF==2000 ;E CMD REQUESTED
INOPTF==4000 ;READING OPTION FILE
INPARS==10000 ;DOING INITIAL PARSE
PCHGF==20000 ;FILE HAS CHANGED THIS PASS
FCHGF==40000 ;FILE HAS CHANGED THIS EDIT
CCHGF==100000 ;THIS COMMAND HAS CHANGED THE FILE
FSEQF==200000 ;ORIGINAL FILE HAD SEQ #'S
ALLCHG==PCHGF!FCHGF!CCHGF ;ALL FLAGS AFFECTING FILE CHANGE
;FLAGS FOR JF (RIGHT)
JFFLG==1 ;J DOES FILL ONLY
JRFLG==2 ;J DOES RIGHT JUSTIFY
JCFLG==4 ;J DOES CENTERING
JBLF==10 ;J SEES A BLANK
JLFLG==20 ;J DOES LEFT JUSTIFY
JPER==40 ;J SEES A PERIOD OR SOMETHING LIKE IT
JWFLG==100 ;J DOES FILL WORDS ONLY
EJECT==200 ;EJECT AFTER PAGES
WAIT==400 ;WAIT FOR CR AFTER PAGES
PGNOS==1000 ;PAGE NUMBERS AT BOTTOM
OPDEF ERROR [1B8] ;ERROR UUOS FATAL ERROR
OPDEF NERROR [2B8] ;NON-FATAL ERROR
OPDEF RERROR [3B8] ;PRINT MESSAGE AND RETURN
OPDEF XLOOK [4B8] ;EXTENDED LOOKUP
OPDEF XENTR [5B8] ;EXTENDED ENTER
OPDEF XRENM [6B8] ;EXTENDED RENAME
MAXUUO==6
;ERROR NUMBERS
ICN==1 ;INTERNAL EDITRO CONFUSION
DIE==2 ;DEVICE INPUT ERROR
DDE==3 ;DEVICE OUTPUT ERROR
ILC==4 ;ILLEGAL COMMAND
ILUUO==5 ;PROTECTION. SOMEONE EXECUTED AN ILLEGAL UUO
LTL==6 ;LINE IS TOO LOGNNG
NLN==7 ;NULL COMAND RANGE
NSP==10 ;NO SUCH PAGE (DELETE)
ORDER==11 ;LINES OUT OF ORDER
UNA==12 ;LPT NOT AVAILABLE FOR L COMMAND
ILR==13 ;ILLEGAL REPLACEMENT WITH INSERT
WAR==14 ;WRAP AROUND IN RENUMBERING
TMS==15 ;TOO MANY SEARCH STRINGS GIVEN
STL==16 ;TOO MANY TOTAL STRING CHRS
ISS==17 ;ILLEGAL SEARCH STRING
ILFMT==20 ;ILLEGAL LINE FORMAT DETECTED
NSG==21 ;NO STRING GIVEN
FNF==22 ;FILE NOT FOUND (COPY)
DNA==23 ;DISK NOT AVAILABLE (COPY)
NEC==24 ;NOT ENOUGH CORE (COPY)
IRS==25 ;ILLEGAL REPLACEMENT STRING
STC==26 ;SEARCH STRING TOO COMPLEX (GOT PDLOV)
ITD==27 ;ILLEGAL TRANSFER DESTINATION (PLACE NO LONGER THERE)
NNN==30 ;NO NEXT LINE (FROM JOIN TYPE COMMANDS)
SRF==31 ;SEARCH FAIL (F AND S COMMANDS)
CMERR==32 ;ERROR IN COMMAND FILE
CMEND==33 ;EOF SEEN IN COMMAND FILE
MAR==34 ;RMAR MUST BE GREATER THAN LMAR AND PMAR
BBF==35 ;FUNNY STUFF IN "BASIC" MODE (FATAL)
SRBLG==^D200 ;NUMBER OF CHRS ALLOWED IN SEARCH STRING
SRNUM==6 ;NUMBER OF SEARCH STRINGS ALLOWED
PDLSIZ==200 ;PUSHDOWN LIST SIZE
MXWPL==^D100 ;MAX NUMBER OF WORDS PER LINE
MINDSK==^D5 ;MINIMUM DISK SPACE TO TRY OUTPUT
OVRDRW==^D100 ;OVER DRAW ALLOWANCE
IFN EXTEND,<LSNUM==3 ;NUMBER OF NESTED LINE SEARCHES ALLOWED>
%LPP==^D53 ;LINES/PAGE FOR "L" CMD
PGSZ==^D55 ;LINES / PAGE
FULLPG==^D65 ;LINES TO NEXT PAGE
.TOLCT==1003 ;LOWER CASE TTY
.GTPRG==3 ;PROGRAM NAME
.GTLDV==16 ;LEVEL D TABLE
%LDSTP==12 ;DEFAULT PROTECTION
SUBTTL RPG LOADER
CREFIT: OCRLF ;INFORM USER IS ALL OK
MOVE T4,[1,,RPGR]
SKIPN T1,RUNDEV ;ANY SPECIFIED
JRST TENTFOLD
MOVEM T1,RPGR ;STASH DEVICE NAME
HRRZS T4 ;REMOVE RUN INCREMENT
HRROI T1,RUNEXT
POP T1,RPGR+2
POP T1,RPGR+1
SKIPE T1,RUNPTH ;ANY PATH INFO?
SKIPN RUNPTH+1 ;YES - JUST PPN?
JRST CRFIT1 ;JUST STORE PPN AND EXIT
MOVE T1,[RUNPTH,,PTHADR+2]
BLT T1,PTHADR+2+SFDLVL
SETZM PTHADR
SETZM PTHADR+1
MOVEI T1,PTHADR
CRFIT1: MOVEM T1,RPGR+4 ;STASH PATH PNTR
TENTFOLD:
RUN T4,
HALT . ;SAY DON'T RETURN
SUBTTL CHARACTER TABLES
;A CHARACTER TABLE FOR USE ON TYPE IN AND TYPE OUT
;FLAGS USED IN CHARACTER TABLE
OPF==10 ;THIS IS A SPECIAL CHARACTER
SNUMF==4 ;THIS IS PART OF A NUMBER
LETF==2 ;THIS IS A LETTER
TERM==1 ;THIS IS A TERMINATOR
M37==400000 ;THIS CHR IS PRINTED AS ITSELF ON MODEL 37
NSEPF==200000 ;THIS IS NOT A SEPERATOR (USED ON $,%,AND.)
DEFINE CHRS (FLAGS,PALT,INALT,RH)
<BYTE (4) FLAGS (7) PALT,INALT(18)RH>
CTBL: 0
CHRS OPF,"!","",""
CHRS OPF,42,"",""
CHRS OPF,"#",3,3
CHRS OPF,"$",4,4
CHRS OPF,"%",5,5
CHRS OPF,"&",6,6
CHRS OPF,"'",7,7
CHRS OPF,"(",10,10
0
CHRS OPF!TERM,0,12,12
CHRS OPF,0,13,13
CHRS OPF,0,14,14
0
CHRS OPF,")",16,16
CHRS OPF,"*",17,17
CHRS OPF,"+",20,20
CHRS OPF,54,21,21
CHRS OPF,"-",22,22
CHRS OPF,".",23,23
CHRS OPF,"/",24,24
CHRS OPF,"0",25,25
CHRS OPF,"1",26,26
CHRS OPF,"2",27,27
CHRS OPF,"9",30,30
CHRS OPF,"6",31,31
CHRS OPF,"4",32,32
CHRS OPF,"=",33,33
CHRS OPF,74,34,34
CHRS OPF,76,35,35
CHRS OPF,"7",36,36
CHRS OPF,"8",37,37
0
CHRS OPF,0,1,"!"
CHRS OPF,0,2,42
CHRS OPF,0,3,"#"
CHRS OPF,0,4,"$"+NSEPF
CHRS OPF,0,5,"%"+NSEPF
CHRS OPF,0,6,"&"
CHRS OPF,"'","'","'"
CHRS OPF,0,10,"("
CHRS OPF,0,16,")"
CHRS OPF,0,17,"*"
CHRS OPF,0,20,"+"
CHRS OPF,0,21,54
CHRS OPF,0,22,"-"
CHRS OPF,0,23,"."+NSEPF
CHRS OPF,0,24,"/"
CHRS SNUMF,0,25,20
CHRS SNUMF,0,26,21
CHRS SNUMF,0,27,22
CHRS SNUMF,0,176,23
CHRS SNUMF,0,32,24
CHRS SNUMF,0,"5",25
CHRS SNUMF,0,31,26
CHRS SNUMF,0,36,27
CHRS SNUMF,0,37,30
CHRS SNUMF,0,30,31
CHRS OPF,0,174,":"
CHRS OPF,0,73,73
CHRS OPF,0,34,74
CHRS OPF,0,33,"="
CHRS OPF,0,35,76
CHRS OPF,0,37,"?"
CHRS OPF,0,140,"@"
XXZ=101
REPEAT ^D26,<CHRS LETF,0,XXZ+40,XXZ-40
XXZ=XXZ+1>
CHRS OPF,0,173,"["
CHRS OPF,0,"\","\"
CHRS OPF,0,175,"]"
CHRS OPF,0,"^","^"
CHRS OPF,0,"_","_"
CHRS OPF,100,140,140
XXZ=141
REPEAT ^D26,<CHRS LETF,XXZ-40,XXZ,XXZ-100
XXZ=XXZ+1>
CHRS OPF,"[",173,173+M37
CHRS OPF,":",174,174+M37
CHRS OPF,"]",175,175+M37
CHRS OPF,"3",176,176
CHRS OPF,"\",177,177
CHRS OPF,0,0,200
SUBTTL SCANNER
GNCH: SKIPN C,LIMBO ;USE SAVED CHAR IF ANY
PUSHJ P,@CHIN ;ELSE GET FRESH CHAR
SETZM LIMBO ;AND CLEAR LIMBO
CAMN C,ESC ;CHECK ESCAPE CHAR
MOVEI C,200 ;CONFUSE WITH LEFT CURLY BRACKET
TLNE FL,QMODF ;SHOULD WE TREAT ' SPECIALLY
JRST GNCH1Y ;NO:
CAIN C,"'" ;YES: SHOULD WE USE ALT CHR SET?
JRST GNCHA ;YES:
GNCH1Y: TDNN FL2,[INOPTF,,COMFLF]
TLNN FL2,BELLF ;ALLOWED?
JRST GNCHB ;NO: JUST GET BITS
CAIN C,7 ;YES: SEE IF BELL
JRST [TLO FL2,BELLSN ;SAY WE SAW ONE
JRST GNCHA] ;AND LOOK AT NEXT
GNCHB: JUMPE C,GNCH ;IGNORE NULLS
MOVE CS,CTBL(C) ;GET CHARACTER TABLE BITS
TLNE CS,LETF_16 ;CHECK TO SEE IF A LETTER
TDC C,CASEBT ;USE UPPER/LOWER INFO
POPJ P, ;AND RETURN
GNCHA: PUSHJ P,@CHIN ;GET NEXT CHAR
JUMPE C,GNCHA ;SKIP NULLS
TLZE FL2,BELLSN ;WAS 1ST BELL SEEN
JRST [CAIN C,7 ;YES: CHECK FOR 2ND
JRST [OCRLF ;2ND SEEN - PUNT
CLRBFI
JRST COMND]
MOVEM C,LIMBO ;SAVE CHAR
MOVEI C,7 ;RETURN A BELL
JRST GNCHB]
SKIPE CTBL(C) ;NO CHANGE FOR NULL,SPACE,TAB,CRET
MOVS C,CTBL(C) ;GET ALTERNATE CHR FROM CHR TABLE
ANDI C,177 ;ONLY THE CHR BITS
JRST GNCHB ;GO CHECK THINGS
;HERE TO INPUT FROM TTY
TTYCH: SOSG TTIBH+2 ;SEE IF MORE CHARS
PUSHJ P,TTYINP ;NO: GO FETCH SOME MORE
ILDB C,TTIBH+1 ;YES: GET ONE
JUMPE C,TTYCH ;SKIP OVER NULLS
POPJ P, ;RETURN
TTYINP: IN TTY,0 ;INPUT UUO
POPJ P, ;ALL OK
STATO TTY,20000 ;SEE IF EOF?
JRST TTYERR ;NO -- ERROR?
TTINP1: RELEAS TTY,0 ;EOF -- RE-INIT TTY
OPEN TTY,TTDEVI
ERROR ICN
MOVEI C,TTIBUF ;SET UP INPUT BUFFER
EXCH C,.JBFF##
INBUF TTY,1
MOVEM C,.JBFF## ;RESTORE JOBFF
JRST TTYINP ;NOW TRY INPUT AGAIN
TTYERR: SETSTS TTY,1 ;CLR ERRORS
CLRBFI
OCRLF
OUTSTR [ASCIZ "TTY input error -- Retype line"]
OCRLF
JRST TTINP1
;SUBROUTINE TO SCAN NEXT ATOM
;CALL:
; PUSHJ P,SCAN
; <RETURN HERE>
;C(ACCUM) := SIXBIT ATOM
;C(T1) := ASCII SEQ NUMBER FORM
;C(T2) := DECIMAL INTEGER
;C(C) := BREAK CHAR OR SPACE IF IDENT.
SCAN: TRZ FL,TERMF!NUMF!IDF ;RESET FLAGS
SKIPE CS,SAVCHR ;CHECK TO SEE IF WE LEFT ONE LAST TIME
JRST SL1 ;YES, IT MUST BE A DELIMITER
SKIPN C,SAVC ;BACK UP A CHARACTER?
JRST SL10 ;NO
PUSHJ P,GNCHB ;YES, GET BITS
TLNN FL2,INPARS ;HANDLE SPECIAL IF IN PARSE
JRST SL11 ;NOT IN INITIAL PARSE
SETZM SAVC
SETZM SAVCHR
POPJ P, ;RETURN IF SPACE DELIM
SL10: PUSHJ P,GNCH ;GET A CHR
SL11: SETZM SAVC
JUMPE CS,SL10 ;CHECK FOR TAB, SPACE, AND IGNORE
JUMPL CS,SL1 ;SPECIAL CHARACTER?
MOVE T3,[POINT 6,ACCUM] ;SET TO SAVE IDENT
SETZM ACCUM
TLNE CS,SNUMF_16 ;CHECK FOR NUMBER
JRST SNUM1 ;AND GO RACING OFF TO NUMBER ROUTINE
SL2P: TRO FL,IDF ;IT IS AN IDENT
SL2: TLNE T3,770000 ;HAVE WE STORED ENOUGH?
IDPB CS,T3 ;NO, STORE ANOTHER (RH OF CHR TABLE HAS SIXBIT)
PUSHJ P,GNCH ;CONTINUE
JUMPG CS,SL2 ;CHECK FOR ANOTHER NUMBER OR LETTER
SOK1: MOVEM CS,SAVCHR ;SAVE THE CHARACTER (MUST BE A SPECIAL CHR)
TLNE FL2,INPARS
JRST [MOVEM C,SAVC ;SAVE HERE IF IN PARSE
SETZB C,SAVCHR
POPJ P,]
MOVEI C,0 ;ZERO IN C FOR NUMBERS AND IDNETS
POPJ P,
SL1: HRRZ C,CS ;FOR SPECIAL CHARACTERS, RETURN RH OF CTABLE
TLNE CS,TERM_16 ;CHECK FOR TERMINATOR
TRO FL,TERMF ;AND SET FLAG
ANDI C,377 ;GET RID OF EXTRA BITS
SETZM SAVCHR ;ZERO SAVCHR FOR LATER
CAIE C,"." ;CHECK FOR .
POPJ P, ;NO RETURN
MOVE T1,CLN ;SET UP FOR CURRENT LINE AND PAGE
MOVE T2,CPGL
TRO FL,NUMF ;CALL IT A NUMBER
POPJ P,
SNUM1: SETZB T1,T2 ;SET NUMBER ACCUMS TO 0
SN1A: TLNE T3,770000 ;WILL STORE THE SIXBIT FOR FILE NAMES
IDPB CS,T3 ;BUT ONLY IF LESS THAN 6
SN1B: TLNE T1,(<177B7>) ;CHECK FOR 5 CHARS
JRST SOK2 ;5 ALREADY
LSH T1,7 ;ACCUMULATE ASCII IN T1
IOR T1,C
IMULI T2,^D10 ;DECIMAL IN T2
ADDI T2,-"0"(C)
PUSHJ P,GNCH ;GET NEXT AND CONTINUE
JUMPLE CS,SOK2 ;CHECK FOR END OF NUMBER
TLNN CS,SNUMF_16 ;CHECK FOR NUMBER
JRST SL2P ;MUST BE AN IDENT
JRST SN1A ;CONTINUE SCANNING NUMBER
SOK2: TRO FL,NUMF ;IT WAS A NUMBER
LSH T1,1 ;CONVERT TO LINE NUMBER
IOR T1,[<ASCII /00000/>!1]
JRST SOK1 ;SAVE DELIM AND RETURN
SUBTTL PLACE FINDING ROUTINES
;FIND-- PAGE TO FIND IS IN DPG. NUMBER TO FIND IS IN SINDEX.
;LOADS T1 WITH THE LINE NUMBER FOUND
;IF NO EXACT MATCH WILL FIND NEXT HIGHER NUMBER OR A PAGE MARK.
FIND: MOVE T1,DPG ;GET THE DESIRED PAGE
CAMLE T1,CPG ;IS IT GREATER THAN THE PAGE WE ARE ON
JRST FWDPG ;YES, SEARCH FORWARD FOR PAGE
CAML T1,CPG ;IS IT THE SAME AS THE CURRENT PAGE?
JRST FEQPG ;YES, JUST SEARCH FOR LINE NUMER
SUBI PNTR,1 ;BACK UP A LITTLE (IN CASE POINTED AT PAGE MARK)
FIND1: PUSHJ P,CHKREN ;SEE IF REENTER
JRST FNDONE ;YES: FINISH UP
SKIPN T1,(PNTR) ;GET THE WORD, BUT WATCH FOR START OF BUFFER
JRST FINDHD ;WILL HAVE TO FINISH COPY AND START OVER
CAME T1,PGMK ;IS IT A PAGE MARK?
SOJA PNTR,FIND1 ;CONTINUE SEARCHING
SOS T1,CPG ;DECREASE THE PAGE WE ARE NOW ON
CAME T1,DPG ;IS IT THE RIGHT ONE YET?
SOJA PNTR,FIND1 ;NO, KEEP SEARCHING
SUBI PNTR,1 ;BACK OVER PAGE MARK
FIND2: PUSHJ P,CHKREN ;REENTER?
JRST FNDONE ;YES:
SKIPN T1,(PNTR) ;PICK UP WORD AND CHECK FOR START OF BUFFER
JRST FINDHD ;HAVE TO DO IT THE HARD WAY
TRNN T1,1 ;IS IT A SEQUENCE NUMBER?
SOJA PNTR,FIND2 ;NO, CONTINUE SEARCH
CAMN T1,PGMK ;IS IT PERHAPS A PAGE MARK?
AOJA PNTR,FNDFW1 ;YES, GO FORWARD A LINE AND RETURN IT
CAMGE SINDEX,T1 ;IS THE LINE WE WANT GREATER OR EQUAL TO THIS ONE
SOJA PNTR,FIND2 ;NO, KEEP UP THE GOOD WORK
CAMN SINDEX,T1 ;EXACT MATCH?
POPJ P, ;YES, RETURN
JRST FNDFW1 ;GO FORWARD A LINE TO GET NEXT LARGER
FEQPG: SKIPN T1,(PNTR) ;CHECK THE WORD WE ARE POINTING AT
JRST FNDFOO ;MUST BE POINTING AT END OF BUFFER OR BUFFER EMPTY
CAMN T1,PGMK ;IS IT A PAGE MARK?
SOJA PNTR,FIND2 ;MUST BE ONE AT END OF PAGE, SEARCH BACKWARDS
FEQPG1: CAMGE SINDEX,T1 ;COMPARE TO LINE WE WANT
JRST FIND2 ;WANT A SMALLER ONE, SEARCH BACK
JRST FNDFW1 ;SEARCH FORWARD
FWDPG: PUSHJ P,CHKREN ;REENTER?
JRST FNDONE ;YES:
SKIPN T1,(PNTR) ;SEARCH FORWARD FOR PAGE
JRST FNXRCP ;END OF BUFFER, GET A NEW ONE
CAME T1,PGMK ;FOUND A PAGE MARK?
AOJA PNTR,FWDPG ;NO, CONTINUE
AOS T1,CPG ;ADVANCE CURRENT PAGE COUNT
CAME T1,DPG ;AND SEE IF WE ARE THER YET
AOJA PNTR,FWDPG ;NUTS, LOOK SOME MORE
ADDI PNTR,1 ;ADVANCE BEYOND PAGE MARK
FNDFW1:
FIND3: PUSHJ P,CHKREN ;REENTER?
JRST FNDONE ;YES:
SKIPN T1,(PNTR) ;LOOK FOR LINE
JRST FNXRC ;END OF RECORD, GET A NEW ONE
TRNN T1,1
AOJA PNTR,FIND3 ;NOT LINE NUMBER
CAMN T1,PGMK ;PAGE MARK
POPJ P, ;RETURN IT, IT IS BEST MATCH WE CAN FIND
CAMLE SINDEX,T1 ;ARE WE THERE YET?
AOJA PNTR,FIND3 ;NO, CONTINUE SEARCH
POPJ P, ;YES, FINALLY
FNDFOO: CAMN PNTR,BUFP ;ARE WE POINTED TO START OF BUFFER
JRST FDFOO1 ;YES, BUFFER MUST BE EMPTY
SUBI PNTR,1 ;NO, MUST HAVE BEEN AT END OF BUFFER
FDFOO2: SKIPN T1,(PNTR) ;GET WORD
ERROR ICN ;MUST BE CONFUSED, THERE SHOULD BE A LINE NUMBER
TRNN T1,1 ;SEARCH FOR LINE NUMBER
SOJA PNTR,FDFOO2 ;KEEP LOOKING
CAMN T1,PGMK ;IS IT A PAGE MARK
AOJA PNTR,FNDFW1 ;YES, SEARCH FORWARD
JRST FEQPG1 ;GO DO SOMETHING WITH IT
FDFOO1: TRNE FL,EOF2 ;ARE WE AT END OF FILE?
JRST FINDHD ;WILL HAVE TO TRY FROM START
PUSHJ P,GETN ;GET THE NEXT BUFFER
JRST FEQPG
;HERE TO SAY WE HAVE BEEN INTERUPTED
FNDONE: JRST COMND ;JUST GO TO CMD LOOP FOR NOW
FNXRCP: TRNE FL,EOF2 ;AR WE AT END OF FILE
JRST FNX1 ;YES, JUST RESET BGPG AND LOOK AGAIN
PUSHJ P,GETN ;GET THE NEXT BUFFER
JRST FWDPG ;AND CONTINUE SEARCH
FNX1: MOVE T1,CPG ;SET BGPG TO CURRENT PAGE
MOVEM T1,BGPG
TRO FL,BGSN ;RECORD THAT LARGEST PAGE SEEN
MOVEI T1,0 ;RETURN 0 FOR EOF
POPJ P,
FNXRC: TRNE FL,EOF2 ;ARE WE AT END OF FILE
JRST FNX1 ;YES, GIVE HIM BACK THE 0
PUSHJ P,GETN ;NO, GET THE NEXT BUFFER
JRST FIND3 ;AND CONTINUE LOOKING FOR LINE
FINDHD: TRNE FL,BOF ;ARE WE AT THE START OF THE FILE
JRST FNDFST ;YES, CAN NOT GO BACK JUST GIVE FIRST LINE OF FILE
TLNE FL,COPFIL ;IS THIS A COPY?
JRST FINDH4 ;YES: DON'T RELEAS IN & OUT
TRNE FL,READOF ;ALSO HANDLE SPECIAL IF RO
JRST FINDH
PUSHJ P,OCOMPL ;FINISH COPYING FILE
TLNN FL2,PCHGF ;ANY CHANGES THIS PASS?
JRST [SETZB T1,T2 ;NO - JUST DELETE OUTPUT
RENAME OUT,T1
JRST EDFLIN
RELEAS IN,0 ;AND CLOSE INPUT FILE
JRST FINDH1]
FINDH: SKIPE AUXFIL
JRST [SETZB T1,T2
RENAME IN,T1
JRST EDFLIN
JRST .+1]
RELEAS IN,0 ;RELEASE IO DEVICES
MOVE T1,[OCRBLK,,ICRBLK]
BLT T1,ICRBKE ;COPY TEMP SPECS TO INPUT
MOVSI T1,'TMP' ;GET CORRECT EXTENSION
HLLM T1,ICREXT
TRNE FL,READOF ;READ ONLY?
JRST FINDH1 ;YES: SKIP RENAME
PUSHJ P,OUTDO ;PURGE BUFFER
XRENM OUT,ICRBLK ;RENAME OUTPUT FILE
JRST EDFLIN ;LOSER
FINDH1: RELEAS OUT,0 ;CLOSE NOW
MOVE T1,OCRDEV
MOVEM T1,OUDEVI+1 ;GET OUTPUT STR ALSO
MOVE T1,ICRDEV
MOVEM T1,INDEVI+1
OPEN IN,INDEVI ;AND GET THEM BACK
JRST NODSK ;WHERE DID THE DISK GO, IT WAS HARE BEFORE
OPEN OUT,OUDEVI
JRST NODSK
MOVE T1,BUFHD ;SET UP JOBFF TO ESTABLISH BUFFERS
MOVEM T1,.JBFF##
HLRZ T1,EDBUF ;GET BUFFER INFO
INBUF IN,0(T1)
OUTBUF OUT,0(T1)
TRNE FL,READOF ;ARE WE IN READ ONLY MODE?
JRST FINDH2 ;SET TO POINT TO ORIGINAL NAME AGAIN
TLNE FL2,PCHGF ;LEAVE AS IS IF NO CHANGES
SETOM AUXFIL ;MARK AUX FILE IN USE
XLOOK IN,ICRBLK ;OPEN INPUT FILE
JRST EDFLIN ;BUT IT JUST PUT ONE THERE
IFN CRYPSW,<
SETOM IBUF+3 ;INIT BLK CNTR
>
XENTR OUT,OCRBLK
JRST EDFLIN ;SOME OTHER BASTARD MUST BE USING IT
SETZM OPG ;OUTPUT PAGE CNTR
IFN CRYPSW,<
MOVNI T1,2
MOVEM T1,OBUF+3 ;INIT BLK CNTR
>
FINDH3: SETZM WC ;WC STARTS OUT 0
TDZ FL,[TECOF,,EOF!EOF2]
TDO FL,[FSTOPF,,BOF]
TLNN FL,COPFIL ;DON'T HURT THIS FLAG IF IN COPY
TLZ FL2,PCHGF ;NO CHANGES YET
MOVEI T1,1 ;SET UP INPUT PAGE IN CASE OF
MOVEM T1,INPG ;ORDER OR LTL ERRORS ON INPUT
SETZM SVWD
SETZM OLDLIN ;USED IN CHECKING INPUT ORDER OF LINES
PUSHJ P,FILLBF ;FILL UP THE BUFFER
MOVEI T1,1
MOVEM T1,CPG ;START ON PAGE 1
MOVE PNTR,BUFP ;SET PNTR TO START OF WORLD
JRST FIND ;AND GO LOOKING
FNDFST: MOVE T1,@BUFP ;GET FIRST WORD
FNDFS1: MOVE PNTR,BUFP ;SET TO START OF WORLD
POPJ P, ;AND DISMISS
FINDH4: RELEAS ALTDV,0 ;LET GO OF ALTERNATE DEVICE
OPEN ALTDV,ALDEVI
JRST NODSK
MOVE T1,SVJRL2
MOVEM T1,.JBFF##
INBUF ALTDV,0
XLOOK ALTDV,ALTBLK
JRST NOFIL ;WHOOPS
JRST FINDH3
FINDH2: MOVE T1,[ORGBLK,,ICRBLK]
BLT T1,ICRBKE ;SET UP FILE NAME
XLOOK IN,ICRBLK
JRST NOFIL ;NO FILE THERE START OVER
IFN CRYPSW,<
SETOM IBUF+3 >
JRST FINDH3 ;GO ON
;FIND THE NEXT LINE, PAGE MARK, ETC.
FINDN1: SKIPN T1,(PNTR)
JRST FINDN2
TRNN T1,1
FINDN: AOJA PNTR,FINDN1
POPJ P, ;RETURN THE LINE
FINDN2: TRNE FL,EOF2 ;IS IT EOF?
POPJ P, ;YES, RETURN PRESENT T1 (0 FOR EOF)
PUSHJ P,GETN ;GET NEXT BUFFER
JRST FINDN1 ;GO LOOK SOME MORE
FINDZ1: SKIPN T1,(PNTR) ;AS FINDN BUT STOPS AT END OF RECORD
POPJ P,
TRNN T1,1 ;LINE NUMBER?
FINDZ: AOJA PNTR,FINDZ1
POPJ P,
;FIND THE PREVIOUS LINE
FINDB1: SKIPN T1,(PNTR) ;WATCH OUT FOR START OF BUFFER
JRST FINDB2
TRNN T1,1 ;LINE NUMBER?
FINDB: SOJA PNTR,FINDB1 ;TRY AGAIN
CAMN T1,PGMK ;TEST FOR PAGE MARK
SOS CPG ;NOW ON PREVIOUS PAGE
POPJ P, ;RETURN LINE NUMBER
FINDB2: TRNE FL,BOF ;AT START OF FILE?
JRST FNDFS1 ;YES, GO GET THE FIRST LINE OF FILE
MOVE T1,1(PNTR) ;GET THE FIRST LINE ON THIS PAGE
TRNN T1,1 ;MAKE SURE THERE IS ONE THERE
ERROR ICN ;NO, WE ARE CONFUSED
PUSH P,SINDEX ;SAVE (CALLER MAY NEED IT)
MOVE SINDEX,T1
PUSHJ P,FINDHD ;THIS WILL WORK AND WE WILL HAVE A LITTLE SPACE BEFORE
POP P,SINDEX ;GET THIS BACK
SOJA PNTR,FINDB1 ;GO LOOK BACK AGAIN
SUBTTL BUFFER HANDLING ROUTINES
OCOMPL: TLNN FL2,PCHGF ;SEE IF NEEDED
POPJ P, ;NO - RETURN
OCOMP0: MOVE T1,WC ;GET CURRENT WORD COUNT
ADD T1,BUFP ;TURN IT INTO A POINTER
PUSHJ P,DUMP ;DUMP DUMPS BUFFER FROM BUFP TO (T1)
SETZM WC ;TELL IT NO CURRENT WORD COUNT
TRNE FL,EOF2 ;ALL DONE?
POPJ P,
PUSHJ P,FILLBF ;FILL UP INPUT BUFFER
PUSHJ P,CHKREN ;DID WE REENTER?
JRST COMND ;YES: GO TO COMMAND LOOP
JRST OCOMP0 ;AND GO DUMP THIS ONE TOO
GCHAR: ;;; ENTRY FOR UNSEQUENCE (CHAR MODE)
GETWD: TRNE FL,EOF
JRST RTEOF ;RETURN 0 IF EOF
TLNE FL,COPFIL ;IN A COPY, WE GET FROM SOMEWHERE ELSE
JRST COPGET
SOSG IBUF+2 ;CHECK FOR MORE WORDS
PUSHJ P,GETDO ;NO - GET SOME BY INPUT
GETWD1: ILDB T3,IBUF+1 ;PICK UP A WORD
JUMPE T3,GETWD ;IGNORE 0 WORDS
POPJ P, ;RETURN
GETDO: IN IN,0 ;FETCH A BUFFER
JRST GTUNDO ;OK RETURN
STATZ IN,1B22 ;ERROR - MAYBE EOF?
TROA FL,EOF ;EOF - SET FLAG
ERROR DIE ;YOU LOSE!
POP P,0(P) ;RETURN UP A LEVEL
RTEOF: MOVEI T3,0 ;AND RETURN A ZERO
POPJ P,
GTUNDO:
IFN CRYPSW,<
MOVEM 7,S.CRYP+7
MOVEI 7,S.CRYP
BLT 7,S.CRYP+6
AOS 6,IBUF+3 ;GET BLK NUMBER
MOVE 5,ICRCOD
HRRZ 7,IBUF ;ADDR OF BUFFER
ADD 7,[XWD -200,2]
PUSHJ P,CRYPT.##
MOVSI 7,S.CRYP
BLT 7,7
>
POPJ P,
PCHAR: ;;; ENTRY FOR UNSEQUENCE (CHAR MODE)
OUTWD: SOSG OBUF+2 ;CHECK WORDS LEFT
PUSHJ P,OUTDO
OUTWD1: IDPB T3,OBUF+1 ;OUTPUT IT
POPJ P, ;AND RETURN
OUTDO: TLNE FL2,DSKCK ;CHECK DISK?
PUSHJ P,DSKTST ;YES:
IFN CRYPSW,<
MOVEM 7,S.CRYP+7
MOVEI 7,S.CRYP
BLT 7,S.CRYP+6
HRRZ 7,OBUF
ADD 7,[XWD -200,2]
MOVE 5,OCRCOD
AOSL 6,OBUF+3 ;ALLOW FOR DUMMY OUTPUT
PUSHJ P,CRYPT.##
MOVSI 7,S.CRYP
BLT 7,7
>
OUT OUT,0
POPJ P, ;NO ERRORS - RETURN
PUSH P,[OUTDOK] ;FAKE UP PDL
PUSH P,T1 ;SAVE T1
PUSH P,T2 ; AND T2
STATO OUT,1B21 ;ERROR OR QUOTA EXCEDED
ERROR DDE ;ERROR - YOU LOSE
JRST DSKBTL ;GO TELL LOSER
;;;; POPJ RETURN TO .+1
OUTDOK: TLO FL2,DSKCK ;REMEMBER THIS HAPPENED
POPJ P, ;OUTPUT ALREADY DONE IT SEEMS
;ROUTINE TO DUMP BUFFER FROM BUFP TO (T1)
DUMP: MOVE T2,BUFP
CAMGE T2,T1 ;CHECK TO SEE IF WE ARE DUMPINF ANYTHING
TRZ FL,BOF ;IF SO TURN OFF BOF
TRNN FL,READOF ;RETURN IF READ ONLY MODE
DUMP1: CAML T2,T1 ;MORE TO DO?
POPJ P, ;NO, RETURN
PUSH P,T1 ;SAVE FOR LATER
MOVEI T1,1(T2) ;FIND END OF THIS LINE
DUMP3: SKIPN T3,(T1) ;ANY OLD END WILL DO
JRST DUMP2
TRNN T3,1 ;SUCH AS A LINE NUMBER
AOJA T1,DUMP3 ;NOT YET
DUMP2: SUB T1,T2 ;GET LENGTH
CAML T1,OBUF+2 ;WILL IT FIT?
PUSHJ P,OUTDO ;NO, DUMP CURRENT BUFFER
DUMP4: MOVE T3,(T2) ;PICK UP WORD
CAMN T3,PGMK ;COUNT UP OUTPUT PAGES
AOS OPG ;...
PUSHJ P,OUTWD
ADDI T2,1 ;ADVANCE POINTER
SOJG T1,DUMP4 ;AND CHECK COUNT
POP P,T1
JRST DUMP1 ;GO CHECK FOR END
DSKTST: PUSH P,T1 ;SAVE SOME AC'S
PUSH P,T2
PUSHJ P,FREDSK ;FIND OUT HOW MUCH DSK THERE IS
CAIL T1,MINDSK ;LESS THAN MINIMUM?
JRST DSKRET ;NO: PROCEED
DSKBTL: CLRBFI ;YES: CLEAR TYPE AHEAD
OUTSTR DSKMS2 ;TELL HIM WHAT HAPPENED
PUSHJ P,TELSP0 ;SUMMARY OF SPACE
DSKTS0: OUTSTR [ASCIZ /
Well? /]
INCHRW T1 ;GET ANSWER
DSKTS1: CLRBFI
OCRLF
ANDI T1,137 ;FORCE UPPER CASE
CAIN T1,"G"
JRST NOWAT
CAIN T1,"R"
JRST DSKRES
CAIN T1,"T"
JRST TTEST
CAIE T1,"W"
JRST DSKHLP
TLO FL2,SLPSW ;SET FOR SPECIAL SLEEP ACTION
CHKTYP: INCHRS T1 ;LOOK FOR CHAR
JRST TRYDSK ;NOPE - TRY DSK OUTPUT
JRST DSKTS1 ;YES - LOOK AT WHAT HE TYPED
TRYDSK: MOVEI T1,2 ;SLEEP FOR 2 SEC.
SLEEP T1, ;ZZZ
TTEST: PUSHJ P,FREDSK ;CHECK FREE STORAGE
BTEST: CAIL T1,MINDSK ;OK NOW?
JRST [OUTSTR [ASCIZ /DSK ok now./]
OCRLF
JRST DSKRET]
TLNN FL2,SLPSW ;CHECK SPECIAL
JRST DSKTS0 ;TO TOP OF LOOP
OUTCHR [15]
JRST CHKTYP ;TRY AGAIN
NOWAT: TLZ FL2,DSKCK ;TURN OFF DISK CHECKING
DSKRET: POP P,T2 ;RESTORE AC'S
POP P,T1
POPJ P,
DSKRES: PUSHJ P,TELSPC ;PRINT OUT RESOURCES
JRST BTEST ;AND TRY NOW.
FREDSK: MOVE T1,[3,,STRNAM] ;DSKCHR UUO
DSKCHR T1,
SKIPA T1,[^D100] ;AS GOOD A NUMBER AS ANY
SKIPG T1,STRNAM+1 ;GET AMOUNT IN T1
ADDI T1,OVRDRW ;ADJUST FOR OVERDRAW
CAMLE T1,STRNAM+2 ;HOW ABOUT THE REST OF THE WORLD
MOVE T1,STRNAM+2 ;DISK IS FULL - GIVE LESSER
POPJ P,
;ROUTINE TO SET UP STR INFO FOR DSKCHK
STRSET: MOVEI T1,OUT ;PATH UUO ON OUTPUT CHL
MOVEM T1,PTHADR
MOVE T1,[<SFDLVL+4>,,PTHADR]
PATH. T1,
SKIPA T1,[SIXBIT "DSK"]
MOVE T1,PTHADR
MOVEM T1,STRNAM ;STORE STRUCTURE NAME
MOVE T1,[5,,STRNAM]
DSKCHR T1, ;GET REAL NAME
SKIPA T1,[SIXBIT "DSK"]
MOVE T1,STRNAM+4
MOVEM T1,STRNAM ;ACTUAL NAME
MOVEM T1,OCRDEV ;ACTUAL DEVICE
POPJ P,
DSKHLP: OUTSTR DSKMSG
JRST DSKTS0
DSKMSG: ASCIZ "You must type:
G - Do the output (now and forever).
T - Test disk space and do output if space available.
R - Give resources and do output if space available.
W - Wait until either space appears or you type a different response.
"
DSKMS2: ASCIZ "
[Insufficient disk space to do output]
"
TELSPC: PUSHJ P,FREDSK
TELSP0: MOVE T2,STRNAM+1 ;GET FREE SPACE
JUMPL T2,TELOVR ;OVERDRAWN?
TELSP1: PUSHJ P,DPRNT ;PRINT IN DECIMAL
OUTSTR [ASCIZ " disk blocks in your area on "]
MOVE T2,STRNAM ;SIXBIT ATOM TO PRINT
PUSHJ P,PRTSX6
PUSHJ P,FORCE ;DUMP BUFFER
OCRLF
MOVE T2,STRNAM+2 ;GET REST OF WORLD
PUSHJ P,DPRNT ;IN DECIMAL
OUTSTR [ASCIZ " blocks for all users on this structure"]
OCRLF
POPJ P, ;RETURN
TELOVR: OUTSTR [ASCIZ "Over quota by "]
MOVN T2,T2 ;TELL HIM BAD NEWS
JRST TELSP1
INSIST: OUTSTR [ASCIZ "? You must type either "]
CONFRM: OUTSTR [ASCIZ "(y or n): "]
INCHRW T1 ;GET RESPONSE
ANDI T1,137 ;FORCE UPPER CASE
CLRBFI
CAIE T1,"N"
JRST CONFRY ;MAYBE HE MEANT YES
OUTSTR [ASCIZ "o
"]
POPJ P,
CONFRY: CAIE T1,"Y"
JRST INSIST
OUTSTR [ASCIZ "es
"]
JRST CPOPJ1
GETN: MOVE T1,WC ;GET THE NEXT BUFFER. FIND CURRENT WORD COUNT
CAMGE T1,HLFWC ;GREATER THAN HALF OF MAX POSSIBLE?
JRST FILLBF ;NO, JUST REFILL BUFFER
ASH T1,-1 ;YES, TAKE HALF OF IT
ADD T1,BUFP ;CONVERT TO POINTER
GETN1: SKIPN T2,(T1) ;LOOK FOR A WORD BOUNDARY
JRST NOWFL ;WE ARE HERE?
TRNN T2,1 ;SEQUENCE NUMBER?
SOJA T1,GETN1
NOWFL: PUSHJ P,DUMP ;DUMP IT
MOVE T2,T1 ;COPY POINTER
SUB T2,BUFP ;AND FIND OUT HOW MANY DUMPED
SUB PNTR,T2 ;ADJUST POINTER
EXCH T2,WC ;CALC NEW WORD COUNT
SUBB T2,WC
ADD T2,BUFP ;GET POINTER TO END OF BUFFER
HRLS T1 ;SET UP BLT
HRR T1,BUFP
BLT T1,(T2)
JRST FILLBF ;AND FINISH FILLIN BUFFER
FILLBF: MOVE T1,WC ;GET WORD COUNT
ADD T1,BUFP ;AND CONVERT TO POINTER TO END OF BUFFER
FILBF3: CAML T1,FILPT ;FULL ENOUGH?
POPJ P, ;YES, RETURN
TLNE FL,TECOF ;SPECIAL READING FOR TECO FILES
JRST RDTECO
HRLI T1,-MXWPL-2 ;GET A COUNT FOR MAX LINE SIZE
SKIPN T3,SVWD ;SEE IF THERE IS A WORD LEFT FROM LAST TIME
PUSHJ P,GETWD ;ELSE GET A NEW ONE
JUMPE T3,SNEOF ;MUST BE EOF
CAMN T3,PGMK ;CHECK FOR PAGE MARKS
JRST CKPGMK ;GO FUDGE P/M
TLZE FL,FSTOPF ;IF FIRST OP
JRST CKTECO ;CHECK FOR TECO FILE
NOTECO: MOVEM T3,SVWD2 ;SAVE FOR SEQUENCE CHECK
JRST FILBF4 ;GO PUT IT AWAY
FILBF1: PUSHJ P,GETWD ;ELSE GET A NEW ONE
JUMPE T3,FILBF2 ;0 WORD MUST BE EOF
TRNE T3,1 ;CHECK FOR SEQNUM
JRST FILBF2 ;YES, FINISH PUTTING IT IN
FILBF4: MOVEM T3,(T1) ;PUT IN THIS WORD
AOS WC ;AND ADVANCE WORD COUNT
AOBJN T1,FILBF1 ;ADVANCE POINTER AND CHECK COUNT
JRST INLTL ;LINE IS TOO LONG
FILBF2: MOVEM T3,SVWD ;SAVE THIS WORD
FILBF0: SETZM (T1) ;MAKE SURE OF A ZERO WORD
HRRZS T1 ;ELIMINATE COUNT INFO
MOVE T3,SVWD2 ;CHECK ON ORDER OF INPUT LINES
CAMG T3,OLDLIN ;CHECK FOR CORRECT ORDER
JRST OUTOFO ;LINES ARE OUT OF ORDER
FILBF5: MOVEM T3,OLDLIN ;SAVE FOR LATER
SKIPE SVWD ;CHECK TO SEE IF WAS EOF
JRST FILBF3 ;AND TRY FOR MORE
SNEOF: SETZM (T1) ;MAKE SURE OF ZERO WORD
TRO FL,EOF2 ;SET EOF FLAG
MOVE T1,INPG ;GET INPUT PAGE
MOVEM T1,BGPG ;AND SET LARGEST PAGE
TRO FL,BGSN
SETZM SVWD ;ALSO ZERO EXTRA WORD
POPJ P, ;AND RETURN
CKPGMK: SETZM OLDLIN ;RESET LINE LAST INPUT
AOS INPG ;INCR INPUT PAGE
MOVEM T3,0(T1) ;STASH PGMK
AOS WC ;INCR WORD/COUNT
PUSHJ P,GETWD ;PASS NEXT WORD
MOVE T3,PGMKW2 ;GRNTEE CORRECT P/M 2ND WORD
MOVEM T3,1(T1) ;STASH
AOS WC ;INCR WC
SETZM 2(T1) ;GRNTEE ZERO WORD
SETZM SVWD ;FORCE READ
MOVEI T1,2(T1) ;CORRECT PNTR
JRST FILBF3 ;CHECK FULL
INLTL: PUSHJ P,GETWD ;FIND THE END OF THE LINE ON INPUT
JUMPE T3,INLTL2 ;THIS IS IT
TRNN T3,1 ;OR MAYBE THIS
JRST INLTL ;KEEP LOOKING
INLTL2: MOVEM T3,SVWD ;SAVE IT
PUSH P,T1 ;SAVE POINTER TO END OF IT
SUBI T1,2 ;LAST PART THAT IS IN THE LINE
MOVEI T2,<BYTE (21)0(7)15,12> ;A CRLF
DPB T2,[POINT 15,(T1),35] ;MAKE SURE IT ENDS PROPERLY
INLTL1: SKIPN T2,(T1) ;NOW LOOK FOR THE START OF IT
ERROR ICN ;SOMETHING HAS GONE WRONG, THERE IS NO LINE
TRNN T2,1 ;START?
SOJA T1,INLTL1 ;NO, TRY AGAIN
MOVE T2,INPG ;PRINT HIM THE CURRENT PAGE
PUSHJ P,PGPRN
PUSHJ P,OUTLIN ;PRINT THE LINE
RERROR LTL ;AND THE ERROR MESSAGE
POP P,T1 ;RESTORE POINTER TO END
SOS WC ;GET WORD COUNT CORRECTED
SOJA T1,FILBF0 ;AND CONTINUE FILL
OUTOFO: PUSH P,T1 ;SAVE THE POINTER
PUSH P,T3 ;SAVE T3 ALSO
SUBI T1,1 ;GET BACK INTO LINE
OUTOF1: SKIPN T2,(T1) ;LOOK FOR START OF LINE
ERROR ICN ;HORRIBLE CONFUSION
TRNN T2,1 ;CHECK FOR SEQ NUM
SOJA T1,OUTOF1 ;NOPE, TRY SOME MORE
MOVE T2,INPG ;PRINT HIM THE PAGE
PUSHJ P,PGPRN
PUSHJ P,OUTLIN ;PRINT THE LINE
RERROR ORDER ;GIVE HIM SOMETHING TO THINK ABOUT
POP P,T3 ;RESTORE
POP P,T1 ;GET SET TO GO ON
JRST FILBF5 ;GO
CKTECO: TRNE T3,1 ;CHECK FOR A LINE NUMBER
JRST NOTECO ;NO ITS NOT A TECO FILE
TLO FL,TECOF ;SET WARNING FLAG
SETZM SVWD ;GRNTEE USE FIRST SEQ #
TLNE FL,COPFIL ;IS IT ANOTHER FILE?
JRST CKTEC2 ;SPECIAL CHECK
TLO FL2,PCHGF!FCHGF ;SAVE WE'VE CHANGED
SETSTS IN,1 ;SET FOR CHAR AT A TIME INPUT
MOVSI T3,(<POINT 7,0>)
HLLM T3,IBUF+1 ;SET INPUT BYTE POINTER
MOVEI T3,5 ;COMVERT TO CHRS
IMULM T3,IBUF+2
AOS IBUF+2 ;AND COMPENSATE FOR THINKING WE TOOK ONE
RDTECO: HRRZM T1,TMPT1 ;SAVE THIS FOR A WHILE
MOVEI T3,1(T1) ;ZERO OUT A FEW WORDS
HRL T3,T1
SETZM (T1)
BLT T3,MXWPL(T1)
ADDI T1,1 ;THIS IS WHERE CHRS SHOULD BE PUT
PUSH P,T1 ;SAVE
SKIPE BASICF ;IS THIS A BASIC FILE
JRST RDBAS ;YES: PROCESS SPECIAL
SKIPE T1,SVWD ;CHECK BEGINNING OF PAGE
CAIN T1,1 ;...
JRST [MOVE T1,TECFST
MOVEM T1,SVWD
MOVEM T1,SVWD2
JRST RDTEC1]
MOVE T2,TECINC ;GET INCREMENT
PUSHJ P,ASCIAD
MOVEM T1,SVWD ;SAVE FOR LATER
MOVEM T1,SVWD2 ;AND FOR ORDER CHECK
CAMGE T1,TECINC ;CHECK WAR
JRST INSPG1 ;FORCE PAGE INSERT
RDTEC1: EXCH T1,(P) ;GET OLD T1 BACK AND SAVE NUMBER
MOVEI T2,MXWPL*5-2 ;COUNT
MOVEI T3,11 ;FIRST CHR
HRLI T1,(<POINT 7,0>)
IDPB T3,T1
LINL1: PUSHJ P,GETWD ;NEXT CHR
LINL1A: CAIN T3,15
JRST LINL1 ;IGNORE RETURNS
CAIN T3,14
JRST [SKIPE BASICF ;ILLEGAL IN BASIC MODE
ERROR BBF
JRST IPGMK]
JUMPE T3,EOF1 ;MUST BE END OF FILE
POP P,-1(T1) ;PUT NUMBER IN PROPER PLACE
JRST LP1 ;AND READ MORE OF LINE
CLP: PUSHJ P,GETWD
LP1: CAIN T3,15 ;IGNORE RETURNS
JRST CLP
CAIE T3,0 ;FOR EOF
CAIN T3,12 ;OR LINE FEED
JRST LINFD ;GO PUT IN RETURN LINE FEED
CAIN T3,14
JRST LINFD
IDPB T3,T1 ;ELSE DEPOSTI
SOJG T2,CLP ;HAVE WE RUN OUT
ADD T1,[XWD 700,0] ;BACK UP POINTER
TLZ FL,TECOF ;USE THE ABSENCE AS A FLAG
PUSHJ P,GETWD
CAIE T3,12
JUMPN T3,.-2
LINFD: MOVEI T3,15
IDPB T3,T1
MOVEI T3,12
IDPB T3,T1
MOVEI T1,1(T1)
MOVE T3,T1
SUB T3,TMPT1 ;GET COUNT
ADDM T3,WC
TLOE FL,TECOF ;IF OFF WE HAD A LTL ERR
JRST FILBF0 ;THIS WILL FINISH UP
PUSH P,T1 ;SET UP FOR LTL CODE
AOS WC
AOS (P)
SOJA T1,INLTL1
INSPG1: POP P,T1
SKIPA
IPGMK: POP P,T2 ;GET RID OF IT
MOVEI T3,1 ;SO IT WILL NOT BE EOF
MOVEM T3,SVWD ;SO WE START OVER
MOVE T3,PGMK
MOVEM T3,OLDLIN
MOVEM T3,-1(T1)
MOVEI T2,2
ADDM T2,WC
MOVE T3,PGMKW2
MOVEM T3,(T1)
SETZM 1(T1) ;GRNTEE ZERO
MOVEI T1,1(T1) ;UPDATE PNTR
AOS INPG ;INCR INPUT PAGE
JRST FILBF3 ;FINISH OFF
EOF1: POP P,T2 ;CLEAR STACK
SOJA T1,SNEOF
;HERE TO HANDLE BASIC FILES
RDBAS: MOVEI T2,5 ;5 CHARS MAX
MOVE T1,[<ASCII "00000">_<-1>]
RDBAS0: PUSHJ P,GETWD ;GET CHAR
JUMPE T3,BASEOF ;MUST BE EOF
CAIE T3,40 ;SKIP SPACES
CAIN T3,11 ;AND/OR TABS
JRST RDBAS0
CAIG T3,"9" ;FIRST CHAR MUST BE A DIGIT
CAIGE T3,"0" ;...
ERROR BBF
JRST RDBDG1
RDBDIG: PUSHJ P,GETWD ;FETCH NEXT CHAR
JUMPE T3,BASEOF ;EOF SEEN IF T3 := 0
CAIG T3,"9" ;MUST BE DIGIT
CAIGE T3,"0"
JRST RDBDG2 ;END OF DIGIT STREAM
RDBDG1: LSH T1,7 ;MAKE ROOM FOR NEW DIGIT
ADD T1,T3
SOJA T2,RDBDIG ;ADD IN AND READ NEXT
RDBDG2: SKIPGE T2 ;CHECK FOR MORE THAN 5
ERROR BBF
LSH T1,1 ;MAKE LIKE REAL SEQ #
IORI T1,1
MOVEM T1,SVWD ;SAVE GOOD THINGS
MOVEM T1,SVWD2
EXCH T1,0(P) ;GET PNTR BACK & SAVE #
HRLI T1,(<POINT 7,0>);FORM B.P.
MOVEI T2,11 ;DEPOSIT A TAB
IDPB T2,T1 ;...
MOVEI T2,MXWPL*5-2 ;INIT LTL CNTR
CAIE T3,11 ;IF TAB
CAIN T3,40 ; OR SPACE
JRST LINL1 ;GET NEXT CHAR
JRST LINL1A ;ELSE ALREADY HAVE CHAR
BASEOF: POP P,T1 ;RETURN POINTER
JRST SNEOF ;SAY EOF SEEN
SUBTTL RANGE SPECIFIER READERS
;ROUTINE TO GET ONE LINE NUMBER FROM INPUT STREAM. HANDLES + AND -
GETLS: PUSHJ P,SCAN
GETL: TRZ FL,LINSN!ADDL!SUBL
TRZ FL2,STARF
TLZ FL2,UARWF
CAIN C,"^"
JRST DOFST
CAIN C,"*"
JRST DOLST
IFN EXTEND,<
CAIN C,200 ;DO WE HAVE TO SEARCH FOR IT
PUSHJ P,LSRCH ;OK THEN HERE WE GO
>
TRZN FL,NUMF
POPJ P, ;SCAN DID NOT SEE A NUMBER RETURN (CALLER CAN GIVER ERR)
MOVEM T1,HILN ;SAVE THE NUMBER HERE
GETL1: TRO FL,LINSN ;SET A FLAG TO SAY WE SAW THE LINE
PUSHJ P,SCAN ;SCAN FOR + OR -
CAIN C,"+"
JRST ADDNUM
CAIE C,"-"
POPJ P, ;NEITHER
TROA FL,SUBL ;SET SUBTRACT FLAG
ADDNUM: TRO FL,ADDL ;SET ADD FLAG
PUSHJ P,SCAN ;SCAN ANOTHER
TRZN FL,NUMF ;WAS IT A NUMBER
NERROR ILC ;ANYTHING ELSE IS ILLEGAL
MOVEM T2,SVINC ;SAVE IT
JRST SCAN ;RETURN AFTER SCANNING ONE MORE
DOLST: TRO FL2,STARF
JRST GETL1
DOFST: TLO FL2,UARWF
JRST GETL1
;ROUTINE TO RESOLVE THE + AND - IN THE LINE NUMBER. WE MUST WAIT
;UNTIL THE PAGE HAS BEEN DEFINED BEFORE DOING THIS
ADDSUB: MOVE SINDEX,HILN ;GET THE NUMBER
MOVE T1,HIPG ;GET THE REQUIRED PAGE
MOVEM T1,DPG ;AND SET IT AS THE DESIRED ONE
TLNE FL2,UARWF
JRST [MOVE SINDEX,[<ASCII /00000/>!1]
PUSHJ P,FIND
SKIPE T1 ;FIND ANY
CAMN T1,PGMK
MOVE T1,[<ASCII /00100/>!1]
MOVE SINDEX,T1
JRST DOAS]
TRNN FL2,STARF
JRST DOAS
MOVE SINDEX,[<ASCII /99999/>!1] ;FIND A BIG LINE
PUSHJ P,FIND
CAME T1,[<ASCII /99999/>!1] ;IF ITS THERE ITS LAST
PUSHJ P,FINDB ;ELSE BACK UP
SKIPE T1 ;CHECK TO SEE IF EMPTY PAGE
CAMN T1,PGMK
SKIPA
MOVE SINDEX,T1 ;OK, USE ONE FOUND, ELSE LEAVE BIG
DOAS: TRZE FL,ADDL ;DID WE WANT TO ADD?
JRST ADLIN ;YES, GO ADD
TRZN FL,SUBL ;OR SUBTRACT?
CPOPJ: POPJ P, ;NO, RETURN
PUSHJ P,FIND ;GET THE DESIRED LINE
SUBL1: SOSGE SVINC ;DO WE WANT TO GO BACK STILL FARTHER
POPJ P, ;NO, ALL DONE
PUSHJ P,FINDB ;GET THE PREVIOUS LINE
SKIPE T1 ;0 MUST BE AT START OF BUFFER, QUIT
CAMN T1,PGMK ;WAS IT A PAGE MARK?
POPJ P, ;YES, AS FAR AS WE GO, SINDEX HAS CORRECT NUMBER
MOVE SINDEX,T1 ;THIS WILL DO
JRST SUBL1 ;GO TRY FOR MORE
ADLIN: PUSHJ P,FIND ;GET DESIRED LINE
CAME T1,PGMK ;WAS IT A PAGE MARK?
JUMPN T1,ADLIN1 ;OR 0 (I.E. END OF FILE)
POPJ P, ;RETURN WITH ORIGINAL NUMBER
ADLIN1: CAME T1,HILN ;SEE IF AN EXACT MATCH
SOS SVINC ;IF NO, ALREADY ARE +1
MOVE SINDEX,T1 ;GET THE WORD WE HAVE FOUND
ADLIN2: SOSGE SVINC ;NEED TO GO FURTHER
POPJ P, ;NO, RETURN RESULTS
PUSHJ P,FINDN ;GET THE NEXT LINE IN SEQUENCE
CAME T1,PGMK ;PAGE MARK?
JUMPN T1,.+2 ;OR EOF
POPJ P, ;YES, RETURN
MOVE SINDEX,T1 ;ACCEPT NEW NUMBER
JRST ADLIN2 ;AND LOOK FOR MORE
;ROUTINE GETS A FULL SEQ NUMBER OF FORM A/B
GETLAS: PUSHJ P,SCAN
GETLA: TRZ FL,PGSN ;NO PAGE SEEN YET
PUSHJ P,GETL ;GET THE LINE NUMBER PART
MOVE T2,CPGL ;IN CASE LSRCH GOT A NEW PAGE
TRNE FL,PGSN ;DID LSRCH GET PAGE?
MOVEM T2,HIPG ;YES, USE IT
CAIE C,"/" ;IS THIS A PAGE COMMING?
JRST NOPG ;NO, A LINE NUMBER AT MOST
PUSHJ P,SCAN ;YES, GET THE PAGE NUMBER
CAIN C,"*"
JRST LASTPG ;GET LAST PAGE #
CAIE C,"^" ;UPARROW MEANS
JRST GETLPG ;GET PAGE 1
MOVEI T2,1
TRO FL,NUMF ;MAKE LIKE NUMBER
GETLPG: SKIPLE T2 ;NUMBERS .LE. 0 LOSE
TRZN FL,NUMF ;WAS IT A NUMBER
NERROR ILC ;LOSE LOSE
TRO FL,PGSN ;YEP, WE SAW IT
MOVEM T2,HIPG ;SAVE THAT NUMBER
PUSHJ P,SCAN ;CHECK FOR + OR -
CAIN C,"+"
JRST PGPLS
CAIE C,"-"
JRST NOPG ;NO, GO DO ADSUB ON LINE NUMBER
PUSHJ P,SCAN ;GET THE NUMBER
TRZN FL,NUMF ;MUST BE A NUMBER
NERROR ILC
MOVE T1,HIPG
SUB T1,T2
MOVEM T1,HIPG ;FILL IN NUMBER
NOPGA: PUSHJ P,SCAN ;SCAN PAST NUMBER
NOPG: TRNN FL,LINSN!PGSN ;DID WE SEE A LINE OR A PAGE?
NERROR ILC ;NO, SOMETHING IS WRONG
PUSH P,T1 ;SAVE (HAVE ALREADY SCANNED)
PUSH P,T2
PUSHJ P,ADDSUB ;TAKE CARE OF + AND - FOR LINE
POP P,T2
POP P,T1
MOVEM SINDEX,HILN ;SAVE RESULT
POPJ P, ;AND RETURN
PGPLS: PUSHJ P,SCAN ;GET NUMBER TO ADD
TRZN FL,NUMF ;A NUMBER?
NERROR ILC ;NO, NERROR
ADDM T2,HIPG ;ADD IT IN
JRST NOPGA ;AND CLEAN UP
LASTPG: TRNE FL,BGSN ;SEEN LAST
JRST LSTPG1 ;YES: SKIP CODE
MOVSI T1,1
MOVEM T1,DPG ;TRY FOR LARGE
MOVEI SINDEX,0
PUSHJ P,FIND
TRNN FL,BGSN ;SHOULD SEE IT NOW
ERROR ICN
LSTPG1: MOVE T2,BGPG
TRO FL,NUMF ;NUMBER SEEN
JRST GETLPG
;ROUTINE SETS HIPG IN CASE NONE SEEN BY GETLA, THEN CALLS GETLA
GET1S: PUSHJ P,SCAN
GET1: MOVE T3,CPGL
MOVEM T3,HIPG
JRST GETLA
;GET A PAIR OF FORM A/B,C/D LOLN IS SET BY CALLER BEFORE CALL
GET2S: PUSHJ P,SCAN
GET2: TRZ FL,CNTF ;NOT A ! COMMAND
PUSHJ P,GET1 ;GET A LINE AND PAGE NUMBER PAIR
MOVE T3,HIPG ;NOW SET LOWER PAGE TO THE ONE SEEN
MOVEM T3,LOPG
MOVE T3,HILN ;RESET LOW LINE IS A NUMBER SEEN
TRNE FL,LINSN
MOVEM T3,LOLN
GET2HF:MOVE T3,[<ASCII /99999/>!1] ;SET UP A LARGE NUMBER
TRNN FL,LINSN ;IF NO LINE NUMBER SEEN
MOVEM T3,HILN
TRZ FL,PGSN ;SO DELETE CAN DETECT A SECOND PAGE SPEC
CAIN C,"!" ;IS IT A ! COMMAND?
JRST GET2CT ;GO TAKE CARE OF IT
CAIE C,":" ;CHECK FOR SECOND SET
POPJ P, ;NOPE, RETURN
MOVEM T3,HILN ;SET HILN ANYWAY
JRST GETLAS ;AND GO GET THE SECOND PAIR
GET2CT: TRO FL,CNTF ;SET THE APPROPRIATE FLAG
PUSHJ P,SCAN ;THERE SHOULD BE A NUMBER HERE
TRNN FL,NUMF
NERROR ILC ;LOSE
MOVEM T2,SVCNT ;HANG ON TO IT
JRST SCAN ;SCAN NEXT AND RETURN
SUBTTL LINE NUMBER SEARCH
IFN EXTEND,<
;SEARCH FOR A LINE AND USE ITS NUMBER INSTEAD OF .
;MOSTLY PLAGIARIZED FROM SEARCH
LSRCH: PUSH P,SVINC ;SAVE PREVIOUSLY GATHERED LINE NUMBERS
PUSH P,SVCNT
PUSH P,HIPG
PUSH P,LOLN
PUSH P,LOPG
PUSH P,FL ;SAVE FLAGS IN CASE CALLED WITHIN SEARCH
PUSH P,FL2
TLZ FL,ASSMF ;CLEAR ALL FLAGS
SETZM LOLN ;JUST LIKE EVERYONE ELSE HAS TO
SETZM LSCNT ;START WITH ZERO
SOSGE LSBUFN ;GET STRING BUFFER NUMBER
NERROR TMS ;NESTING TOO DEEP
MOVE T2,LSBUFN ;INDEX IN STRING BUFFER TABLES
MOVE T1,LSPTR(T2) ;SET UP BYTE POINTER
MOVE T3,LSPTT(T2) ;AND POINTER TO BYTE POINTER TABLE
PUSHJ P,SSTRNG ;GET A SEARCH STRING
JRST [MOVE T2,LSBUFN ;INDEX TO POINTERS
SKIPN @LSPTT(T2) ;WAS STRING SET?
NERROR NSG ;NO, TELL HIM
CAIN C,12
JRST ASLMD1 ;SPECIAL CONTINUE MODE
JRST .+1] ;YES, USE OLD ONE
TLZ FL,NUMSRF!DECID!EXCTSR ;CLEAR FLAGS
PUSHJ P,SCAN ;CHECK FOR WHAT COMES AFTER
TRNN FL,TERMF ;IF TERMINATOR
CAIN C,"," ;OR ,
JRST ASLMDT ;SET UP LIMITS SPECIALLY
CAIE C,"!"
CAIN C,":"
JRST ASLMDT ;LET HIM SPECIFY 2ND HALF OF RANGE
PUSHJ P,GET2 ;ELSE CALL USUAL LIMIT ROUTINE
LSC4: MOVE T1,HILN ;SAVE END OF RANGE
MOVEM T1,LSHILN
MOVE T1,HIPG
MOVEM T1,LSHIPG
CAIE C,"," ;ANY MORE ARGUMENTS?
JRST LSC1 ;NO, CHECK TERMINATOR AND PROCEED
PUSHJ P,SCAN ;YES, SEE WHAT IT IS
TRNN FL,IDF ;SHOULD BE IDENT OR NUMBER
JRST LSC2 ;NOT IDENT, CHECK FOR NUMBER OF SEARCHES
MOVS T1,ACCUM ;GET THE IDENT
CAIN T1,(<SIXBIT /N />) ;AND FIND OUT WHAT IT IS
TLO FL,NUMSRF!DECID
CAIN T1,(<SIXBIT /D />)
TLO FL,DECID ;WANTS TO DECIDE ON LINE
TLNN FL,NUMSRF!DECID ;WAS IT EITHER?
JRST LSC3 ;NO, CHECK E
PUSHJ P,SCAN ;CONTINUE LOOKING
CAIE C,","
JRST LSC1 ;NO MORE ARGUMENTS
PUSHJ P,SCAN ;WELL WHAT KIND IS THIS ONE?
TRNN FL,IDF ;MORE IDENTS?
JRST LSC2 ;NO, MUST BE NUMBER OF SEARCHES
MOVS T1,ACCUM
LSC3: CAIE T1,(<SIXBIT /E />)
NERROR ILC ;NO, HE MUST HAVE MADE A MISTAKE
TLO FL,EXCTSR ;YES, REMEMBER IT
PUSHJ P,SCAN ;AND CHECK FOR MORE
CAIE C,","
JRST LSC1 ;NO MORE
PUSHJ P,SCAN ;ONLY ONE THING IT CAN BE NOW
LSC2: TRNN FL,NUMF
NERROR ILC ;NOPE, LOSE
MOVEM T2,LSCNT ;SAVE AS COUNT OF LINES TO FIND
PUSHJ P,SCAN ;GET TERMINATOR (WE HOPE)
LSC1: TRNN FL,TERMF ;ALLS WELL THAT ENDS WELL
NERROR ILC ;BUT THIS DOSNT
LSCH1A: MOVE T1,LSBUFN
MOVE T1,LSPTT(T1) ;GET POINTER TO STRINGS
PUSHJ P,CODSR ;AND GENERATE CODE
MOVE T1,LOPG ;GET SET TO HUNT IT
MOVEM T1,DPG
MOVEM T1,LSPG ;FLAG TO SAY IF WE SHOULD PRINT PAGE
MOVE SINDEX,LOLN
PUSHJ P,FIND
TRZ FL,LINSN ;NO LINES YET
ONLSC: PUSHJ P,ONMOV ;CHECK RANGE
JRST ENDLSC ;DONE
TLZE FL,ASSMF ;FIRST TIME AND WANT .+1?
JRST [CAME T1,LOLN ;IS THERE EXACT MATCH?
JRST .+1 ;NO, THIS IS .+1
AOS SVCNT ;PRETEND WE DIDNT SEE IT
JRST LSNXT] ;AND TAKE NEXT
CAMN T1,PGMK ;PAGES ARE SPECIAL
JRST LSCPAG ;SO TAKE GOOD CARE OF THEM
MOVE T2,LSBUFN
MOVE T2,LSPTT(T2) ;POINTER TO STRINGS
PUSHJ P,COMSRC ;GO SEARCH THIS LINE
JRST LSNXT ;LOSER
MOVE T2,CPG ;GET CURRENT PAGE
CAME T2,LSPG ;AND SEE IF WE SHOULD PRINT IT
PUSHJ P,PGPRN ;YES
MOVE T2,CPG ;NOW SET IT AS CURRENT
MOVEM T2,CPGL
MOVEM T2,LSPG ;ALSO RESET FLAG
MOVE T2,(PNTR) ;ALSO SET LINE
MOVEM T2,CLN
TRO FL,LINSN ;WE SAW ONE
TLNN FL,DECID ;DOES HE WANT OPTION?
JRST LSNXTC ;NO, GO GET NEXT ONE OR STOP
TLNE FL,NUMSRF ;DO WE WANT ONLY LINE NUMBERS?
JRST LSCNUM ;YES
MOVE T1,PNTR ;GO PRINT LINE
PUSHJ P,OUTLIN
LSNXT1:
INCHRW T1
ANDI T1,177
OCRLF
CAIE T1,177 ;DID HE SAY RUBOUT(DO NOT USE)?
JRST LSOUT ;NO, WE'RE THROUGH
LSNXTC: SOSG LSCNT ;HAVE WE FOUND ENOUGH
JRST LSOUT ;YES, GIVE UP (WE HAVE SEEN AT LEAST ONE)
LSNXT: PUSHJ P,FINDN ;GET NEXT LINE TO LOOK A
JRST ONLSC
LSCNUM: MOVE T1,(PNTR) ;PRINT SEQUENCE NUMBER
PUSHJ P,OUTSN
OCRLF
JRST LSNXT1 ;AND DECIDE
ENDLSC: TRZN FL,LINSN ;DID WE SEE ONE?
NERROR NLN ;NULL RANGE
JRST LSOUT
LSCPAG: AOS CPG ;JUST ADVANCE PAGE COUNTER
JRST LSNXT ;AND PROCEED
LSOUT: POP P,FL2 ;RESTORE THE FLAGS WE USED
POP P,T1
AND T1,[XWD ASSMF!NUMSRF!EXCTSR!DECID,ADDL!SUBL!CNTF]
ANDCM FL,[XWD ASSMF!NUMSRF!EXCTSR!DECID,ADDL!SUBL!CNTF]
IOR FL,T1
POP P,LOPG ;RESTORE PREVIOUS LINE NUMBERS
POP P,LOLN
POP P,HIPG
POP P,SVCNT
POP P,SVINC
MOVE T1,CLN ;LOAD CURRENT LINE AND PAGE WHICH WE FOUND
MOVE T2,CPGL
TRO FL, NUMF!PGSN ;AND MAKE LIKE SCAN SAW A NUMBER
AOS LSBUFN ;GO BACK TO SEARCH STRING ON PREVIOUS LEVEL IF ANY
POPJ P, ;AND EXIT VICTORIOUS
ASLMD1: TROA FL,CNTF ;MARK AS KEEP END OF RANGE
ASLMDT: TRZ FL,CNTF ;JUST IN CASE
TLO FL,ASSMF ;WE ASSUME .+1
MOVE T1,CLN ;SET THINGS UP FOR . TO INFINITY
MOVEM T1,LOLN
MOVEM T1,HILN ;AS GOOD AS ANYTHING WITH THE PAGE WE WILL
MOVE T1,CPGL ;USE
MOVEM T1,LOPG
TRZE FL,CNTF ;KEEP END?
JRST LNOSPC ;YES
CAIE C,":" ;IF A : OR !
CAIN C,"!"
JRST HALFLS ;GET THE SECOND HALF (.+1 TO GIVEN)
MOVSI T1,377777 ;GET A LARGE PAGE
MOVEM T1,HIPG
JRST LSC4 ;BACK INTO THINGS
HALFLS: MOVEM T1,HIPG ;SET TOP AS /.
PUSHJ P,GET2HF ;GET THE SECOND HALF
JRST LSC4 ;AND GO
LNOSPC: MOVE T1,LSHIPG
MOVEM T1,HIPG ;PUT BACK END
MOVE T1,LSHILN
MOVEM T1,HILN
JRST LSCH1A
>
SUBTTL INITIALIZE
;HERE IS THE INITIALIZE CODE
STPT:
SKIPA
JRST DOSAIL ;ENTRY POINT FOR SAIL
SETZM RPGSW
SETZM TMPCF ;CLEAR TMPCOR FLAG
IFN RENTSW,<
MOVEI 0,IMPEND
HRLM 0,.JBSA##
RESET
MOVE 0,.JBFF##
CORE 0, ;GET ENUF CORE
EXIT ;YOU LOSE
MOVE 0,[XWD DATAB,DATABL]
BLT 0,DATABL+DATAE-DATAB
>
SETZM ZEROB
MOVE 0,[XWD ZEROB,ZEROB+1]
BLT 0,IMPEND-1
MOVE 0,[BYTE (7) 15,15,15,15,15]
MOVEM 0,CRSX ;PUT CR'S IN PLACE
IFE RENTSW,< RESET >
HRROI P,[.+2] ;DUMMY PDL
JRST DISINT ;DISABLE ^C INT
MOVSI FL,QMODF ;SET FOR ' IS NOT SPECIAL
MOVEI FL2,0 ;NOTHING IN SECOND FLAG REGISTER
SETOM BAKF ;SET FOR BAK FILE
MOVEI T1,TTYCH ;SET UP DEFAULT INPUT
MOVEM T1,CHIN ;...
IFN CCLSW,<
MOVE T1,[POINT 7,CMDBUF]
MOVEM T1,P.TEXT
RESCAN 1
SKPINL ;CHECK SOMETHING THERE
JRST RPGRET ;NO--GO ASK USER
MOVE T1,[POINT 7,CMDBUF]
MOVEI T2,5*^D20
CMDL: SKPINC ;MAKE SURE SOMETHING THERE
JRST CMDD ;NO--GIVE UP
INCHWL T3 ;YES--GET IT
CAIN T3,15 ;PITCH RETURNS
JRST CMDL
IDPB T3,T1
CAIE T3,12 ;LOOK FOR TERM
CAIN T3,33
JRST CMDD
SOJG T2,CMDL
CMDD: MOVEI T3,12
DPB T3,T1
SETOM RPGSW
>
RPGRET: MOVE T1,[JSR ERRHD] ;SET UP UUO HANDLER
MOVEM T1,.JB41##
MOVEI T1,PDLOV ;SET UP A PDLOV TRAP
MOVEM T1,.JBAPR##
MOVEI T1,200000 ;SET FOR PDLOV ONLY
APRENB T1,
OPEN TTY,TTDEVI ;FOR SETSTS ONLY
EXIT ;YOU LOSE
MOVEI T1,TTIBUF ;SET UP INPUT BUFFER
EXCH T1,.JBFF##
INBUF TTY,1
MOVEM T1,.JBFF##
MOVE T1,[POINT 7,TTOBUF]
MOVEM T1,TTOPNT ;SET UP TTY OUTPUT BUFFER
MOVEI T1,^D80
MOVEM T1,TTOCNT
MOVE T1,.JBFF##
MOVEM T1,BUFHD ;FOR LATER RECOPY OPERATIONS
NOCOM0: TLNN FL2,AUTOF
MOVE P,[IOWD PDLSIZ,PDL]
TRNE FL2,SVIT ;SKIP * IF DOING W COMMAND
JRST RPGR1
TLZ FL2,INPARS!BELLF ;SAY WE ARE STARTING
SETZM OPTION ;LOOK FOR DEFAULT
PUSHJ P,DOOPT
JRST .+2 ;IGNORE NOT FOUND RETURN
JRST [OUTSTR [ASCIZ "? Syntax error in default options"]
SETZM RPGSW ;CLR CMD MODE
CLRBFI
JRST .+1]
NOCOM1: TLO FL2,INPARS ;SET FOR PARSE
IFN CCLSW,<
SKIPE RPGSW
JRST DOCMD.
>
OUTSTR [ASCIZ /
File: /]
DOCMD.: PUSHJ P,PARSE
RPGR1: TLZ FL2,INPARS ;PARSE DONE
MOVE T1,[ORGBLK,,ICRBLK]
BLT T1,ICRBKE ;MOVE INFO TO INPUT BLOCK
MOVE T1,[NEWBLK,,OCRBLK]
BLT T1,OCRBKE ;INFO FOR TEMP FILES
MOVSI T3,'SOS' ;SET UP TEMP FILE NAME
PUSHJ P,JOBNUM
MOVEM T3,EDNAM
MOVEM T3,OCRNAM
MOVSI T1,'TMP'
MOVEM T1,OCREXT
MOVE T1,ORGCOD ;GET ORIG FILE PSW
SKIPN NEWNAM ;DO WE HAVE A NEW FILE
MOVEM T1,OCRCOD ;NO - USE ORIG PSW
MOVE T1,ORGDEV ;GET INPUT DEVICE NAME
MOVEM T1,INDEVI+1 ;STASH IN OPEN BLOCK
DEVCHR T1, ;GET CHARACTERISTICS
TLNN T1,(1B1) ;SEE IF REAL LIVE DISK
JRST NOTDKI ;NOPE!
MOVEI T1,INDEVI ;ADDR OF OPEN BLOCK
DEVSIZ T1, ;GET BUFFER INFO
SKIPA [2,,203] ;DEFAULT IF NO UUO
JUMPLE T1,NOTDKI ;LOSE IF ERROR FLAGS
MOVEM T1,EDBUF ;STORE FOR LATER
OPEN IN,INDEVI ;OPEN INPUT CHL
JRST NOTDKI ;OOPS!
XLOOK IN,ICRBLK ;DO EXTENDED LOOKUP
JRST NOFILE ;CHECK TYPE OF FAILURE
MOVEI T1,IN ;SET UP FOR PATH UUO
MOVEM T1,PTHADR
MOVE T1,[<SFDLVL+4>,,PTHADR]
PATH. T1,
HALT . ;NEVER COME HERE (OFTEN)
SKIPN NEWNAM ;SAVE PATH INFO IN NEW FILE
JRST [MOVE T1,[PTHADR+2,,OCRPTH]
BLT T1,OCRPTH+SFDLVL
JRST .+1]
SETZM CREATF ;SAY NOT CREATE
TRNE FL,READOF ;IF READ ONLY, LOOKUP IS ENUF
JRST GUDPRV
LDB T2,[POINT 9,XBLOCK+2,8]
CAIL T2,400 ;CHECK IF OK TO EDIT
SKIPE NEWNAM ;NO GOOD IF NO OUTPUT SPEC
GUDPRV: SKIPA T1,PTHADR ;ATTN PROGRAM BUMMERS
JRST BADPRV ;CANNOT EDIT THIS ONE
HRRM T2,ORGPRT ;SAVE FOR LATER
ANDI T2,77 ;STASH TEMP FILE PROT
SKIPN T2 ;WATCH OUT FOR X00 FILES
MOVEI T2,100 ;THIS IS BETTER
HRRM T2,OCRPRT
MOVEM T1,STRNAM ;SET UP FOR DSKCHR
MOVE T1,[5,,STRNAM]
DSKCHR T1, ;FIND REAL NAME
SKIPA T4,[SIXBIT "DSK"]
MOVE T4,STRNAM+4
MOVEM T4,ORGDEV ;STORE DEVICE NAME
FILRET: SKIPE NEWNAM ;OUTPUT SPECIFIED?
MOVE T4,NEWDEV ;YES: GET OUTPUT DEVICE
MOVEM T4,OUDEVI+1 ;SAVE IT IN OUPUT BLOCK
MOVEM T4,OCRDEV ;AND OUTPUT FILE DESC
DEVCHR T4, ;GET CHARACTERISTICS
TLNN T4,(1B1) ;GRNTEE DISK
JRST NOTDKO
OPEN OUT,OUDEVI ;OPEN OUTPUT CHL
JRST NOTDKO ;GRONK
HLRZ T1,EDBUF ;GET DEFAULT # OF BUFFERS
INBUF IN,0(T1) ;GET BUFFERS
OUTBUF OUT,0(T1) ;...
MOVE T1,.JBFF##
SETZM 0(T1) ;SAVE A ZERO WORD
ADDI T1,1 ;NEXT ONE IS START OF
MOVEM T1,BUFP ; BUFFERS
MOCO: MOVE T1,.JBREL## ;FIND THE END OF CORE
MOVEM T1,CORTOP
SUBI T1,2*MXWPL+2 ;LEAVE SPACE FOR A COUPLE OF LINES
MOVEM T1,FILPT ;THIS IS HOW FAR TO FILL THE BUFFER
MOVE T1,CORTOP ;NOW FIND THE SIZE
SUB T1,BUFP
CAIGE T1,3000
JRST [MOVE T2,.JBREL##
ADDI T2,2000
CORE T2,
SKIPA
JRST MOCO
JRST .+1] ;DID NOT GET IT, GIVE UP
MOVE T2,T1 ;GET A COPY
SUBI T2,MXWPL+1 ;WHEN TO START DUMPING
MOVEM T2,MAXWC
ASH T1,-1 ;TAKE HALF OF IT
MOVEM T1,HLFWC ;SAVE THAT FIGURE
TRNE FL2,SVIT
JRST NOSV1 ;SKIP SOME MORE STUFF IF IN W COMMAND
PJOB T3,
TRMNO. T3, ;GET TTY #
JRST NOLCT ;ERROR - IGNORE
MOVEI T2,.TOLCT ;CODE FOR LC TEST
MOVE T1,[2,,T2]
TRMOP. T1,
JRST NOLCT ;NOT IMP EITHER
SKIPN T1
TRO FL,M37F ;LC SET SO SAY HE'S M37
NOLCT: MOVE T1,[<ASCII /00000/>!1]
MOVEM T1,CLN ;SET UP THE CURRENT LINE
SKIPN T1,TECINC ;USE STEP IF GIVEN
MOVE T1,[<ASCII /00100/>!1] ;AND CURRENT INCREMENT
MOVEM T1,INCR
MOVEM T1,CURINS ;CURRENT PLACE TO INSERT IF NO ARGS TO I
NOSV1: MOVEI T1,1 ;AND THE CURRENT PAGE
MOVEM T1,CPG
TRNE FL2,SVIT ;DO NOT CHANGE LOGICAL PAGE (.)
JRST NOSV1A
MOVEM T1,CPGL
MOVEM T1,IPG ;CURRENT PAGE TO INSERT ON
NOSV1A: MOVE PNTR,BUFP ;SET THE BUFFER POINTER
MOVEI T1,1 ;SET INPUT PAGE
MOVEM T1,INPG
SETZM SVWD ;O WORDS WAITING
SETZM WC ;ZERO WORD COUNT FOR START
SETZM OLDLIN ;UESD FOR ORDER CHECKING ON INPUT
TLNN FL2,AUTOF ;PRESERVE IF IN AUTO SAVE
SETZM ALTSN ;USED FOR ALTMODE SEEN FOR I AND R
SETZM AUXFIL ;USED TO FLAG AUXILLARY FILE IN USE
TRNE FL2,SVIT
JRST NOSV2
SETZM CASEBT ;0 FOR LETTERS AS UPPER CASE 40 FOR LOWER
SETZM SRPNT ;NO SEARCH STRING YET
SETZM R1PNT ;ALSO REPLACE STRINGS
SETZM R2PNT
SETZM SVPBTS#
MOVSI T1,1 ;SET BIG PAGE LARGE FOR NOW
MOVEM T1,BGPG
TRNE FL,READOF ;DONT BOTHER IF READ-ONLY
JRST NOSV2
XLOOK OUT,OCRBLK ;GRNTEE TMP FILE GONE
JRST [HRRZ T1,XBLOCK+1
JUMPN T1,EDFLIN ;ERROR IF OTHER THAN FNF
JRST NOSV2]
SETZB T1,T2 ;DELETE IT IF THERE
RENAME OUT,T1
JRST EDFLIN ;LOSE IF CAN'T DELETE
NOSV2: MOVSI T1,'TEM' ;RESET EXT
HLLM T1,OCREXT
TLO FL2,BELLF ;ALLOW BELLS
PUSHJ P,ENBINT ;ENABLE ^C INTS
SKIPE CREATF ;CHECK IF WE ARE CREATING
JRST CRTOK
IFN CRYPSW,< SETOM IBUF+3 >
TRNE FL2,SVIT ;WRAP ON SAVE CMD(W)
JRST NOSV3 ;YES: DON'T PRINT MSG AGAIN!
MOVEI T1,[ASCIZ /Edit: /]
TRNE FL,READOF ;CHECK FOR R/O
MOVEI T1,[ASCIZ /Read: /]
OUTSTR @T1 ;PRINT MSG
MOVEI T4,ICRBLK
PUSHJ P,GVNAM0 ;GIVE FILE NAME
OCRLF
NOSV3: TRNE FL,READOF
JRST NOENT ;DO NOT ENTER
XENTR OUT,OCRBLK
JRST EDFLIN ;SOME OTHER BASTARD IS USING IT
PUSHJ P,STRSET ;SETUP STR INFO
SETZM OPG ;OUTPUT PAGE CNTR
IFN CRYPSW,<
MOVNI T1,2
MOVEM T1,OBUF+3
>
NOENT: TRO FL,BOF ;IS AT START OF FILE
TLO FL,FSTOPF ;FIRST OP
TLZ FL2,ALLCHG ;NO CHANGES YET
PUSHJ P,FILLBF ;AND FILL UP THE BUFFER
TLZN FL2,AUTOF ;SKIP IF AUTO SAVE
JRST COMND
TRZ FL2,SVIT ;CLR THIS TOO
MOVE SINDEX,SVLNUM ;GET BACK TO POINT OF LAST INSERT
TLZ FL2,NORENT ;RE-ENABLE FOR REENTER
JRST FIND ;EXITS TO CALLER
RJUST: MOVE T3,ACCUM ;GET THE SIXBIT
MOVEI T1,0
RJUST1: MOVEI T2,0
LSHC T2,6
CAIL T2,"0"-40 ;CHECK FOR OCTAL DIGIT
CAILE T2,"7"-40
POPJ P,
LSH T1,3
IORI T1,-20(T2)
JUMPN T3,RJUST1 ;DONE IF NULLS LEFT
AOS (P)
POPJ P, ;SKIP RETURN FOR ALL OK
;ROUTINE FOR FETCH FULL PATH NAME
SETPPN: PUSHJ P,SCAN ;FETCH ATOM
TRNN FL,IDF!NUMF ;CHECK FOR ATOM
JRST [CAIN C,"-" ;CHECK FOR DEFAULT SPEC
JRST STDPTH
SKIPN T1,MYPPN ;HAVE DEFAULT?
PUSHJ P,USRPPN ;NO: GET ONE
HLLZM T1,PTH(ALTP)
JRST SETPP1]
PUSHJ P,RJUST ;RIGHT JUSTIFY ATOM IN OCTAL
POPJ P, ;PPN ERROR
HRLZM T1,PTH(ALTP)
PUSHJ P,SCAN
SETPP1: CAIE C,"," ;PROPER DELIM
POPJ P,
PUSHJ P,SCAN ;FETCH NEXT ATOM
TRNN FL,IDF!NUMF ;ALLOW [,,...]
JRST [SKIPN T1,MYPPN
PUSHJ P,USRPPN
HRRM T1,PTH(ALTP) ;FILL IN DEFAULT
JRST SETPP2]
PUSHJ P,RJUST ;GET OCTAL ATOM
POPJ P, ;PPN ERROR
HRRM T1,PTH(ALTP) ;STASH PROG #
PUSHJ P,SCAN ;MOVE ON
SETPP2: MOVSI T3,-<SFDLVL+1>
HRR T3,ALTP
JRST STPTH1
SETPTH: PUSH P,T3 ;SAVE AOBJN WD
PUSHJ P,SCAN ;FETCH ATOM
TRNN FL,IDF!NUMF ;CHECK FOR END OF SPEC
JRST T1POPJ ;PRUNE PDL AND EXIT
MOVE T3,0(P) ;FETCH PNTR
MOVE T1,ACCUM ;FETCH SFD NAME
MOVEM T1,PTH(T3) ;STORE IN PROPER PLACE
PUSHJ P,SCAN ;SCAN NEXT
POP P,T3 ;SET UP AOBJN PNTR
STPTH1: CAIN C,"]" ;GOOD TERMINATOR?
JRST CPOPJ1 ;YES: EXIT
CAIE C,"," ;MORE TO COME?
POPJ P, ;NO: ERROR RET
AOBJN T3,SETPTH ;YES: TRY NEXT
POPJ P, ;OOPS!
USRPPN: GETPPN T1,
JFCL ;INCASE JACCT ON
MOVEM T1,MYPPN ;SAVE FOR LATER
POPJ P,
STDPTH: PUSHJ P,SCAN ;CHECK PROPER TERM
TRNN FL,IDF!NUMF
CAIE C,"]"
POPJ P, ;LOSE
SETZM PTH(ALTP) ;USE DEFAULT
JRST CPOPJ1
READN0: TDZA T2,T2 ;INIT DEVICE TO 0
READNM: MOVSI T2,'DSK' ;INIT DEVICE TO DSK
SETZM TMPBLK ;CLEAR OUT PARSE AREA
MOVE T1,[TMPBLK,,TMPBLK+1]
BLT T1,TMPBKE
MOVEI ALTP,TMPBLK ;SET UP FOR SETPPN
SETZM RSW ;AND SWITCH FLAGS
SETZM SSW
MOVEM T2,TMPDEV
TRNN FL,IDF!NUMF ;IS IT AN IDENT
POPJ P, ;ERROR RETURN
PUSH P,ACCUM ;SAVE ATOM
PUSHJ P,SCAN ;SCAN FOR DELIM
CAIE C,":" ;IS IT A DEVICE
JRST [POP P,TMPNAM ;IT IS A FILE NAME
JRST NOTDEV]
POP P,TMPDEV ;YES: SAVE IN CORRECT PLACE
PUSHJ P,SCAN ;GET NEXT ATOM
TRNN FL,IDF!NUMF ;IS IT AN IDENT
POPJ P, ;NO: RETURN
MOVE T1,ACCUM ;FETCH ARG
MOVEM T1,TMPNAM
PUSHJ P,SCAN
NOTDEV: CAIN C,"[" ;CHECK FOR PPN
JRST READPP
CAIE C,"."
JRST RDTERM
PUSHJ P,SCAN ;THIS SHOULD BE AN EXTENSION
TRNE FL,TERMF ;CHECK FOR NULL EXT
JRST CPOPJ1 ;OK IF NOTHING AFTER PERIOD
TRNN FL,IDF!NUMF
POPJ P,
MOVE T1,ACCUM ;GET IT
HLLZM T1,TMPEXT ;AND PUT IT IN THE EXTENSION FIELD
PUSHJ P,SCAN
CAIE C,"[" ;NOW LOOK FOR PPN
JRST RDTERM
READPP: PUSHJ P,SETPPN ;FETCH FULL PATH NAME
POPJ P, ;ERROR IN PPN
PUSHJ P,SCAN ;LOOK PAST BRACKET
RDTERM: TLNN FL2,INOPTF ;NO SWITCHES IN OPTION FILE
CAIE C,"/" ;CHECK FOR READ ONLY MODE
JRST CPOPJ1 ;ALL OK
PUSHJ P,SCAN
TRNN FL,IDF
POPJ P,
MOVS T1,ACCUM
CAIN T1,'R '
SETOM RSW
CAIN T1,'S '
SETOM SSW
PUSHJ P,SCAN
SKIPN RSW
SKIPE SSW
AOS (P)
POPJ P,
;CREATE A NEW FILE
NOFILE: MOVEI T4,ICRBLK ;SET FOR PRINTING
HRRZ T1,XBLOCK+1 ;GET FAIL CODE
TRNN FL,READOF ;ERROR IF R/O
JUMPE T1,NOFIL1 ;OK IF FNF CODE
PUSHJ P,GVNAM0 ;PRINT NAME
OUTCHR ["("]
HRRZ T1,XBLOCK+1 ;FAIL CODE
MOVEI T3,OCHR ;OUTPUT ROUTINE
PUSHJ P,OCTPR ;PRINT IN OCTAL
PUSHJ P,FORCE ;DUMP BUFFER
OUTSTR [ASCIZ /) - LOOKUP failed/]
HRRZ T1,XBLOCK+1 ;FAIL CODE
CAIN T1,0
OUTSTR [ASCIZ /, file not found/]
CAIN T1,1
OUTSTR [ASCIZ /, no such directory/]
CAIN T1,2
OUTSTR [ASCIZ /, protection violation/]
CAIN T1,6
OUTSTR [ASCIZ /, RIB or UFD error/]
CAIN T1,23
OUTSTR [ASCIZ /, no such SFD/]
OCRLF
EXIT
NOFIL1: OUTSTR [ASCIZ /Input: /]
PUSHJ P,GVNAM0
MOVE T1,[%LDSTP,,.GTLDV]
GETTAB T1, ;GET DEFAULT PTB.
MOVSI T1,155000 ;MUST BE LVL C
LDB T1,[POINT 9,T1,8]
HRRM T1,ORGPRT
ANDI T1,77 ;SET UP FOR TEMP
SKIPN T1 ;LOOK FOR X00
MOVEI T1,100 ;AND USE THIS
HRRM T1,OCRPRT
SETOM CREATF ;SAY WE ARE CREATING
MOVE T1,[ORGPTH,,OCRPTH]
BLT T1,OCRPTH+SFDLVL ;SET UP OUTPUT PATH
MOVE T4,ORGDEV ;GET DEVICE NAME
JRST FILRET ;GO OPEN IT
CRTOK:
XENTR OUT,OCRBLK ;CREAT TEMP FILE
JRST EDFLIN
PUSHJ P,STRSET ;SETUP STR INFO
SETZM OPG ;OUTPUT PAGE CNTR
IFN CRYPSW,<
MOVNI T1,2
MOVEM T1,OBUF+3
>
SETZM (PNTR) ;ZERO FIRST WORD OF BUFFER
TRZ FL,READOF ;CREAT AND READOF ARE NOT POSSIBLE
TRO FL,BOF!EOF!EOF2 ;SAY AT START AND NO MORE TO READ
TLO FL2,ALLCHG ;NEW FILE - THEREFORE CHANGES
MOVEI T1,1 ;SET BGPG
MOVEM T1,BGPG
JRST CRTINS ;AT LAST
DOSAIL: OUTSTR [ASCIZ /
? SAIL FEATURE NOT YET IMPLEMENTED!/]
EXIT
SUBTTL PARSE CODE
;LOOK FOR SYSTEM COMMAND. MAY BE "R SOS" OR "SOS" OR "EDIT"
PARSE: MOVEI ALTP,NEWBLK ;INIT NAME PNTR
PUSHJ P,ZERNEW ;CLR OUT FILE BLOCK
MOVEI T1,LDCHR ;SET UP CHIN FOR PARSE
EXCH T1,CHIN ;SAVE OLD VALUE
MOVEM T1,SVPCIN ;...
SETZM PZBEG ;CLEAR PARSE AREA
MOVE T1,[PZBEG,,PZBEG+1]
BLT T1,PZEND
MOVSI T1,'DSK'
MOVEM T1,DEV(ALTP) ;DEFAULT DEVICE
TRZ FL,F.ANY ;CLEAR ATOM SEEN
SKIPN RPGSW
JRST PARSE1
PUSHJ P,RDSKIP
PUSHJ P,RDATOM ;GET FIRST ATOM
TRO FL,F.LAHD
LDB T1,[POINT 6,D,5]
CAIE T1,"R"-40 ;RUN CMD?
JRST PARSE1 ;NO: GO PARSE COMMAND LINE
PUSHJ P,RDSKIP
PUSHJ P,RDATOM ;SKIP FILE NAME
CAIN C,":" ;IN CASE DEVICE NAME
JRST .-3
CAIN C,"-" ;DASH BREAK?
JRST [TRZ FL,F.LAHD
SETOM TMPCF ;SET TO SKIP TMP READ
JRST FIXUP]
CAIN C,12 ;END OF WORLD?
JRST RDEOT0 ;YES: PROCESS
PUSHJ P,RDSKIP ;NO: SKIP CORE ARG
PUSHJ P,RDATOM
TRO FL,F.LAHD
FIXUP: MOVE T1,[ASCII "SOS "]
MOVEM T1,CMDBUF ;OVERWRITE RUN CMD
MOVE T1,[POINT 7,CMDBUF+1]
MOVEI C," "
FIXUP1: IBP T1
CAMN T1,P.TEXT
JRST FIXUP2
DPB C,T1
JRST FIXUP1
FIXUP2: TRNN FL,F.LAHD ;CORRECT # OF SPACES
DPB C,T1
PARSE1: PUSHJ P,RDSKIP ;RETURN HERE TO SKIP SPACES
PARSE2: PUSHJ P,RDATOM
CAIN C,12
JRST RDEOT
TRO FL,F.ANY ;SET ATOM SEEN
CAIN C,"/" ;SLASH
JRST RDSLSH
CAIN C,"."
JRST RDPER
CAIE C,"_"
CAIN C,"="
JRST RDEQL
CAIE C," "
CAIN C," "
JRST RDSPAC
IFN CRYPSW,<
CAIN C,"("
JRST RDLPRN
>
CAIN C,"["
JRST RDPPN
CAIN C,":"
JRST RDCOLN
ILLCHR: MOVEI T1,[ASCIZ /Illegal char in cmd/]
JRST COMERR
;HERE WHEN COLON SEEN
RDCOLN: TRZN FL,F.SLSH ;IN SWITCH?
JRST RDCLN1 ;NO: TREAT AS DEVICE
TRO FL,F.LAHD ;YES: SET LOOK AHEAD
JRST RDSPC1 ;AND LOOK AT SWITCH
RDCLN1: JUMPE D,RDCERR ;ERROR IF NULL DEVICE
TROE FL,F.COLN ;SAY SEEN ONE
JRST RDCERR
MOVEM D,DEV(ALTP) ;STASH
JRST PARSE2 ;AND CONT PARSE
RDCERR: MOVEI T1,[ASCIZ /Illegal colon/]
JRST COMERR
;HERE WHEN SPACE SEEN
RDSPAC: TRZE FL,F.SLSH
JRST RDSPC1 ;CHECK SWITCH
PUSHJ P,RDPLNK ;STORE DESCRIPTOR
TRO FL,F.ANY ;SAY WE'VE SEEN SOMETHING
JRST PARSE1
RDSPC1: MOVEM D,ACCUM ;STASH ARG FOR DECODE
PUSHJ P,DOSET ;CALL ON SET CODE
JRST SWTERR ;ERROR RETURN
TRO FL,F.LAHD ;SET LOOK AHEAD
MOVEM C,SAVCHR ;SAVE INCASE OF TTY INPUT
JRST PARSE1 ;CONTINUE PARSE
SWTERR: MOVEI T1,[ASCIZ /Illegal switch/]
JRST COMERR
;HERE WHEN EQUAL SIGN SEEN
RDEQL: TROE FL,F.EQL ;MAKE SURE FIRST ONE
JRST RDEQLE
PUSHJ P,CHKFIL ;SEE IF WE HAVE A FILE
JUMPE D,RDEQL1 ;OK IF D .NE. 0
PUSHJ P,RDPLNK ;STASH REMAINING ATOM
RDEQL1: TRZ FL,F.PER!F.COLN!F.PPN!F.CDSN!F.LAHD
MOVEI ALTP,ORGBLK ;CLR FLAGS AND ADVANCE PNTR
MOVSI T1,'DSK'
MOVEM T1,DEV(ALTP) ;DEFAULT DEVICE NAME
JRST PARSE2 ;AND CONTINUE
RDEQLE: MOVEI T1,[ASCIZ /Illegal equal sign/]
JRST COMERR
;HERE WHEN SLASH SEEN
RDSLSH: PUSHJ P,CHKFIL
JUMPE D,RDSLS1
JRST RDSPAC
RDSLS1: TRZ FL,F.LAHD ;CLEAR LOOK AHEAD
TRON FL,F.SLSH
JRST PARSE2
MOVEI T1,[ASCIZ /Illegal slash/]
JRST COMERR
;HERE WHEN LEFT PAREN SEEN
IFN CRYPSW,<
RDLPRN: PUSHJ P,CHKFIL
JUMPE D,RDLPER
JRST RDSPAC ;TREAT AS SPACE
TRON FL,F.CDSN ;GRNTEE UNIQUE CODE
JRST RDLPR1 ;GO SNARF CODE
RDLPER: MOVEI T1,[ASCIZ /Illegal code spec./]
JRST COMERR
RDLPR1: MOVE T1,[POINT 7,CODBUF]
MOVEI T2,CODMAX
RDLPR2: PUSHJ P,@CHIN ;FETCH A CHAR
CAIN C,")"
JRST RDLPR3
CAIN C,12
JRST RDLPER ;ERROR IF EOT
IDPB C,T1
SOJG T2,RDLPR2
MOVEI T1,[ASCIZ /Code too long/]
JRST COMERR
RDLPR3: MOVEI C,0
IDPB C,T1
MOVEM 7,S.CRYP+7
MOVEI 7,S.CRYP
BLT 7,S.CRYP+6
MOVEI 7,CODBUF ;GET A SEED
PUSHJ P,CRASZ.##
MOVEM 5,COD(ALTP) ;STASH AWAY
MOVSI 7,S.CRYP
BLT 7,7
TRZ FL,F.LAHD
JRST PARSE1
>
;HERE WHEN PERIOD SEEN
RDPER: JUMPN D,RDPER1
MOVEI T1,[ASCIZ /Null name with extension/]
JRST COMERR
RDPER1: TROE FL,F.PER
JRST [MOVEI T1,[ASCIZ /Illegal period/]
JRST COMERR]
MOVEM D,NAM(ALTP)
JRST PARSE2
;HERE WHEN END OF CMD SEEN
RDEOT: PUSHJ P,CHKFIL
JUMPE D,RDEOT0
JRST RDSPAC ;PROCESS AS SPACE IF SOMETHING THERE
RDEOT0: SETZM SAVCHR ;CLEAR TTY INPUT
TRNN FL,F.ANY ;ANYTHING?
JRST COMER1
TRNE FL,F.EQL ;EQUAL SIGN SEEN?
SKIPE ORGNAM ;YES: BETTER SEE FILE NAME
SKIPA
JRST RDEQLE ;FUNNY EQUAL SIGN
SKIPN NEWNAM ;WAS A NEW NAME GIVEN?
JRST RDEOT2 ;NO - CHECK FOR DEFAULT
TRNE FL,F.EQL ;YES - EQUAL SIGN SEEN?
JRST RDEOTX ;YES - THEN DONE
MOVE T1,[NEWBLK,,ORGBLK]
BLT T1,ORGBKE ;PUT INFO IN ORG BLOCK
PUSHJ P,ZERNEW
JRST RDEOTX ;AND EXIT
RDEOT2: TRNN FL,F.EQL ;EQUAL SEEN?
JRST [MOVEI T1,[ASCII /NO FILE GIVEN/]
JRST COMERR]
HRROI T1,ORGEXT ;YES - SET INFO
POP T1,NEWEXT ;INTO DEFAULTS
POP T1,NEWNAM
RDEOTX: TRZ FL,P.FLGS ;CLEAR PARSE FLAGS
MOVE T1,SVPCIN ;RESTORE CHIN
MOVEM T1,CHIN
SKIPE RPGSW ;RPG MODE?
PUSHJ P,WRTMP ;YES: WRITE OUT TEMP
SKIPN T1,TECINC ;TECO INCREMENT?
MOVE T1,[<ASCII /00100/>!1]
MOVEM T1,TECINC ;SET CORRECT ONE UP
SKIPN TECFST ;START SEQ # GIVEN?
MOVEM T1,TECFST ;NO: USE INCREMENT
POPJ P, ;EXIT PARSE
;HERE TO READ PPN'S
RDPPN: PUSHJ P,CHKFIL ;SEE IF FILE SPEC
JUMPE D,PPERR ;ERROR IF NO ATOM
JRST RDSPAC ;ELSE TREAT AS SPACE
TRON FL,F.PPN ;GRNTEE JUST ONE PER FILE SPEC
JRST RDPPN1
PPERR: MOVEI T1,[ASCIZ /Illegal PPN/]
JRST COMERR
RDPPN1: SETZM SAVCHR ;CLEAR OUT SCAN
SETZM SAVC
PUSHJ P,SETPPN ;GO READ PPN
JRST PPERR ;ERROR
TRZ FL,F.LAHD ;CLEAR LOOK-AHEAD
JRST PARSE1
;ROUTINE TO ZERO OUT NEWBLK
ZERNEW: MOVE T1,[NEWBLK,,NEWBLK+1]
SETZM NEWBLK
BLT T1,NEWBKE
POPJ P,
;COMMAND ERROR ROUTINE
COMERR:
OUTSTR [ASCIZ /? /]
OUTSTR (T1)
OCRLF
SETOM TMPCF ;MAKE LIKE READ
CLRBFI ;CLEAR TYPE AHEAD
SETZM TTIBH+2
COMER1: SKIPN TMPCF ;HERE ONCE?
SKIPN RPGSW ;NO: RPG MODE?
SKIPA ;SKIP INTO NORMAL CMD LOOP
PUSHJ P,RDTMP ;READ TEMP (SKIP IF OK)
SETZM RPGSW ;CLEAR RPG MODE
TRZ FL,P.FLGS
MOVE T1,SVPCIN ;RESTORE CHIN
MOVEM T1,CHIN
MOVE P,[IOWD PDLSIZ,PDL] ;RESTORE PDL
JRST NOCOM1 ;TRY SOME MORE
;HERE TO STASH ATOM IN EITHER NAME OR EXT
RDPLNK: JUMPE D,CPOPJ ;DONE IF NULL ATOM
TRZN FL,F.PER ;PERIOD?
JRST RDPLN1 ;NO: STASH NAME
HLLZM D,EXT(ALTP) ;YES: EXTENSION
POPJ P,
RDPLN1: MOVEM D,NAM(ALTP)
POPJ P, ;RETURN
;HERE TO READ TEMP FILE
RDTMP: SETOM TMPCF ;STATE THAT WE HAVE TRIED
MOVNI T1,20 ;BUFFER SIZE
HRLM T1,T.IOWD
IFN TEMPC,<
MOVE T1,[XWD 1,T.HEAD]
TMPCOR T1,
SKIPA ;IT FAILED - TRY FILE
JRST RDTMP1
>
MOVSI T3,(<SIXBIT /EDS/>)
PUSHJ P,JOBNUM
MOVEM T3,XBLOCK ;STASH FILE NAME
MOVSI T1,(<SIXBIT /TMP/>)
MOVEM T1,XBLOCK+1 ;AND EXTENSION
SETZM XBLOCK+3 ;ZERO PPN
MOVE T1,[1B0+17] ;DUMP MODE + PHYS ONLY
MOVSI T2,'DSK' ;ON DEFAULT STR
MOVEI T3,0
OPEN IN,T1 ;PERFORM OPEN
JRST RDTMPE ;TREAT AS FNF
LOOKUP IN,XBLOCK ;IS IT THERE
RDTMPE: JRST [RELEAS IN,0
POPJ P,]
INPUT IN,T.IOWD ;FETCH FILE
STATZ IN,740000 ;CHECK ERRORS
JRST RDTMPE ;YOU LOSE
RELEAS IN,0
RDTMP1: MOVE T1,[POINT 7,CMDBUF]
MOVEM T1,P.TEXT
AOS (P)
POPJ P,
;HERE TO WRITE TEMP FILE
WRTMP: HRRZ T1,P.TEXT ;CALC LENGTH OF STRING
SUBI T1,CMDBUF-1
MOVN T1,T1 ;NEG LENGTH
HRLM T1,T.IOWD
IFN TEMPC,<
MOVE T1,[XWD 3,T.HEAD]
TMPCOR T1,
SKIPA
POPJ P,
>
MOVSI T3,(<SIXBIT /EDS/>)
PUSHJ P,JOBNUM
MOVEM T3,XBLOCK
MOVSI T1,(<SIXBIT /TMP/>)
MOVEM T1,XBLOCK+1 ;GEN FILE NAME
SETZM XBLOCK+2
SETZM XBLOCK+3
MOVE T1,[1B0+17] ;DUMP MODE + PHYS ONLY
MOVSI T2,'DSK' ;DEFAULT STR
MOVEI T3,0
OPEN OUT,T1 ;INIT DSK
JRST WRTMP1 ;LOSE!
ENTER OUT,XBLOCK
JRST WRTMP1 ;JUST IGNORE
OUTPUT OUT,T.IOWD
WRTMP1: RELEAS OUT,0 ;CLOSE CHL
POPJ P,
;GENERAL JOBNUMBER KLUDGE...
JOBNUM:
PJOB T1,
JOBNM1: IDIVI T1,^D10
IORI T2,20
LSHC T2,-6
TRNN T3,77
JRST JOBNM1
POPJ P,
;UTILITY ROUTINES
RDSKIP: PUSHJ P,RDSKP1 ;SKIP SPACES
TRO FL,F.LAHD ;SET LOOK AGAIN
POPJ P,
RDSKP1: PUSHJ P,@CHIN
CAIE C," "
CAIN C," " ;SPACE OR TAB
JRST RDSKP1
POPJ P,
RDATOM: MOVE T1,[POINT 6,D]
MOVEI D,0 ;INIT ATOM
RDATO1: PUSHJ P,@CHIN
PUSHJ P,CKALN ;CHECK ALPHA-NUMERIC
JRST RDATO2
TLNN T1,770000 ;6 YET?
JRST RDATO1
SUBI C,40
IDPB C,T1
JRST RDATO1
RDATO2: CAIE C," "
CAIN C," "
PUSHJ P,RDSKP1
PUSHJ P,CKALN
POPJ P,
MOVEI C," " ;RETURN A SPACE IF
TRO FL,F.LAHD ;ALPHA-NUMERIC
POPJ P,
;SUBROUTINE TO CHECK WHAT TO DO AT BREAK CHAR
;CALL:
; PUSHJ P,CHKFIL
; <HERE IF NAME NOT STORED (CHECK D)>
; <HERE IF NAME STORED AND PERIOD SEEN>
; <HERE IF NO FURTHER PROCESSING REQUIRED>
CHKFIL: SKIPN NAM(ALTP) ;SEE IF WE GOT A NAME
JRST CHKFL1 ;NO: SET LAHD AND RETURN
AOS (P)
TRNN FL,F.PER
JUMPE D,CPOPJ1 ;DOUBLE SKIP IF OK
MOVEI C," " ;RETURN SPACE
CHKFL1: TRO FL,F.LAHD
POPJ P, ;SKIP RETURN IF NEED TO STASH 'D'
;HERE TO FETCH NEXT CHAR
LDCHR: SKIPN RPGSW ;FROM WHERE
JRST LDCHR1
TRZN FL,F.LAHD
LDCHRA: IBP P.TEXT
LDB C,P.TEXT
CAIN C,15 ;PURGE CR'S
JRST LDCHRA
POPJ P,
LDCHR1: TRZE FL,F.LAHD
SKIPA C,SVCCIN
LDCHRB: PUSHJ P,TTYCH
CAIN C,15 ;SKIP OVER CR'S
JRST LDCHRB
MOVEM C,SVCCIN
POPJ P,
;CHECK IF CHAR IS ALPHA-NUMERIC
CKALN: CAIG C,"z"
CAIGE C,"a"
SKIPA
SUBI C,40 ;CONVERT TO UPPER
CAIL C,"0"
CAILE C,"Z"
POPJ P,
CAILE C,"9"
CAIL C,"A"
AOS (P)
POPJ P,
;SPECIAL ROUTINE CALLED FROM SET OPTION IN INITIAL PARSE
OPTSWT: TLZ FL2,INPARS ;TEMP CLR FLAG
PUSHJ P,DOOPT ;PARSE OPTION FILE
JRST OPTSE1 ;SAY NOT FOUND
JRST OPTSE2 ;SAY ERROR IN FILE
TLO FL2,INPARS ;TURN BACK ON
MOVEI C," " ;PRETEND LAST CHAR WAS A SPACE
POPJ P, ;RETURN
OPTSE1: MOVEI T1,[ASCIZ /Option not found/]
JRST COMERR
OPTSE2: MOVEI T1,[ASCIZ /Syntax error in option file/]
JRST COMERR
SUBTTL OPTION FILE HANDLER
;ROUTINE TO EAT AN OPTION FILE IF ANY
;CALL: PUSHJ P,DOOPT
; <OPTION NOT FOUND>
; <ERROR IN OPTION FILE>
; <OK RETURN>
; C(OPTION) = SIXBIT OF DESIRED OPTION OR ZERO IF DEFAULT
DOOPT: TLNE FL2,INOPTF ;TRYING TO REENTER
JRST WRAPUP ;JUST GIVE CURRENT FAILURE
OPEN OPT,OPTDVI
POPJ P, ;SAY NOT FOUND
MOVEI T1,OPTBUF ;GET BUFFER ADDR
EXCH T1,.JBFF##
INBUF OPT,1 ;ONE IS ENUF
MOVEM T1,.JBFF## ;RESTORE JOBFF
SETZM OPTFIL+2 ;CLEAR OUT ANY TRASH
SKIPN T1,MYPPN ;GET DEFAULT DIRECTORY
PUSHJ P,USRPPN
MOVEM T1,OPTFIL+3 ;STASH IN CORRECT PLACE
LOOKUP OPT,OPTFIL ;GO FIND FILE
JRST [RELEAS OPT,
POPJ P,] ;NOT FOUND
MOVEI T1,OPTCH ;SET UP INPUT ROUTINE
EXCH T1,CHIN ;SAVE CURRENT ONE
MOVEM T1,SVOCIN
TLO FL2,INOPTF ;SAY WE IS IN OPTION FILE
SETZM SAVCHR ;CLEAR SCANNER
RDOPT: PUSHJ P,SCAN ;FETCH FIRST ATOM OF LINE
CAIN C,177 ;EOF OR ERROR?
JRST WRAPUP ;YES: FINISH UP AND RETURN
MOVE T1,ACCUM ;GET WHAT WE FOUND
CAME T1,[SIXBIT "SOS"]
JRST SKPEOL ;NOT WHAT WE WANT - TRY NEXT LINE
PUSHJ P,SCAN ;FETCH BREAK CHAR
SKIPN OPTION ;NEED DEFAULT?
JRST DEFOPT ;YES:
CAIE C,":" ;LOOK AT BREAK CHAR
JRST SKPEOL ;SKIP LINE IF NOT COLON
PUSHJ P,SCAN ;GET NEXT ATOM
TRNE FL,IDF ;SEE IF IDENT
JRST OPTONE ;YES: TRY THIS
CAIE C,"(" ;COULD BE LEFTPAREN
JRST OPTDN1 ;NOPE - IT IS TRASH
OPTMOR: PUSHJ P,SCAN ;TRY FOR ATOM
MOVE T1,ACCUM
CAMN T1,OPTION ;IS THIS THE ONE?
JRST OPTMR1 ;SCAN FOR RT PAREN
PUSHJ P,SCAN ;GULP DOWN BREAK CHAR
CAIN C,"," ;COMMA MEANS MORE COMING
JRST OPTMOR
CAIN C,")" ;RT PAREN MEANS THAT'S ALL
JRST SKPEOL ;TRY NEXT LINE
JRST OPTDN1 ;TRASHINESS
OPTMR1: PUSHJ P,SCAN ;LOOK FOR RT PAREN
CAIE C,177 ;EOF OR ERROR
TRNE FL,TERMF ;EOL
JRST OPTDN1
CAIE C,")" ;A GOOD THING
JRST OPTMR1 ;KEEP LOOKING
JRST OPTFN0 ;GOT IT
OPTONE: MOVE T1,ACCUM
CAME T1,OPTION ;IS THIS IT?
JRST SKPEOL ;NO: KEEP LOOKING
OPTFN0: AOS (P) ;ALL ELSE ARE ERRORS OR AOK
OPTFND: PUSHJ P,SCAN ;SCAN NEXT
TRNE FL,IDF ;IDENTS ARE OK
JRST OPTGOT ;GOT ONE - USE IT
OPTNXT: CAIE C,"/" ;CHECK LEGAL DELIMS
CAIN C,","
JRST OPTGET ;NEED TO SCAN AGAIN
CAIE C,"-" ;CHECK LINE CONT.
JRST OPTDON ;NOPE - CHECK PROPER EOL
PUSHJ P,SCAN ;SCAN PAST DASH
TRNN FL,TERMF ;PROPER TERM?
JRST WRAPUP ;NO: SYNTAX ERROR
JRST OPTFND ;CONTINUE LOOKING
OPTGET: PUSHJ P,SCAN ;GET NEXT ATOM
TRNN FL,IDF ;IDENT?
JRST WRAPUP ;NO: LOSE
OPTGOT: PUSHJ P,DOSET ;SWITCH IN "ACCUM" - CALL SET ROUTINE
JRST WRAPUP ;ILLEGAL ENTRY IN FILE
JRST OPTNXT ;CONTINUE
OPTDON: TRNE FL,TERMF ;OK IF PROPER TERM
OPTDN1: AOS (P) ;GIVE SKIP RETURN
JRST WRAPUP ;FINISH UP
DEFOPT: CAIE C,":" ;IF COLON JUST SKIP LINE
JRST OPTFN0 ;ELSE WE HAVE CORRECT LINE
SKPEOL: PUSHJ P,GNCH ;GET A CHAR
CAIN C,177 ;CHECK ON EOF
JRST WRAPUP ;DONE IF SO
TLNN CS,TERM_16 ;TERMINATOR?
JRST SKPEOL ;NO: KEEP GOING
SETZM SAVCHR ;CLEAR SCANNER
JRST RDOPT ;YES: TRY THIS LINE
WRAPUP: RELEAS OPT, ;CLOSE CHL
MOVE T1,SVOCIN ;RESTORE OLD INPUT ROUTINE
MOVEM T1,CHIN
TLZ FL2,INOPTF
POPJ P, ;RETURN
;UTILITY ROUTINES TO READ OPTION FILE
OPTCH: SOSG OPTBHD+2
JRST OPTINP ;NEED MORE
OPTCH1: ILDB C,OPTBHD+1 ;GET CHAR
JUMPE C,OPTCH ;IGNORE NULLS
MOVE CS,@OPTBHD+1 ;CHECK FOR SEQ NOS
TRNN CS,1
POPJ P, ;NONE - RETURN
MOVNI C,5 ;YES: SKIP IT
ADDM C,OPTBHD+2
AOS OPTBHD+1
CAME CS,PGMK ;PAGE MARK?
JRST OPTCH ;NO: GET NEXT CHAR
MOVNI C,4 ;YES: SKIP SOME MORE
ADDM C,OPTBHD+2
MOVSI C,(<POINT 7,0,35>)
HLLM C,OPTBHD+1
JRST OPTCH ;TRY AGAIN
OPTINP: STATZ OPT,760000 ;EOF OR ERROR?
JRST OPTEOF ;YES: RETURN -1
IN OPT,0
JRST OPTCH1 ;OK - RETURN
STATZ OPT,740000 ;ERROR?
OUTSTR [ASCIZ /? Read error in option file/]
OPTEOF: MOVEI C,177 ;GET A RUBOUT
POPJ P, ;AND RETURN
SUBTTL SPECIAL FILE UUOS
;ROUTINE TO SET UP FOR FILE OPERATION
SETPRM: PUSH P,T2 ;SAVE T2 - T1 ALREADY SAVED
SETZM XBLOCK+2 ;CLEAR RESIDUALS
HRRZ T2,40 ;GET PARAMS ADDRS
MOVE T1,NAM(T2) ;FILE NAME
MOVEM T1,XBLOCK
MOVE T1,EXT(T2) ;EXTENSION
HLLZM T1,XBLOCK+1
DPB T1,[POINT 9,XBLOCK+2,8]
SKIPE T1,PTH(T2) ;CHECK FOR DEFAULT PATH
SKIPN PTH+1(T2) ;OR JUST PPN
JRST STPRM1
MOVEI T1,PTH(T2) ;ADDRS OF PATH INFO
MOVSS T1
HRRI T1,PTHADR+2
BLT T1,PTHADR+2+SFDLVL
SETZM PTHADR
SETZM PTHADR+1
MOVEI T1,PTHADR ;SET UP XBLOCK INFO
STPRM1: MOVEM T1,XBLOCK+3
MOVE T1,40 ;FETCH UUO
AND T1,[17B12] ;GET AC FIELD
JRST T2POPJ ;RETURN
;ROUTINE TO DO LOOKUP
LKX: PUSHJ P,SETPRM ;SETUP
IOR T1,[LOOKUP 0,XBLOCK]
XCT T1
AOS (P) ;SKIP ON FAIL
POPJ P,
;ROUTINE TO DO ENTER
ENX: PUSHJ P,SETPRM ;SETUP
IOR T1,[ENTER 0,XBLOCK]
XCT T1
AOS (P) ;SKIP ON FAIL
POPJ P,
;ROUTINE TO DO RENAME
RNX: PUSHJ P,SETPRM ;SETUP
IOR T1,[RENAME 0,XBLOCK]
XCT T1
AOS (P) ;SKIP ON FAIL
POPJ P,
SUBTTL ERROR ROUTINES
EDFLIN:
OUTSTR [ASCIZ /
? Temporary file nnnSOS in use or protected!
/]
EXIT
NOTDKI:
NOTDKO:
NODSK:
OUTSTR [ASCIZ /
? No DISK available. Please check the DISK you have requested/]
EXIT
NOFIL:
OUTSTR [ASCIZ /
? File dissappeared -- LOSE BIG!/]
EXIT
BADPRV:
OUTSTR [ASCIZ /
? Cannot edit file with prot .GE. 400/]
EXIT
PDLOV: MOVEI T1,200000
APRENB T1, ;RESET PDL HANDLING
NERROR STC ;GRONK USER
; THE ERROR HANDLER & SPECIAL FILE OPERATIONS
ERRHD0: MOVEM T1,SVT1E ;SAVE T1 IN CASE OF RERROR
LDB T1,[POINT 9,40,8]
CAILE T1,MAXUUO ;CHECK LEGAL
ERROR ILUUO
XCT EDISP(T1) ;DO FUNCTION
AOS ERRHD ;NON-SKIP MEANS SKIP
MOVE T1,SVT1E ;RESTORE T1
JRSTF @ERRHD ;RETURN
ERRCON: HRRZ T1,40 ;PICK UP THE ERROR NUMBER
SKIPE T1
CAILE T1,NUMER
ERROR ILUUO ;WRONG ERROR, CALL SELF
TLNE FL2,INOPTF!INPARS ;TREAT OPTION FILE AS SPECIAL
JRST OPTERR ;...
MOVEM T1,SVERN ;SAVE FOR =ERROR COMMAND
TRNE FL,EXTOG
SKIPA T1,ETBL-1(T1) ;(NN ZERO ERRORS) GET MESSAGE
MOVE T1,ETBL2-1(T1) ;GET LONG FORM
OUTSTR @T1
TRNN FL2,COMFLF ;IN COMMAND FILE?
JRST ERRHD1 ;NO: SKIP OVER LINE PRINT
OUTSTR COMESS ;MSG ADDRS
ERRHD1: LDB T1,[POINT 9,40,8] ;GET UUO
XCT ERND(T1) ;DO GOOD THING
JRST @ERRHD ;RERROR WILL FALL THROUGH XCT AND RETURN
ERND: ERROR ILUUO ;(0) IS AN ERROR
JRST LOSER ;(1) DIE
JRST CKIND ;(2) CHECK IND FILE
MOVE T1,SVT1E ;(3) RERROR- RESTORE T1
LOSER: OCRLF
EXIT 1,
EXIT
CKIND: TRZ FL2,COMFLF ;CLR COMMAND FILE FLAG
CLRBFI ;CLEAR OUT THINGS
SETZM TTIBH+2
TRZ FL2,SUPN ;...
JRST COMND ;GO ON
EDISP: ERROR ILUUO ;(0) ILLEGAL
JRST ERRCON ;(1) ERROR
JRST ERRCON ;(2) NERROR
JRST ERRCON ;(3) RERROR
PUSHJ P,LKX ;(4) XLOOK
PUSHJ P,ENX ;(5) XENTR
PUSHJ P,RNX ;(6) XRENM
SUBTTL CONTROL-C INTERCEPT CODE
REENT: TLO FL2,RENTF ;ONLY IF ALLOWED
POPJ P,
OPTERR: MOVE T1,SVT1E ;RESTORE T1
POP P,0(P) ;UP A LEVEL
POPJ P, ;AND GIVE ERROR RETURN
;CONTROL C INTERCEPT HANDLERS
;ENABLE INTERCEPT
ENBINT: MOVEI T1,CNCBLK
MOVEM T1,.JBINT##
SETOM CNCLOK ;CLEAR INTERLOCK FOR FIRST TIME
MOVEI T1,CNCREN ;SET UP REENTER ADDRS
MOVEM T1,.JBREN##
POPJ P,
;DISABLE INTERCEPT
DISINT: SETZM .JBINT##
SETZM .JBREN##
POPJ P,
;INTERUPT HANDLER
CNCINT: AOSE CNCLOK ;TRYING TO RE-ENTER?
JRST CNCAGN ;YES: SKIP OVER CODE
PUSH P,CNCBLK+2 ;STASH PC FOR RETURN
PUSH P,T1 ;SAVE A REG
CNCAGN: HLRZ T1,CNCBLK+3 ;GET REASON
CAIE T1,1B34 ;^C ONLY
ERROR ICN
SETZM CNCBLK+2 ;RE-ENABLE
TLNE FL2,NORENT ;ARE WE DISABLED?
JRST CNCREN ;YES: JUST RE-ENTER
CNCIN0: OUTSTR [ASCIZ "Yes? "]
TRNN FL,EXTOG
OUTSTR [ASCIZ "(Type H for help): "]
INCHRW T1 ;GET REPLY
OCRLF
CLRBFI ;CLEAR OUT TTY TYPE AHEAD
ANDI T1,137 ;FORCE UPPER CASE
CAIN T1,"H"
JRST CNCHLP ;GIVE HELP
CAIN T1,"C"
JRST CNCCON ;CONTINUE
CAIN T1,"M"
JRST MONRET ;PUNT!
CAIN T1,"E"
JRST CNCXIT ;DO "E" COMMAND
CAIN T1,"Q"
JRST CNCQT ;DO "EQ" COMMAND
CAIN T1,"R"
JRST CNCREN ;DO LIKE REENTER
CAIN T1,"D"
SKIPN T1,.JBDDT##
JRST CNCIN0 ;TRY AGAIN
HRRZ T1,T1
EXCH T1,0(P) ;STASH ON PDL
POP P,0(P) ;AND PRUNE
SETOM CNCLOK ;CLEAR INTERLOCK
JRST @1(P) ;AND GO DEBUG
;HERE TO DUMMY E CMD
CNCXIT: TLO FL2,DOENDF ;SET DO END REQUEST
JRST CNCREN ;AND TREAT LIKE RE-ENTER
;HERE TO DUMMY UP EQ
CNCQT: MOVEI T1,12 ;FAKE OUT SCANNER
MOVEM T1,LIMBO
SETOM CNCLOK ;CLEAR INTERLOCK
JRST QUIT ;AND EXIT
CNCREN: SKIPGE CNCLOK ;IS THIS A "REE" CMD?
JRSTF @.JBOPC## ;TRY THIS ONE
POP P,T1
SETOM CNCLOK ;CLEAR INTERLOCK
JRST REENT ;AND EXIT
;ROUTINE TO CHECK IF WE HAVE REENTERED, SKIP RETURN IF NOT.
CHKREN: TLNN FL2,NORENT ;ALLOWED?
TLZN FL2,RENTF ;YES: CHECK FLAG
AOS (P) ;NO: SKIP RETURN
POPJ P, ;NO SKIP IF WE DID
CNCCON: POP P,T1 ;RESTORE T1
SETOM CNCLOK ;CLEAR INTERLOCK
POPJ P, ;AND CONTINUE
CNCHLP: OUTSTR CNCTXT
SKIPE .JBDDT##
OUTSTR [ASCIZ "D - transfer to DDT
"]
JRST CNCIN0
CNCTXT: ASCIZ "Type one of:
C - to CONTinue automatically
E - to end edit and close file
Q - to quit (delete temporary files)
M - return to MONITOR now
R - to do REEnter (terminate losing search etc.)
"
SUBTTL ERROR MESSAGES
DEFINE ERMS (A)
<IRP (A) <EXP [ASCIZ /
A
/]
>>
ETBL: ERMS <?Internal confusion,?Device input error>
ERMS <?Device output error,%ILC,?ILUUO,%LTL,%NLN,%NSP,%ORDER>
ERMS <?Device not available,%ILR>
ERMS <%WAR,%TMS,%STL,%ISS,%ILFMT,%NSG,%FNF,%DNA,%NEC,%IRS,%STC,%ITD>
ERMS <%NNN,%SRF,?DMERR,%CMEND,%MAR,?Bad "BASIC" file format>
NUMER==.-ETBL
ETBL2: ERMS <?Internal confusion,?Device input error>
ERMS <?Device output error,%Illegal command,?Illegal UUO>
ERMS <%Line too long>
[ASCIZ /
%No such line(s)
/]
ERMS <%No such page>
ERMS <%Out of order,?Device no available,%Illegal replacement on insert>
ERMS <%Wrap around,%Too many strings,%String too long>
ERMS <%Illegal search string,%Illegal line format>
ERMS <%No string given,%File not found,%DISK not available>
ERMS <%Insufficient core available,%Illegal replacement string>
ERMS <%Search string too complex,%Illegal transfer destination>
ERMS <%No next line,%Search fails>
ERMS <?Indirect read error,%Indirect EOF>
ERMS <%Margin error,?Bad "BASIC" file format>
SUBTTL COMMAND DECODER
;HERE IS THE COMMAND DECODER AND DISPATCHER
COMND: SETZM SAVCHR ;SCAN SHOULD GET RESET AT THIS POINT
SETZM SAVC ;...
ONECHO ;TURN ECHO BACK ON JUST IN CASE
SKIPN T1,TEMINC;TEMP INCR?
MOVE T1,INCR ;NO: USE CURRENT ONE
MOVEM T1,INCR ;YES: RESOTRE OLD ONE
SETZM TEMINC ;CLEAR TEMP
TLNE FL,SRCOP ;THIS CASE IS SPECIAL SINCE WE
SKIPA P,COPDL ;SHOULD NOT DESTROY SAVED ITEMS
MOVE P,[IOWD PDLSIZ,PDL] ;ALSO PDL (IN CASE OF ERRORS)
TLZE FL2,DOENDF ;NEED END COMMAND?
JRST CMDEND ;YES: GO DO IT
TLNE FL,SRCOP
JRST NOCPCK ;DO NOT GET OUT OF COPY MODE
TLZE FL,ISCOP ;IN COPY MODE?
JRST COPDON ;YES, DO SPECIAL CLEAR OUT
NOCPCK:
SKPINL
JFCL
TLZN FL2,NORENT ;NEED TO CHECK FOR REENTER
JRST NORNCK ;NO:
TLZE FL2,RENTF ;SEE IF NEED TO REENTER
JRST [MOVEI T1,[TLZ FL2,RENTF
JRST COMND]
MOVEM T1,CNCBLK+2
MOVEI T1,1B34
HRLM T1,CNCBLK+3 ;FAKE OUT CNCINT
JRST CNCINT]
NORNCK: TRNN FL,EXTOG ;SKIP THIS HACK IF IN EXPERT MODE
SKIPN T1,DELCNT# ; OR IF NO DELETIONS
JRST CMNDA
MOVEI T3,OCHR ;SET UP FOR PRINTER
PUSHJ P,DECPR ;PRINT # OF LINES DELETED
PUSHJ P,FORCE ;DUMP IT
OUTSTR [ASCIZ / Lines (/]
MOVE T1,FDELLN# ;GET FIRST LINE DELETED
MOVEM T1,LINOUT ;PRINT IT
OUTSTR LINOUT
MOVE T1,FDELPG#
PUSHJ P,DECPR ;AND PAGE #
PUSHJ P,FORCE
MOVE T1,LDELLN# ;LAST LINE DELETED
SKIPN PGDELS ;IF ANY PAGE MARKS DELETED
CAME T1,FDELLN ;SAME AS FIRST?
JRST [OUTCHR [":"] ;NO: PRINT IT ALSO
SETZI T2,
OUTSTR T1
SKIPN T1,PGDELS
JRST .+1
ADD T1,FDELPG
OUTCHR ["/"]
PUSHJ P,DECPR
PUSHJ P,FORCE
JRST .+1]
OUTSTR [ASCIZ /) deleted
/]
CMNDA: PUSHJ P,CMDSAV ;CHECK FOR AUTO-SAVE
JRST CMND2 ;DO IT
TRNE FL2,SUPN!COMFLF ;SUPPRESS * AFTER PRETTY PRINT
JRST CMNDB
TLNE FL,SRCOP ;GIVE XTRA PROMPT IF COPY
OUTCHR ["C"]
OUTCHR ["*"]
CMNDB: TRZ FL2,SVIT!SUPN ;TURN OFF SOME BITS
IFN EXTEND,<
MOVEI T1,LSNUM ;RESET LINE SEARCH STRINGS
MOVEM T1,LSBUFN
>
TRNN FL2,COMFLF ;COMMAND FILE?
JRST CMND1 ;NO
MOVE T2,[ASCII /00001/] ;INCREMENT CMD CNT
MOVE T1,COMCNT
PUSHJ P,ASCIAD ;ASCII ADDDER
MOVEM T1,COMCNT ;STORE
CMND1: PUSHJ P,GNCH ;READ A CHARACTER
TLZ FL2,RENTF ;CLEAR FLAG - HE MAY TRY TO REENTER
CAIE C,15
JUMPE CS,CMND1 ;IGNORE SPACES ETC
TLNE CS,LETF_16 ;CHECK TO SEE IF LETTER
TRZ C,40 ;AND CONVERT TO UPPER CASE
CMND2: MOVSI T1,-CMDLG ;GET LENGTH OF COMMAND TABLE
CAME C,CMD1(T1) ;COMPARE
AOBJN T1,.-1 ;CHECK FOR MATCH
SETZM DELCNT
SETZM LDELLN
SETZM FDELLN
SETZM FDELPG ;INIT DELETE CNTS
JUMPL T1,@CMD2(T1) ;DISPATCH IF FOUND
NERROR ILC ;ELSE ERROR
CMD1: EXP "P",15,"E","I","D","M","N","H","/"
EXP "A","_","=","L","R","F",12,200,"C","S"
EXP "G","X","J","T","W","@","Q","K","."
CMDLG==.-CMD1
CMD2: EXP PRINT,NULCMD,ENDIT,INSERT,DELETE,MARK,NUMBER
EXP HELP,SET,ALTER,SET,GIVE,LIST,REPLAC,SEARCH
EXP NXTLIN,BAKLIN,COPY,SUBST,GEND,XPAND,JUST
EXP TRANS,SVCOD,COMFIL,QCOM,KILL,MOVE
;COME HERE TO DO AUTO SAVE
CMDSAV: TRNE FL,READOF ;CHECK RO
JRST CPOPJ1 ;YES - SKIP THIS
TLZE FL2,CCHGF ;DID THIS COMMAND CHANGE THINGS?
SOSE SAVEN ;YES -- COUNT DOWN
JRST CPOPJ1 ;STILL OK
OUTSTR [ASCIZ "[Doing auto-save, please wait.]"]
OCRLF
MOVEI C,"W" ;FUDGE UP W COMMAND
MOVEI T1,12 ;FUDGE UP LINE TERM
MOVEM T1,LIMBO
POPJ P, ;PROCESS COMMAND
NULCMD: PUSHJ P,GNCH ;GRNTEE LF AFTER CR COMMAND
CAIE C,12 ;IS IT?
NERROR ILC ;NO: LOSE
JRST COMND ;YES: WIN
CMDEND: MOVEI C,"E" ;DUMMY CMD
TLZ FL2,RENTF ;CLR FLAG
MOVEI T1,12
TLNN FL,SRCOP ;NEED DUMMY LF IF NOT COPY
MOVEM T1,LIMBO
JRST CMND2 ;PROCESS
SUBTTL MOVE & HELP
MOVE: SETZM LOLN
PUSHJ P,GET1S ;GET A POS.
TRNE FL,TERMF ;CHECK ARG
SKIPN HILN
NERROR ILC
MOVE T1,HIPG
MOVEM T1,DPG
MOVE SINDEX,HILN ;PERFORM SEARCH
PUSHJ P,FIND
MOVE T2,CPG ;FIND THE ONE WE WANT
CAME T2,HIPG
NERROR NSP
CAME T1,HILN
NERROR NLN
MOVEM T1,CLN ;MAKE IT CURRENT
MOVEM T2,CPGL
JRST COMND
HELP: PUSHJ P,SCAN ;CHECK FOR VALID TERM
TRNN FL,TERMF
NERROR ILC
HRROI T1,.GTPRG ;GET NAME OF THIS PROG
GETTAB T1,
MOVSI T1,'SOS' ;USE DEFAULT IF NECESSARY
PUSH P,.JBFF## ;PLACE FOR BUFFER IS NEEDED
HRRZ T2,.JBREL## ;USE TOP OF CORE
ADDI T2,1
MOVEM T2,.JBFF## ;...
PUSHJ P,.HELPR## ;CALL CONKLINS CROCK
POP P,.JBFF## ;RESTORE OLD FF
JRST COMND ;RETURN TO DO USEFUL THINGS
SUBTTL PRINT
;PRINT LINES SPECIFIED
PRINT: SETZM LOLN ;AS A FLAG IN CASE OF /C OR /A,/C
TRZ FL2,SUPN
IFN PPNTSW,<
MOVEI JF,0 ;CLEAR SPECIAL FLAGS
MOVEI T2,1
MOVEM T2,LSTCNT
SETZM LOGPG ;CLEAR COUNTERS AND THINGS
>
PUSHJ P,SCAN
CAIE C,"," ;IS THERE A SWITCH?
JRST PRNT5 ;NO
PUSHJ P,PRNSCN ;SCAN FOR SWITCHES
PRNT5: TRNE FL,TERMF
JRST [MOVE T1,CLN ;MAKE P WITH NO ARGS DO P.!<PLINES>
MOVEM T1,LOLN
MOVE T1,CPGL
MOVEM T1,LOPG
MOVE T1,PLINES
MOVEM T1,SVCNT
TRO FL,CNTF
TRNE FL,DPYF
OUTSTR [BYTE (7)32,177,177,177]
JRST PRCNT]
PUSHJ P,GET2 ;GET A DOUBLE STRING
CAIE C,"," ;I{S THERE A SWITCH?
JRST PRNT6 ;NO
PUSHJ P,PRNSCN ;YES, LOOK AT THEM
PRNT6: TRNN FL,TERMF ;DID IT END WITH A TERMINATOR
NERROR ILC ;NO, ILLEGAL
PRCNT: TRZ FL,LINSN ;USE THIS AS A FLAG TO CHECK FOR NULL RANGE
TRNE FL2,NONUMF ;NEED TO SUPPRESS NUMBERS
TRO FL2,SUPN ;YES:
IFN PPNTSW,<
TRNE JF,EJECT!WAIT
PUSHJ P,PGWT ;WAIT FOR USER!
>
RPGPRN: MOVE T1,LOPG ;FIND THE FIRST LINE WANTED
MOVEM T1,DPG ;SET IT AS THE ONE WE WANT
MOVE SINDEX,LOLN ;PICK UP THE LINE
PUSHJ P,FIND ;GO GET IT
SKIPE LOLN ;DID WE WANT TO PRINT AN ENTIRE PAGE
JRST PRNT1 ;NO, GO CHECK BOUNDS
MOVE T2,CPG ;WHICH ONE ARE WE ON
MOVEM T2,CPGL
TRNN FL2,SUPN
PUSHJ P,PGPRN ;PRINT THE PAGE HEADER
TRO FL,LINSN ;THIS CAN COUNT AS A LINE
PRNT1: PUSHJ P,ONMOV ;CHECK TO SEE IF STILL IN RANGE
JRST EPRNT ;NO, END
TRO FL,LINSN ;WE HAVE SEEN ONE
CAMN T1,PGMK ;IS IT A PAGE MARK?
JRST PRNT3 ;YES, DO SOMETHING SPECIAL
MOVEM T1,CLN
MOVEM T2,CPGL ;SAVE PAGE TOO
MOVE T1,PNTR ;GET THE POINTER TO IT
PUSHJ P,OUTLIN ;AND PRINT
IFN PPNTSW,<
AOSN LSTCNT
PUSHJ P,PAGEND ;END OF PAGE
>
PRNT4: PUSHJ P,FINDN ;GET THE NEXT LINE
JRST PRNT1 ;AND CONTINUE
PRNT3: MOVEM T2,CPGL
IFN PPNTSW,<
SOS LSTCNT ;ADJUST FOR PAGE MARK
PUSHJ P,PAGEND ;DO END OF PAGE ROUTINE
SETZM LOGPG ;RESET LOGICAL PAGE COUNTER
>
TRNE FL2,NONUMF ;SPECIAL HACK IF NONUM MODE
OUTCHR [14] ;WON'T HE BE ...
TRNN FL2,SUPN ;UNLESS PRINTING A CLEAN COPY,
PUSHJ P,PGPRN ;GO PRINT A PAGE HEADER
AOS CPG
MOVE T2,[<ASCII /00000/>!1]
MOVEM T2,CLN ;SET LINE TO FIRST ON THAT PAGE
JRST PRNT4 ;AND CONTINUE
EPRNT: TRZN FL,LINSN ;DID WE PRINT SOMETHING
NERROR NLN ;NO, ERROR
IFN PPNTSW,<
PUSHJ P,PAGEJT ;EJECT PAGE
>
TRNE FL2,NONUMF
TRZ FL2,SUPN ;TURN IT OFF IF IN NONUM MODE
JRST COMND ;YES, RETURN FOR COMMAND
;CHECK TO SEE IF OUT OF LIMITS SKIP RETURN IF OK
ONMOV: JUMPE T1,CPOPJ ;0, MUST BE EOF SO ALL DONE
PUSHJ P,CHKREN ;CHECK REENTER
POPJ P, ;YES: SAY WE ARE THROUGH
ONMOV1: MOVE T2,CPG ;GET THE CURRENT PAGE
CAMN T1,PGMK ;ARE WE AT A PAGE MARK?
ADDI T2,1 ;YES, TREAT AS NEXT PAGE
TRNE FL,CNTF ;IS THIS A ! TYPE COMMAND?
JRST ONCNT
CAMLE T2,HIPG ;HOW DOES IT COMPAGE WITH UPPER LIMIT
POPJ P, ;HIGHER, ALL DONE
CAME T1,PGMK ;IF PAGE MARK, DO NOT COMPARE LINE
CAME T2,HIPG ;OR IF NOT ON LAST PAGE
SKIPA
CAMG T1,HILN ;ARE WE OUT OF LINES?
AOS (P) ;SKIP RETURN ALL OK
POPJ P, ;GO
ONCNT: CAMN T1,PGMK ;DO NOT COUNT PAGE MARKS
SKIPG SVCNT ;IF PAGE MARK, GIVE UP IF DONE
SOSL SVCNT ;ARE WE OUT
AOS (P) ;SKIP RETURN FOR OK
POPJ P,
;HERE TO EJECT PAGE
IFN PPNTSW,<
PAGEJT: TRNN JF,EJECT ;EJECTING?
POPJ P, ;NO: JUST RETURN
MOVE T5,LSTCNT
ADD T5,PAGESZ ;GET COUNT LEFT
SUBI T5,FULLPG ;EJECT TO TOP OF PAGE
TRNN JF,WAIT ;IF NOT WAITING
SUBI T5,1 ;ONE MORE LINE
SUBI T5,1 ;HANDLE ZERO CASE
MOVEI C,15 ;PUT OUT CR
PUSHJ P,OCHR
JRST PUTLN1
PUTLN: MOVEI C,12
PUSHJ P,OCHR ;OUTPUT LF'S
PUTLN1: CAMN T5,[-11] ;A BIT WEIRD
PUSHJ P,PUTPG
AOJL T5,PUTLN
AOS LOGPG ;INCR LOGICAL PAGE
PUSHJ P,FORCE ;OUTPUT
POPJ P,
;HERE TO WAIT FOR BOTTOM OF PAGE
PAGEWT: TRNN JF,WAIT ;WAITING?
JRST NOWAIT ;NOPE!
PGWT:
OUTSTR [BYTE (7)10,10,10,10,0]
READ1: PUSHJ P,GNCH ;GET NEXT CHAR
CAIE C,"G"
CAIN C,"g"
TRZ JF,WAIT
CAIE C,"Q"
CAIN C,"q"
JRST QPRINT
CAIE C,12 ;LF?
JRST READ1
NOWAIT: MOVN T5,PAGESZ ;RESET LINE COUNT
MOVEM T5,LSTCNT
POPJ P,
QPRINT: PUSHJ P,GNCH
CAIE C,12 ;SKIP TO LF
JRST QPRINT
JRST COMND
;;;; STILL IN IFN PPNTSW
;HERE ON END OF PAGE
PAGEND: PUSHJ P,PAGEJT ;EJECT A PAGE
JRST PAGEWT ;AND GO WAIT
;ROUTINE TO OUTPUT FUNNY PAGE NUMBERS
PUTPG: TRNN JF,PGNOS ;ARE WE?
POPJ P,
MOVE T1,RMAR
ADD T1,LMAR
ASH T1,-1 ;PUT OUT (R+L)/2 BLANKS
PUTPG1:
OUTCHR [" "]
SOJG T1,PUTPG1
OUTCHR ["-"]
MOVE T2,CPG ;CURRENT PAGE
PUSHJ P,DPRNT
MOVE T2,LOGPG ;LOGICAL PAGE
JUMPE T2,PUTPG2
OUTCHR ["."]
PUSHJ P,DPRNT ;SUB-PAGE
PUTPG2:
OUTSTR [BYTE (7)"-",15]
POPJ P,
> ;;; END IFN PPNTSW
;PRINT SWITCH SCANNER
IFN PPNTSW,<
PRNSCN: PUSHJ P,SCAN ;GET NEXT CHAR
MOVS T1,ACCUM
CAIN T1,(<SIXBIT /N />)
TRO JF,PGNOS
CAIN T1,(<SIXBIT /S />)
TRO FL2,SUPN
CAIN T1,(<SIXBIT /W />)
TRO JF,WAIT
CAIN T1,(<SIXBIT /E />)
TRO JF,EJECT
CAIN T1,(<SIXBIT /F />)
JRST [TRO JF,EJECT!WAIT
TRO FL2,SUPN
JRST .+1]
PUSHJ P,SCAN ;SCAN PAST IT
TRNE FL,TERMF ;TERMINATOR
JRST [TRNN JF,EJECT!WAIT!PGNOS
TRNE FL2,SUPN
POPJ P,
NERROR ILC]
CAIE C,"," ;MORE?
NERROR ILC
JRST PRNSCN ;YES - GET EM
>
IFE PPNTSW,<
PRNSCN: PUSHJ P,SCAN ;GET NEXT ATOM
MOVS T1,ACCUM
CAIE T1,(<SIXBIT /S />)
NERROR ILC ;ONLY LEGAL SW IS S
PUSHJ P,SCAN ;SCAN PAST IT
TRNN FL,TERMF ;MUST BE END
NERROR ILC
TRO FL2,SUPN ;SET FLAG
POPJ P, ;RETURN
>
PGPRN: TRNN FL,DPYF ;CHECK DPY MODE
OCRLF
OUTSTR [ASCIZ /Page /]
PUSHJ P,DPRNT ;PRINT THE NUMBER IN T2
OCRLF
AOS LSTCNT
AOS LSTCNT ;PAGE N - TAKES 2 LINES
POPJ P,
;THE USUAL NUMBER PRINTER
DPRNT: JUMPGE T2,DPRNT0 ;OK IF NOT NEG.
MOVN T2,T2 ;ELSE MAKE POSITIVE
OUTCHR ["-"] ;AND OUTPUT A MINUS
DPRNT0: IDIVI T2,^D10
HRLM T3,(P)
SKIPE T2
PUSHJ P,DPRNT0
HLRZ C,(P)
ADDI C,"0"
OUTCHR C
POPJ P,
;CHARACTER OUTPUT
OCHR: JUMPE C,CPOPJ ;IGNORE NULLS
MOVE CS,CTBL(C) ;GET THE MAJIC BITS
TLNE CS,LETF_16 ;CHECK FOR LETTER
TDC C,CASEBT ;AND CHANGE CASE AS NECESSARY
TRNE FL2,SUPN ;IS THIS A PRETTY PRINT? IF SO NO ' CONVERSION
JRST OCH2
PUSH P,C ;SAVE THE CHARACTER
LDB C,[POINT 7,CTBL(C),10] ;GET PRINT EQUIV.
JUMPE C,OCH1 ;NONE, PRINT ORIGINAL
TDNE CS,[XWD LETF_16,M37] ;IS THIS A LETTER OR SPECIAL
TRNN FL,M37F ;AND A MODEL 37
TLNE FL,QMODF
JRST [MOVE C,(P) ;GET ORIG CHAR
CAIL C,40 ;CHECK FOR CONTROL CHAR
JRST OCH1 ;NO - JUST PRINT IT
ADDI C,100
MOVEM C,(P) ;CONVERT TO PRINTING CHAR
MOVEI C,"^"
JRST OCH0]
MOVEM C,(P) ;SAVE IN STACK
MOVEI C,"'"
OCH0: PUSHJ P,OCH2 ;PUT OUT CHR
OCH1: POP P,C ;GET CHAR TO PRINT
OCH2: SOSG TTOCNT
PUSHJ P,FORCE
IDPB C,TTOPNT
POPJ P, ;AND RETURN
OUTLIN: TRNE FL2,SUPN!NONUMF ;ARE WE SUPPRESSING LINE NUMBERS?
AOS T1 ;YES, SKIP IT
HRLI T1,(<POINT 7,0>);GET SET TO PRINT A LINE
TRNE FL2,SUPN!NONUMF ;IF SUPPRESSING LINE NUMBERS
IBP T1 ;ALSO SUPPRESS THE TAB WHICH FOLLOWS
OUTL1: ILDB C,T1 ;GET A CHR
JUMPE C,FORCE ;QUIT ON NUL
PUSHJ P,OCHR ;AND PRINT IT
CAIE C,12 ;IS IT LINE FEED
JRST OUTL1 ;NO, CONTINUE
;;; ;FALLIN FORCE
;ROUTINE TO DUMP TTY BUFFER AND SET UP FOR NEXT
FORCE: PUSH P,C ;SAVE CURRENT CHAR
MOVEI C,0 ;GRNTEE NULL
IDPB C,TTOPNT ;AT END OF STRING
OUTSTR TTOBUF ;DUMP IT
MOVEI C,^D80 ;NEW COUNT
MOVEM C,TTOCNT
MOVE C,[POINT 7,TTOBUF]
MOVEM C,TTOPNT ;AND PNTR
POP P,C ;RESTORE C
POPJ P, ;AND RETURN
SUBTTL END ROUTINE
;CODE TO FINISH OFF EDIT
ASVINS: SKIPA T1,HILN ;LAST LINE INSERTED
ASVREP: MOVE T1,LOLN ;...
MOVEM T1,SVLNUM ;SAVE FOR RESTART
TLO FL2,AUTOF ;SET TO DO AUTO SAVE
SKIPE ALTSN ;NEED CRLF?
OCRLF ;YEP
OUTSTR [ASCIZ "[Doing auto-save, please wait.]"]
OCRLF
SVCOD: TLNE FL,SRCOP ;IF INSIDE COPY
JRST DSCOP ;TREAT LIKE AN E
TRO FL2,SVIT ;SET TO DO A SAVE
MOVE T1,SSAVEN ;RESET ALL CNTRS
MOVEM T1,SAVEN
JUMPN T1,[TLNN FL2,AUTOF
AOS SAVEN ;FIX CMD COUNT IF NOT AUTO
JRST .+1]
MOVE T1,SISAVN
MOVEM T1,ISAVEN ;...
PUSH P,UNSEQF ;SAVE CURRENT VALUE
SKIPN UNSEQF ;CHECK FOR UNSEQ
JRST END0 ;PROCEDE
OUTSTR [ASCIZ "[WARNING: Sequence numbers preserved.]"]
OCRLF
SETZM UNSEQF
JRST END0
GEND: TLOA FL,GCOM ;GO
ENDIT: TLZ FL,GCOM ;NORMAL TYPE END
END0: TLNE FL,SRCOP
JRST DSCOP ;FINISH UP THE COPY COMMAND
TLO FL2,NORENT ;DISABLE REENTER
TLZ FL2,RENTF
TRNE FL,READOF ;IF READ ONLY
JRST ENDRO ;DO SPECIAL END CODE
TLZ FL2,BELLF ;DISABLE <BELL><BELL>
TRZ FL,NEWFL ;SET TO WANTS SAME OLD PROGRAM
PUSHJ P,NSCAN ;SETUP NEWBLK
NERROR ILC ;BAD SYNTAX
SKIPE DELETF ;WANT TO DELETE?
JRST END1B ;YES - SKIP THIS STUFF
SKIPN UNSEQF
TRNE FL,NEWFL
TLO FL2,PCHGF!FCHGF ;CHANGED IF UNSEQ OR NEW NAME
TLNN FL2,FCHGF
JRST [OCRLF
OUTSTR [ASCIZ "[No changes.]"]
OCRLF
SETZB T1,T2 ;DELETE OUTPUT FILE
RENAME OUT,T1
JFCL
JRST ENDEND]
JRST END1
;CODE TO HANDLE 'E' COMMANDS IN R/O MODE
ENDRO: PUSHJ P,GNCH ;GET A CHAR
ANDI C,137 ;FORCE UPPER
CAIN C,"D" ;CHECK FOR DELETE REQ
JRST [SETOM DELETF
MOVEI C,0 ;DON'T BACKUP SCAN
JRST .+1]
CAIE C,"Q" ;QUIT OK ALSO
MOVEM C,SAVC ;BACKUP IF NOT Q
PUSHJ P,SCAN ;CHECK FOR EOL
TRNN FL,TERMF
NERROR ILC
SKIPN DELETF ;CHECK WHICH
JRST ENDEND ;JUST QUIETLY EXIT
JRST END1B ;GO DELETE
END1: PUSHJ P,OCOMPL ;COMPLETE FILE COPY
RELEAS IN, ;AND CLOSE OFF INPUT CHL
SKIPE AUXFIL ;IF NO AUX FILE
TLNE FL2,PCHGF ; AND NO CHANGES
JRST [PUSHJ P,OUTDO ;PURGE OUTPUT BUFFERS
JRST END1A]
MOVSI T1,'TMP' ;FIXUP CORRECT FILE
HLLM T1,OCREXT
SETZM AUXFIL ;NO AUX FILE ANYMORE
SETZB T1,T2
RENAME OUT,T1 ;DELETE OUTPUT FILE
JFCL ;CAN'T HAPPEN
END1A: CLOSE OUT, ; AND CLOSE CHL ALSO
MOVE T1,[ORGBLK,,ICRBLK]
BLT T1,ICRBKE ;SET UP FOR BACKUP FILE
END1B: MOVE T1,ORGDEV ;GET ORIGINAL INPUT DEVICE
MOVEM T1,INDEVI+1
OPEN IN,INDEVI ;AND RE-OPEN CHL
JRST NODSK ;THIS CAN'T HAPPEN OFTEN
SKIPE DELETF ;DELETING?
JRST END3B ;YES -- SKIP MORE
END2: XLOOK OUT,NEWBLK ;SEE IF DEST FILE EXISTS
JRST END4 ;NOT FOUND - OK
CLOSE OUT, ;RELEASE FILE NOW
TRNN FL,NEWFL ;FOUND - IS THIS OK?
JRST END3 ;YES: WE SHOULD HAVE FOUND IT
OUTSTR [ASCIZ /
Output file exists - delete? /]
PUSHJ P,CONFRM ;ASK HIM IF OK
JRST ASKNAM ;HE SAID NO - ASK FOR NEW NAME
LDB T1,[POINT 9,XBLOCK+2,8]
CAIL T1,400 ;BETTER CHECK IF OK
JSP T1,FIU ;SAY ITS PROTECTED
CAIGE T1,200 ;NEED TO CHANGE?
JRST END2A ;NO - JUST DELETE
PUSHJ P,FIXPRT ;CORRECT PROTECTION
HRRM T1,NEWPRT
XRENM OUT,NEWBLK
JSP T1,FIU
END2A: SETZB T1,T2 ;HE SAID YES - DELETE IT
RENAME OUT,T1 ;...
JSP T1,FIU ;OOPS!
JRST END4 ;NOW TREAT IT AS NOT THERE
END3: HLRZ T1,ICREXT ;GET ORIGINAL EXTENSION
ANDI T1,7777 ;SAVE LAST 2 CHARS
IORI T1,'Q ' ;MAKE IT INTO QXX
SKIPLE BAKF ;UNLESS OF CORSE WE NEEDED
XORI T1,130000 ;THE OLD EXTENSION - ZXX
HRLM T1,ICREXT ;STASH EXTENSION & GET PROT
MOVE T1,ICREXT
TRZ T1,700 ;CORRECT PROTECTION
PUSH P,T1 ;AND SAVE FOR LATER
XLOOK IN,ICRBLK ;IS FILE THERE
JRST END3B ;NO: JUST DO RENAME
SKIPG BAKF ;YES: NEED OLD ?
JRST END3A ;NOPE - GO DO RENAME (DELETE FIRST)
MOVSI T1,130000 ;YES - MAKE CORRECT EXTENSION
XORB T1,0(P) ; TO BE QXX.
HLLM T1,ICREXT
XLOOK IN,ICRBLK ;NOW LOOK FOR THIS ONE
JRST END3B ;NOT THERE - IMAGINE THAT
END3A: LDB T1,[POINT 9,XBLOCK+2,8]
CAIL T1,400 ;CHECK IF OK
JRST [OUTSTR [ASCIZ /% Backup file write protected - ignored/]
OCRLF
CLOSE IN,
SETZM BAKF ;SAY NO BACKUP
JRST END3B]
HRRM T1,0(P) ;SAVE OLD FILE PROT.
CAIGE T1,200 ;CHECK GOODNESS OF PROTECTION
JRST END3R ;OK - JUST DELETE
PUSHJ P,FIXPRT ;ADJUST INTO RANGE 1XX
HRRM T1,ICRPRT ;STASH PROT
XRENM IN,ICRBLK ;CHANGE PROT SO WE CAN DELETE
JSP T1,FIU ;OH - WELL
END3R: SETZB T1,T2 ;PREPARE FOR DELETE
RENAME IN,T1 ;ZAP-A-ROO!
JSP T1,FIU ;WHOOPS!
;;;; ;FALIN END3B
END3B: MOVE T1,[ORGBLK,,TMPBLK]
BLT T1,TMPBKE ;SET UP COPY OF ORIGINAL
XLOOK IN,TMPBLK ;LOOK FOR IT
JSP T1,FIU ;SOMEBODY'S CONFUSED
HRRZ T1,ORGPRT ;GET ORIGINAL PROT.
CAIGE T1,200 ;TOO LARGE?
JRST END3C ;OK TO JUST RENAME
PUSHJ P,FIXPRT ;MAKE GOOD
HRRM T1,TMPPRT ;STASH IN THE RIGHT PLACE
XRENM IN,TMPBLK ;CHANGE PROT FOR LATER
JSP T1,FIU ;BETTER NOT!
END3C: SKIPE DELETF ;STILL DELETING?
JRST ENDDEL ;YES -- FINISH UP
POP P,TMPEXT ;RESTORE EXT & PROT
SKIPN BAKF ;IS THIS NECESSARY?
SETZM TMPNAM ;NO: JUST DELETE THE LOSER
SETSTS IN,1 ;GIVE CORRECT I/O STATIS
XRENM IN,TMPBLK ;TRY RENAME
JSP T1,FIU ;WHOOPS
END4: HRRZ T1,ORGPRT ;GIVE FILE ORIGINAL PROT
HRRM T1,NEWPRT ;...
SKIPE UNSEQF ;SKIP LOOKUP IF UNSEQUENCING
JRST UNSEQ
XLOOK OUT,OCRBLK ;LOOKUP TEMP FILE
JRST EDFLIN ;GIVE UP
PUSHJ P,ENDNAM ;PRINT FINAL NAME
SETSTS OUT,1 ;CORRECT I/O STATUS
XRENM OUT,NEWBLK ;RENAME TO DESIRED NAME
JSP T1,FIU ;LOSE AGAIN
JRST ENDEND ;AND FINISH UP
ENDNAM: OUTSTR [ASCIZ "
["]
MOVEI T4,NEWBLK ;NEW FILE NAME
PUSHJ P,GVNAM0 ;PRINT IT
OUTSTR [ASCIZ "]
"]
POPJ P,
ENDDEL: SETZB T1,T2 ;SET FOR DELETE
RENAME IN,T1 ;CAN EVERYTHING
JFCL
RENAME OUT,T1 ;...
JFCL
;;;; ;FALIN ENDEND
ENDEND: CLOSE IN, ;TERMINATE INPUT CHL
RELEAS IN,
CLOSE OUT,
SKIPE AUXFIL ;AUX FILE IN USE?
PUSHJ P,DELAUX ;YES: DETLETE IT
RELEAS OUT, ;TERMINATE OUTPUT CHL
TRNE FL2,SVIT ;CHECK FOR SAVE COMMAND
JRST RESTRT ;YES - GO RESTART
TLNE FL,GCOM ;IS THIS A 'GO'?
JRST CREFIT ;YES - DO RUN UUO
MONRET: EXIT 1,
SKIPGE CNCLOK ;SEE IF FROM M OPTION
JRST MONRET
JRST CNCCON ;OK - IF FROM ^C
;ROUTINE TO DELETE AUX FILE IF ANY
DELAUX: MOVSI T1,'TMP' ;GET EXTENSION
HLLM T1,OCREXT ;IN PLACE
SETZM AUXFIL ;SAY IT'S GONE
XLOOK OUT,OCRBLK ;THERE?
POPJ P, ;DON'T SWEAT IT
SETZB T1,T2 ;SET TO DELETE
RENAME OUT,T1 ;POW!
JFCL ;DON'T CARE
POPJ P, ;RETURN
;HERE TO START WORLD OVER AFTER 'W'
RESTRT: RESET ;A GOOD THING
POP P,UNSEQF ;NOW RESTORE ALL GOOD THINGS
SETZM RPGSW
TDZ FL,[TECOF,,BOF!EOF!EOF2!NEWFL]
MOVE T1,[NEWBLK,,ORGBLK]
BLT T1,ORGBKE ;SET UP INPUT FILE NAME
MOVE T1,OCRDEV ;GET CORRECT DEVICE
MOVEM T1,ORGDEV
PUSHJ P,ZERNEW ;CLEAR OUT OLD INFO
JRST RPGRET ;AND START OVER
;CODE FOR 'ED' COMMAND, CHECK PROPER TERM AND SET FLAG
ZAPIT: PUSHJ P,SCAN ;CHECK EOL
TRNN FL,TERMF ;
POPJ P, ;ERROR RETURN FROM NSCAN
SETOM DELETF ;SET FLAG
JRST CPOPJ1 ;GOOD RETURN
;ROUTINE TO GET PROT INTO RANGE 1XX
FIXPRT: MOVEI T2,200 ;GENERATE XOR CONST
CAIGE T1,300
IORI T2,100
XOR T1,T2 ;ZAP IT
POPJ P, ;RETURN WITH PROT IN T1
NSCAN: TLNE FL2,AUTOF ;SPECIAL IF AUTO MODE
JRST NSCAN1
NSCAN0: PUSHJ P,GNCH ;LOOK FOR ARGS
CAIN C,":" ;IS IT A COLON
JRST NSCAN2 ;YES: GO LOOK FOR FILE NAME
ANDI C,137 ;FORCE UPPER CASE
MOVEI T1,0 ;INITIAL VALUE
MOVE T2,[POINT 7,[ASCIZ "SBQD"]]
NSCNA: ILDB T3,T2 ;GET CHAR
JUMPE T3,NSCAN3 ;NOT FOUND IF NULL
CAIE C,(T3) ;MATCH?
AOJA T1,NSCNA ;NO -- TRY NEXT
XCT ENDTBL(T1) ;IF SW SEEN - DO ROUTINE
JRST NSCAN0 ;LOOK FOR MORE
NSCAN2: PUSHJ P,SCAN ;GET A FILE NAME
PUSHJ P,SETNM1 ;...
POPJ P, ;ERROR RETURN
SKIPE TMPDEV ;ERROR IF DEVICE SPECIFIED
POPJ P,
MOVE T1,[TMPBLK,,NEWBLK]
BLT T1,NEWBKE ;PUT INFO IN NEWBLK
NSCAN1: SKIPN NEWNAM ;IF NEW NAME
JRST NSCN1A
TRO FL,NEWFL ;THEN INDICATE NEW FILE
HRRZ T1,ORGPRT ;GET CORRECT PROTECTION
HRRM T1,NEWPRT ;...
MOVE T1,OCRDEV ; AND CORRECT STR NAME
MOVEM T1,NEWDEV
MOVSI T2,-<PTH+SFDLVL+1>
MOVE T1,NEWBLK(T2) ;COMPARE FILE SPECS
CAMN T1,ORGBLK(T2) ;...
AOBJN T2,.-2
JUMPL T2,CPOPJ1 ;JUMP IF DIFFERENT
TRZ FL,NEWFL ;IT AINT NEW
JRST CPOPJ1
NSCN1A: MOVE T1,[OCRBLK,,NEWBLK]
BLT T1,NEWBKE ;SET UP NEWBLK FOR CORRECT
HRROI T1,ORGEXT ;FILE SPEC
POP T1,NEWEXT
POP T1,NEWNAM
JRST CPOPJ1
NSCAN3: MOVEM C,SAVC ;BACK UP SCANNER
PUSHJ P,SCAN
TRNE FL,TERMF ;CHECK FOR TERM
JRST NSCAN1 ;PROPER - CHECK NEW NAME
POPJ P, ;NO TERM - LOSE
ENDTBL: SETOM UNSEQF ;'S'
SETZM BAKF ;'B'
JRST QUIT ;'Q'
JRST ZAPIT ;'D'
ASKNAM: OUTSTR [ASCIZ /File: /]
SETZM SAVCHR ;RESET SCAN
CLRBFI
PUSHJ P,NSCAN2 ;GET A NEW NAME
SKIPA
JRST END2 ;TRY AGAIN
OUTSTR [ASCIZ /? What?
/]
JRST ASKNAM ;WE CAN DO THIS UNTIL YOU GET IT CORRECT
FIU: OUTSTR [ASCIZ /
? File write protected. Try another name
/]
JRST ASKNAM
;CODE FOR 'EQ' COMMAND. JUST DELETE TEMPS AND EXIT
QUIT: POP P,0(P) ;PRUNE PDL
PUSHJ P,SCAN ;MAKE SURE NO ARGS
TRNN FL,TERMF
NERROR ILC
SETZB T1,T2 ;SET TO DELETE OUTPUT SIDE
RENAME OUT,T1
JFCL ;DON'T CARE
JRST ENDEND
QCOM: PUSHJ P,SCAN ;CHECK THAT THIS IS REALLY JUST 'Q'
TRNN FL,TERMF
NERROR ILC
OUTSTR [ASCIZ /% Type 'W' to save world - 'EQ' to quit
/]
JRST COMND
;HERE TO DO UNSEQUENCING
UNSEQ: RELEAS IN, ;PREPARE FOR NEW OPEN
MOVE T1,OCRDEV ;GET OUTPUT DEVICE
MOVEM T1,INDEVI+1
OPEN IN,INDEVI ;OPEN CHL
JRST NODSK ;SIGH!
SETSTS IN,1 ;SET UP CORRECT I/O STATUS
SETSTS OUT,1
MOVSI T1,(<1B0>) ;SET UP RING BUFFERS
HLLM T1,OBUF
HLLM T1,IBUF
MOVSI T1,(<POINT 7,,>)
HLLZM T1,OBUF+1
HLLZM T1,IBUF+1
SETZM OBUF+2
SETZM IBUF+2
IFN CRYPSW,<
SETOM IBUF+3 ;INIT BLK CNTR
MOVNI T1,2
MOVEM T1,OBUF+3
MOVE T1,NEWCOD ;GET CORRECT PSWS
EXCH T1,OCRCOD
MOVEM T1,ICRCOD ;...
>
XENTR OUT,NEWBLK ;CREATE NEW FILE
JSP T1,FIU ;LOSAGE
XLOOK IN,OCRBLK ;LOOKUP TEMP FILE
JRST EDFLIN ;GROAN
TDZ FL,[COPFIL,,EOF];CLR FLAGS
UNSEQL: PUSHJ P,GCHAR ;FETCH CHARACTER
JUMPE T3,UNSEQ5 ;DONE IF ZERO RETURNED
MOVE T1,@IBUF+1 ;SEE IF SEQ #
TRNN T1,1
JRST UNSEQ2
SKIPE BASICF ;CHECK BASIC MODE
JRST UNSEQB
AOS IBUF+1 ;SKIP SEQ #
MOVNI T3,5
ADDM T3,IBUF+2
JRST UNSEQL
UNSEQ2: PUSHJ P,PCHAR ;WRITE CHAR
JRST UNSEQL ;LOOP UNTIL DONE
UNSEQ5: SETZB T1,T2 ;SET FOR DELETE
RENAME IN,T1
JFCL
PUSHJ P,OUTDO ;DUMP LAST BUFFER
PUSHJ P,ENDNAM ;PRINT FINAL NAME
JRST ENDEND
;HERE FOR SPECIAL BASIC UNSEQUENCE
UNSEQB: SKIPA T1,[5] ;DO 5 CHAR SEQ #
PUSHJ P,GCHAR ;GET NEXT CHAR
PUSHJ P,PCHAR ;OUTPUT CHAR
SOJG T1,.-2
PUSHJ P,GCHAR ;GET TAB
CAIE T3,11 ;IT BETTER BE
ERROR ICN
MOVEI T3,40 ;PUT IN A SPACE
JRST UNSEQ2
SUBTTL SOME GENERAL PURPOSE STUFF
;SOME MORE GENERAL ROUTINES
RDLIN: SETZM LIBUF+1 ;READ IN A LINE. FIRST ZERO INPUT BUFFER
MOVE T1,[XWD LIBUF+1,LIBUF+2]
BLT T1,LIBUF+MXWPL+1
MOVE T1,[POINT 7,LIBUF+1] ;SET UP POINTER
MOVEI T2,5*MXWPL-2 ;SET FOR AVAILABLE SPACE
MOVEI C,11 ;START WITH A TAB
JRST RDL3
RDL1: PUSHJ P,GNCH ;GET ANOTHER CHARACTER
CAIN C,15 ;IGNORE RETURN
JRST RDL1
CAIN C,12 ;LINE FEED IS THE ONLY PROPER END
JRST RDL2
CAIE C,200 ;ALTMODE IS A SPECIAL CASE
JRST RDL3 ;NOT ALTMODE
SETOM ALTSN ;FLAG ALTMODE SEEN FOR I AND R
CAIE T2,5*MXWPL-3
JRST RDL2 ;DO END OF LINE STUFF
POPJ P, ;EMPTY LINE RETURN
RDL3: IDPB C,T1 ;PUT IT IN THE BUFFER
SOJGE T2,RDL1 ;CHECK FOR OVERFLOW AND CONTINUE
RERROR LTL ;LINE IS TOO LONG
POPJ P, ;NON-SKIP RETURN
RDL2: MOVEI C,15 ;PUT IN A CR-LF
IDPB C,T1
MOVEI C,12
IDPB C,T1
HRRZS T1 ;NOW GET THE SIZE
SUBI T1,LIBUF-1
AOS (P) ;SKIP RETURN IF OK
POPJ P, ;AND RETURN
GETLTH: MOVE T1,PNTR ;GET THE LENGTH OF THE LINE POINTED AT
ADDI T1,1
GETLN1: SKIPN T2,(T1) ;ANY END IS GOOD ENOUGH
JRST GETLN2
TRNN T2,1 ;SEQ-NUM?
AOJA T1,GETLN1
GETLN2: SUB T1,PNTR ;FIND LENGTH
POPJ P, ;AND RETURN
OUTSN: MOVEM T1,SQBUF ;PUT IT IN SPACE FOLLOWED BY A TAB
OUTSTR SQBUF
POPJ P,
ASCIAD: AND T2,K2A ;CONVERT TO NUMBERS
IOR T1,K4A ;MAKE SURE THIS IS IN DIGIT FORM
ADD T1,K1A ;GET EACH DIGIT IN RANGE 166 TO 177 FOR CARRY
ADD T2,T1 ;SUM
AND T2,K3A ;GET RID OF 100 BITS IF THERE
MOVE T1,K4A ;FIND OUT WHICH ONES NEED SUBTRACTING
AND T1,T2
ASH T1,-3 ;CONVIENIENTLY THEY NEED 6 SUBTRACTED
SUBM T2,T1 ;SO DO IT
IOR T1,K4A ;AND RECONVERT TO DIGITS
POPJ P, ;WE HAVE ADDED THE ASCII IN T1 AND T2 RESULT IN T1
K1A: BYTE (7) 106,106,106,106,106
K2A: BYTE (7) 17,17,17,17,17
K3A: BYTE (7) 77,77,77,77,77
K4A: <ASCII /00000/>!1
K5A: BYTE (7) 7,7,7,7,7
K6A: BYTE (1) 1 (7) 77,77,77,77,77
K7A: BYTE (1) 0 (7) 106,106,106,106,106
ASCAV: AND T2,K2A
IOR T1,K4A ;THIS ROUTINE AVERAGES 2 ASCII NUMERS
LSH T1,-1
ADD T1,K7A ;IT WORKS MOSTLY BY MAJIC
LSH T2,-1
ADD T2,T1
AND T2,K6A
MOVE T1,T2
ANDCM T1,K3A
AND T2,K3A
MOVE T3,T2
LSH T3,-3
AND T3,K2A
AND T2,K5A
SUB T2,T3
LSH T1,-4
ADD T2,T1
LSH T1,-2
ADD T2,T1
IOR T2,K4A
POPJ P,
;CHECK TO SEE IF BUFFER TOO FULL AND DUMP IF NEEDED
FILLB: MOVE T1,WC ;GET WORD COUNT
FILLB3: CAMGE T1,MAXWC ;AND COMPARE WITH MAX PERMISSIBLE
POPJ P, ;OK, SO RETURN
MOVE T1,BUFP ;GET BUFFER POINTER
ADDI T1,1
FILLB1: SKIPN T2,(T1) ;FIND END OF FIRST LINE
JRST FILLB2
TRNN T2,1
AOJA T1,FILLB1
FILLB2: PUSHJ P,NOWFL ;PART OF GETN WILL DUMP AND ADJUST POINTERS
JRST FILLB ;SEE IF IN LIMITS NOW
;INSERT A LINE (IN LIBUF) INTO PLACE POINTED AT BY PNTR
;WORD COUNT OF OLD LINE IN OCNT. OF NEW LINE IN NCNT
INSED: TLO FL2,ALLCHG ;CHANGES
MOVE T1,NCNT ;SEE HOW THE COUNTS DIFFER
SUB T1,OCNT
JUMPE T1,NOBLT ;THEY ARE SAME, NO MOVING NECESSARY
JUMPG T1,BBLT ;NEW IS LARGER, BLT WILL NOT DO
MOVE T2,PNTR ;SET UP BLT POINTER FROM PNTR+OCNT
ADD T2,OCNT
HRLS T2
HRR T2,PNTR ;TO PNTR+NCNT
ADD T2,NCNT
ADDB T1,WC ;ADJUST WC TO OLD WORD COUNT +NCNT-OCNT
ADD T1,BUFP ;LAST TRANSFERED IS BUFP+WC+NCNT-OCNT
BLT T2,(T1)
NOBLT: SKIPN T1,NCNT ;CHECK FOR 0 NEW COUNT (WE ARE DELETING)
POPJ P, ;IF SO DONE
MOVE T2,PNTR ;GET THE POINTER POSITION FOR BLT
HRLI T2,LIBUF ;FROM LIBUF TO PNTR
ADD T1,PNTR ;STOP AT PNTR+NCNT-1
BLT T2,-1(T1)
POPJ P, ;AND ALL DONE
BBLT: MOVE T2,BUFP ;FAKE BACKWARDS BLT FROM BUFP+WC
ADD T2,WC
ADDB T1,WC ;TO BUFP+WC+NCNT-OCNT (ALSO FIX WC)
ADD T1,BUFP
BBLT1: CAMGE T2,PNTR ;STOP HERE (COULD STOP SOONER BUT THIS IS EASIER)
JRST NOBLT ;AND GO MOVE IN NEW STUF
MOVE T3,(T2) ;TRANSFER A WORD
MOVEM T3,(T1)
SUBI T1,1
SOJA T2,BBLT1 ;AND KEEP IT UP
SUBTTL INSERT ROUTINE
;INSERT A LINE
CRTINS: OCRLF
MOVEI T1,1 ;SET TO START INSERTING AT LINE 100 PAGE 1
MOVEM T1,HIPG
SKIPN T1,TECFST ;USE START IF GIVEN
MOVE T1,[<ASCII /00100/>!1]
MOVEM T1,HILN
JRST INSGO ;AND AWAY WE GO
INSERT: TRNE FL,READOF ;ERROR IF READ-ONLY
NERROR ILC
PUSHJ P,SCAN
TRNE FL,TERMF ;CHECK FOR NO ARGUMENTS
JRST [MOVE T1,IPG
MOVEM T1,HIPG
MOVE T1,CURINS
MOVEM T1,HILN
JRST INSGO] ;GO BACK TO INSERTING WHERE YOU WERE
PUSHJ P,GET1 ;GET ONE LINE/PAGE NUMBER
TRNN FL,LINSN ;WAS /N GIVEN
JRST INSMK ;YES: TREAT SPECIAL
PUSHJ P,INSINC ;GET INCR IF ANY
INSGO: PUSHJ P,DOINS ;DO THE INSERTS
JRST COMND ;RETURN
INSINC: CAIN C,"," ;TRYING TO GIVE PERM INC?
JRST GETINC ;YES - GO GET IT
CAIE C,";" ;TEMP INC?
JRST NOINC ;NOPE
MOVE T1,INCR ;SAVE OLD INCR
MOVEM T1,TEMINC
PUSHJ P,GNCH ;LOOK AT NEXT CHAR
CAIE C,"!" ;TRYING TO GIVE NUMBER OF LINES?
JRST [MOVEM C,SAVC ;NO - BACK UP SCANNER
JRST GETINC] ; AND READ INCR
SETOM INCR ;YES - SET FLAG
GETINC: PUSHJ P,SCAN ;GET THE NUMBER
TRNE FL,NUMF ;WAS IT A NUMBER?
CAMN T1,[<ASCII /00000/>!1] ;DO NOT PERMIT 0 INCR
NERROR ILC ;HE WAS CONFUSED
MOVEM T2,NLIN1 ;STASH DECIMAL
SKIPL INCR ;SEE IF INCR WANTED
MOVEM T1,INCR ;SET INCREMENT
PUSHJ P,SCAN ;SCAN PAST IT
NOINC: TRNN FL,TERMF ;TERMINATOR?
NERROR ILC ;LOSE
SETZM ALTSN ;CLEAR ALTMODE FLAG
POPJ P, ;RETURN
DOINS: MOVE T1,HIPG ;GET THE PAGE TO GO TO
MOVEM T1,DPG ;AND SET IT UP
MOVE SINDEX,HILN ;ALSO LINE
PUSHJ P,FIND ;GO GET UM
MOVE T2,CPG ;DEMAND CORRECT PAGE MATCH
CAME T2,HIPG
NERROR NSP
SKIPL INCR ;NEED TO COMPUTE ONE?
JRST INSTRY ;NO -- JUST TRY TO INSERT
MOVE T2,HILN ;YES -- SET UP FOR CALL
MOVE T3,NLIN1
PUSHJ P,GETDIF ;GET BEST FIT
NERROR ILR ;WHOOPS
MOVEM T1,HILN ;USE THESE VALUES
MOVEM T2,INCR
JRST INSLP
INSTRY: CAME T1,HILN ;DO THEY MATCH
JRST INSLP ;YES - GO AHEAD
MOVE T2,INCR ;NO - GO INVENT A NEW LINE
PUSHJ P,FIXLIN
EXP HILN
NERROR ILR ;NO ROOM
MOVEM T2,HILN ;STORE NEW NUMBER
INSLP: SETZM OCNT
SKIPE ALTSN ;ALTMODE SEEN?
JRST LVINS ;YES: DONE
MOVE T1,HILN ;TELL HIM THE LINE HE IS INSERTING
MOVEM T1,LIBUF ;AND PUT IT IN THE BUFFER
TRNN FL2,COMFLF!NONUMF ;IGNORE SQ # IF IN CMD FILE
PUSHJ P,OUTSN ;PUT IT OUT
PUSHJ P,RDLIN ;READ A LINE
JRST LVINS ;YES, GET OUT OF INSERT MODE
MOVEM T1,NCNT ;HERE IS THE COUNT OF THE NEW ONE
PUSHJ P,INSED ;GO INSERT
SOSN ISAVEN ;TIME TO SAVE?
PUSHJ P,ASVINS ;YES: GO DO IT
PUSHJ P,FINDN ;MOVE UP A LINE
PUSHJ P,FILLB ;AND DUMP SOME IF NECESSARY
MOVE T1,CPG ;SET CURRENT LINE AND PAGE TO LAST
MOVEM T1,CPGL ;ONE REALLY INSERTED
MOVE T1,HILN
MOVEM T1,CLN
MOVE T2,INCR ;GET NEXT LINE TO INSERT
PUSHJ P,ASCIAD
CAMG T1,INCR ;HAVE WE WRAPED AROUND
JRST LVINS1 ;YES -- STOP
MOVEM T1,HILN ;STORE FOR REFERENCE
SKIPN T1,(PNTR) ;GET THE LINE POINTED TO
JRST INSLP ;ALWAYS INSERT AT END OF FILE
CAME T1,PGMK ;OR AT END OF PAGE
CAMLE T1,HILN ;HAVE WE FOUND A MATCH OR PASSED OVER A LINE?
JRST INSLP ;NO, INSERT
JRST LVINS1 ;RETURN TO COMMAND LEVEL
LVINS: MOVE T1,HILN
MOVEM T1,CURINS ;SET PLACE TO INSERT NEXT TIME
MOVE T1,CPG
MOVEM T1,IPG
TRNE FL2,COMFLF ;CMD FILE?
JRST LVINS2 ;YES SKIP CR
LVINS1: SKIPE ALTSN ;ALT SEEN?
OCRLF ;YES -- OUTPUT CRLF
LVINS2: SETZM ALTSN ;CLEAR ALTMODE FLAG
POPJ P, ;RETURN
;ROUTINE TO COMPUTE INCREMENT AS DIFFERENCE OF
; TWO LINES / # OF LINES TO INSERT
;CALL:
; MOVE T1,<RESULT OF FIND>
; MOVE T2,<LINE TYPED(DESIRED)>
; MOVE T3,<# OF LINES TO INSERT>
; PUSHJ P,GETDIF
; <ERROR RETURN (IE NO ROOM)>
; <OK RETURN>
; C(T2) := COMPUTED INCR
; C(T1) := WHERE TO START INSERTING
GETDIF: PUSH P,T3 ;SAVE ARGS
PUSH P,T2
PUSH P,T1 ;SAVE RESULT OF FIND
TLZE T3,(1B0) ;CHECK FOR SPECIAL
JRST [MOVEM T3,-2(P) ;CORRECT ARG
MOVEI T1,0 ;SAY EOF FOR FINDN
JRST NOFND]
CAMN T1,T2 ;ALREADY HAVE NEXT IF NOT EQUAL
PUSHJ P,FINDN ;LOOK FOR NEXT LINE
NOFND: SKIPE T3,T1 ;NONE IF EOF
CAMN T1,PGMK ; OR PAGE MARK
JRST [MOVEI T1,^D100000
JRST NONXT] ;USE HIGHEST + 1
PUSHJ P,NUMCON ;NEXT LINE # IN T1
NONXT: PUSH P,T1 ;SAVE IT
MOVE T3,-2(P) ;GET WHAT WAS TYPED
CAMN T3,-1(P) ;DOES IT EXIST?
SOS 0(P) ;YES - ALLOW FOR IT
PUSHJ P,NUMCON ;CONVERT ARG
MOVE T2,T1 ;MOVE RESULT TO T2
POP P,T1 ;RESTORE <NEXT>
SUB T1,T2 ;GET DIFFERENCE
IDIV T1,-2(P) ;(<NEXT>-<CURR>)/N
JUMPE T1,GOTZER ;DON'T FIT IF ZERO
CAIGE T1,3 ;IF 1 OR 2 ITS THE BEST
JRST GOTIT
MOVE T2,[-6,,[DEC 2,5,10,20,50,100,100001]]
CAML T1,1(T2) ;LOOK FOR ITEM .GT. T1
AOBJN T2,.-1
JUMPGE T2,GOTZER ;CAN'T HAPPEN
MOVE T1,0(T2) ;GET AESTHETIC INCR
GOTIT: PUSHJ P,ASCON ;CONVERT TO INCR FORM
MOVE T2,T3 ;GET INTO CORRECT AC
POP P,T1 ;GET BACK ARG
MOVEM T2,-1(P) ;STORE COMPUTED INCR
CAME T1,0(P) ;FIGURE OUT START POINT
JRST GETRET ;OK IF NOT FOUND
PUSHJ P,ASCIAD ;ELSE ADD INCR TO IT
MOVEM T1,0(P) ; AND USE IT
GETRET: POP P,T1 ;STARTING LINE #
POP P,T2 ;INCR
JRST CPOPJ1 ;GIVE GOOD RETURN
GOTZER: SUB P,[3,,3] ;PRUNE PDL
POPJ P, ;ERROR RETURN
;ROUTINE TO GUESS AT A GOOD PLACE TO INSERT IF CURRENT LINE EXISTS
;CALL:
; MOVE T1,<CURRENT POSITION>
; MOVE T2,<INCREMENT TO USE>
; PUSHJ P,FIXLIN
; <LOC OF HIGH BOUND>
; <ERROR RETURN>
; <OK RETURN> ;NEW NUMBER IN T2
FIXLIN: AOS T4,0(P) ;SKIP OVER ARG
PUSHJ P,ASCIAD ;ADD
PUSH P,T1 ;SAVE RESULT
PUSHJ P,FINDN ;GET THE NEXT ONE
POP P,T2
CAMG T2,@-1(T4) ;IS THERE A WAR PROBLEM
JRST FIXBAD ;YES, WE MUST TRY TO COMPUTE ONE
JUMPE T1,CPOPJ1 ;END OF FILE, ANY INC IS OK
CAME T1,PGMK ;ALSO OK IF A PAGE MARK
CAMGE T2,T1 ;OR IN CORRECT ORDER
JRST CPOPJ1
FIXBAD: CAME T1,PGMK
SKIPN T1
MOVE T1,[<ASCII /9999:/>!1] ;ONE OVER THE TOP OF THE WORLD
MOVE T2,@-1(T4) ;GET CURRENT
PUSHJ P,ASCAV ;FIND AVERAGE
CAME T2,@-1(T4) ;THERE MAY HAVE ONLY BEEN A DIF OF 1
AOS 0(P) ;SKIP RETURN
POPJ P,
SUBTTL DELETE ROUTINE
;DELETE A LINE, A NUMBER OF LINES, OR A PAGE MARK
DELETE: SETZM LOLN ;JUST AS A START
SETZM PGDELS ;NO PAGES DELETED
TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
NERROR ILC
PUSHJ P,GET2S ;GET TWO PAGE-LINE PAIRS
TRZ FL,LINSN ;FOR NOW
CAIE C,"," ;CHECK SWITCH
JRST DELT1
PUSHJ P,SCAN
MOVS T1,ACCUM
TRNE FL,IDF
CAIE T1,(<SIXBIT /Y />)
NERROR ILC
TRO FL,LINSN ;DON'T ASK
PUSHJ P,SCAN
DELT1: TRNN FL,TERMF ;CHECK FOR TERMINATOR
NERROR ILC
PUSHJ P,DELSUB ;DO SOME DELETING
SKIPN PGDELS ;NEED TO DO ORDER CHECK
JRST COMND ;NO - ALL OK
JRST ORDCHK ;YES - DO IT
;SUBROUTINE TO DELETE LINES FROM A FILE - COUNTS NUMBER OF
;PAGE MARKS DELETED IN PGDELS
DELSUB: TRNN FL,PGSN ;CHECK FOR MASSIVE DELETE
SKIPN LOLN
JRST [TRNN FL,EXTOG
TRNE FL,LINSN
JRST .+1
OUTSTR [ASCIZ /Massive delete ok? /]
PUSHJ P,CONFRM
JRST COMND ;NO:
JRST .+1] ;YES:
TRZ FL,LINSN ;NONE SEEN YET
MOVE T1,LOPG ;GET THE PAGE NUMBER
MOVEM T1,DPG
MOVE SINDEX,LOLN ;AND LINE
PUSHJ P,FIND
MOVE T2,CPG ;SEE WHERE WE ARE
CAME T2,LOPG ;IS THIS OK
NERROR NSP
SKIPN LOLN ;WANT WHOLE PAGE?
TRO FL,LINSN ;YES - SAY WE DID IT
DELSB1: PUSHJ P,ONMOV ;CHECK FOR RANGE
JRST DELEND
TRO FL,LINSN ;SEEN SOMETHING
CAMN T1,PGMK ;PAGE MARK
JRST DELPAG ;YES - DELETE PAGE
MOVEM T1,CLN ;SAVE CURRENT LINE
PUSHJ P,DODEL ;GO DO A LINE DELETE
DELSB2: PUSHJ P,FINDN1 ;FIND NEXT BUT ACCEPT LINE IF ALREADY THERE
JRST DELSB1 ;GO DO NEXT
DELPAG: MOVEI T1,2 ;SET TO DELETE PAGE
MOVEM T1,OCNT
SETZM NCNT ;NEW SIZE IS 0
PUSHJ P,INSED ;ZAP
AOS PGDELS ;INCR COUNT OF PAGES GONE
AOS CPG ;BEWARE!!!
SETZM LDELLN ;NO LINES ON THIS PAGE YET
JRST DELSB2 ;CONTINUE
DELEND: TRNN FL,LINSN ;DO ANYTHING?
NERROR NLN ;NO - GIVE ERROR
MOVE T1,LOPG ;YES - SET CURRENT PAGE
MOVEM T1,CPG ;AS THE ONE HE ASKED FOR
MOVEM T1,CPGL ;...
MOVN T1,PGDELS ;GET NEG # OF PAGES DELETED
ADDM T1,BGPG ;ADJUST CNTRS
ADDM T1,INPG ;TO SHOW CORRECT # OF PAGES
POPJ P, ;RETURN
;DELETE A PAGE MARK
KILL: SETZM LOLN ;A GOOD THING
TRNE FL,READOF
NERROR ILC
PUSHJ P,GET1S
TRZN FL,LINSN
TRNN FL,TERMF
NERROR ILC
DELPG: MOVE T1,HIPG ;GET THE DESIRED PAGE TO DELETE
MOVEM T1,DPG ;SET IT
SOJLE T1,DELER ;DO NOT TRY PAGE 1
MOVEI SINDEX,0 ;GUARENTEED TO FIND LINE IMMEDIATELY AFTER PAGE MARK
PUSHJ P,FIND ;GET IT
MOVE T2,CPG ;CHECK FOR MATCH
CAME T2,HIPG
DELER: NERROR NSP ;NO SUCH PAGE
PUSHJ P,FINDB ;GO BACK ONE
CAME T1,PGMK ;IS IT A PAGE MARK?
NERROR ICN ;CONFUSED, GIVE FATAL ERROR
MOVEI T1,2 ;COUNT IS 2
MOVEM T1,OCNT
SETZM NCNT ;AND NEW IS 0
PUSHJ P,INSED
SOS CPGL ;ONE LESS ALSO
SOS BGPG ;MAX PAGE IS NOW 1 LOWER
SOS INPG
ORDCHK: PUSHJ P,FINDN1 ;GET THE NEXT LINE
JUMPE T1,COMND ;IF EOF THERE IS NO ORDER ERROR
CAMN T1,PGMK ;OR IF A PAGE MARK
JRST COMND
MOVEM T1,SVWD3 ;SAVE IT FOR COMPARE
PUSHJ P,FINDB ;FIND THE PREVIOUS ONE
JUMPE T1,COMND ;START OF FILE, ALL OK
CAME T1,PGMK ;ANOTHER PAGE MARK
CAMGE T1,SVWD3 ;CHECK THE ORDER
JRST COMND ;ALL OK
NERROR ORDER ;ALL WRONG
SUBTTL INSERT PAGE MARK
;INSERT A PAGE MARK AT DESIGNATED LINE
MARK: SETZM HILN ;IN CASE OF /A
SKIPN BASICF ;ILLEGAL IN BASIC MODE
TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
NERROR ILC
PUSHJ P,GET1S ;GET ONE LINE/PAGE NUMBER
TRNN FL,TERMF ;CHECK FOR TERMINATOR
NERROR ILC
PUSHJ P,MARK0 ;INSERT PAGE MARK
JRST COMND ;RETURN TO COMMAND LEVEL
MARK0: MOVE T1,HIPG ;GO LOOK FOR IT
MOVEM T1,DPG
MOVE SINDEX,HILN ;AND THE LINE
PUSHJ P,FIND ;GET IT
MOVE T1,CPG
CAME T1,HIPG ;PAGE MUST MATCH
NERROR NSP ;MUST MATCH
AOS T1,CPG ;WILL BE ON HIGHER PAGE WHEN DONE
MOVEM T1,CPGL ;SET UP LOGICAL PAGE
AOS BGPG ;THERE IS NOW ONE MORE
AOS INPG
MOVE T1,[<ASCII /00100/>!1]
MOVEM T1,CLN ;FIRST LINE ON THAA PAGE
MOVE T1,PGMK ;PUT A PAGE MARK IN LIBUF
MOVEM T1,LIBUF
MOVE T1,PGMKW2 ;TEXT OF A PAGE MARK
MOVEM T1,LIBUF+1
SETZM OCNT ;THIS IS A STRAIGHT INSEET
MOVEI T1,2 ;OF 2 WORDS
MOVEM T1,NCNT
PUSHJ P,INSED ;GO DO IT
PUSHJ P,FINDN ;SINCE FILLB MAY WANT TO DUMP THIS LINE
JUMPE T1,FILLB ;SKIP IF EOF SEEN
CAME T1,PGMK ;CHECK IF EMPTY
MOVEM T1,CLN ;NO; USE THIS LINE
JRST FILLB ;FILL BUFFER
INSMK: TRNN FL,TERMF ;GRNTEE TERM
NERROR ILC
SETZM ALTSN ;NO ESC SEEN YET
MOVE T1,[<ASCII /9999:/>!1]
MOVEM T1,HILN ;ONE PAST END OF WORLD
PUSHJ P,MARK0 ;INSERT PAGE-MARK
MOVE T1,CLN ;GET CURRENT LINE
MOVEM T1,HILN
MOVE T1,CPG ;AND CURRENT PAGE
MOVEM T1,HIPG ;SET UP FOR INSERT
JRST INSGO ;GO
SUBTTL RENUMBER
;RENUMBER SELECTED LINES
NUMBER: MOVE T1,[<ASCII /00100/>!1] ;IF NO INCR IS SEEN
MOVEM T1,REINC ;WE WILL USE 100
MOVEM T1,INCST
MOVEM T1,REFST ;SAVE FOR NEW PAGE
SETZM LOLN ;GET THIS SET TO START THINGS OFF
TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
NERROR ILC
TRZ FL2,ACONST!MONOF
PUSHJ P,GNCH ;GET NEXT CHAR
MOVEM C,SAVC ;SAVE IN CASE WE NEED IT
ANDI C,137 ;FORCE UPPER
CAIN C,"A"
TRO FL2,ACONST ;ADD CONSTANT
CAIN C,"P"
TRO FL2,MONOF ;NO RESET ON PAGE MARK
TRNE FL2,ACONST!MONOF
SETZM SAVC ;GOT ONE - DON'T BACK UP SCANNER
PUSHJ P,SCAN ;GET THE RENUMBER INCREMENT
TRNE FL,NUMF ;WAS IT A NUMBER
CAMN T1,[<ASCII /00000/>!1] ;NO 0 RENUMBER INCR
JRST NUMBC ;NO NUMBER, CHECK FOR COMMA
MOVEM T1,REINC ;THE INCREMENT TO USE
MOVEM T1,INCST ;LINE TO START WITH
MOVEM T1,REFST
PUSHJ P,SCAN ;SCAN PAST NUMBER
NUMBC: CAIN C,"," ;AND CHECK FOR COMMA
JRST NUMB1 ;GET A RANGE
MOVEI T1,1 ;NO RANGE, DO WHOLE FILE
MOVEM T1,LOPG ;FROM PAGE 1
MOVSI T1,1 ;TO IMPOSSIBLY HIGH
MOVEM T1,HIPG
TRZ FL,CNTF ;MAKE SURE THIS IS OFF
JRST NUMBL ;AND CHECK FOR TERMINATOR
NUMB1: PUSHJ P,GET2S ;GET A RANGE
CAIE C,"," ;SEE IF THERE IS A FOURTH ARGUMENT
JRST NUMBL ;NO
PUSHJ P,SCAN ;YES, GET IT
TRNN FL2,ACONST ;ILLEGAL IF ADD MODE
TRNN FL,NUMF ;IS IT A NUMBER?
NERROR ILC ;HE WOULD HAVE BEEN BETTER OFF WITHOUT IT
MOVEM T1,REFST
MOVEM T1,INCST ;USS AS STARTING NUMBER
PUSHJ P,SCAN ;SCAN PAST IT
NUMBL: TRNN FL,TERMF ;ENDS PROPERLY?
NERROR ILC ;LOSE
MOVE T1,LOPG ;GET PLACE TO START
MOVEM T1,DPG
MOVE SINDEX,LOLN ;AND LINE
PUSHJ P,FIND ;GET IT
TRZ FL,LINSN!ORDF ;SET TO NONE SEEN AND NO ORDER ERROR
PUSHJ P,FINDB ;BACK UP AND SEE HOW ORDER LOOKS
JUMPE T1,NUMB5 ;START OF FILE IT MUST BE OK
CAME T1,PGMK ;ALSO IF A PAGE MARK
CAMGE T1,INCST ;OR IF IN CORRECT ORDER
SKIPA
TRO FL,ORDF ;WRONG SET FLAG
NUMB5: PUSHJ P,FIND ;GET THE CORRECT LINE BACK
NUMB2: PUSHJ P,ONMOV ;CHECK RANGE
JRST NUMB3
CAMN T1,PGMK ;PAGE MARK?
JRST NUMB4 ;SPECIAL TREATMENT
TRNE FL2,ACONST ;JUST ADD CONSTANT
JRST [MOVE T1,(PNTR) ;YES - USE OLD LINE #
TRO FL,LINSN ;SAY WE'VE SEEN ONE
JRST NUMB2A]
MOVE T1,INCST ;GET STAATING NUMBER
NUMB2A: MOVE T2,REINC ;AND INCREMENT
TRON FL,LINSN ;WAS A LINE SEEN?
JRST FSTLIN ;NO, FIRST ONE IS SPECIAL
PUSHJ P,ASCIAD ;SKIP THIS THE FFRST TIME
CAMGE T1,REINC ;HAVE WE WRAPED
JRST [RERROR WAR ;TELL HIM HE LOST
MOVE T2,CPG ;PRINT THE PAGE
PUSHJ P,PGPRN
JRST .+1] ;RETURN
FSTLIN: MOVEM T1,INCST ;SAVE FOR NEXT LINE
MOVEM T1,CLN ;AND THE CURRENT LINE
MOVEM T1,(PNTR) ;PUT IT IN
PUSHJ P,FINDN ;GET NEXT
JRST NUMB2 ;AND GO RANGE CHECK
NUMB3: TRNN FL,LINSN ;DONE, WAS THERE SOMETHING THERE?
NERROR NLN ;NO, NULL RANGE ERROR
TLO FL2,ALLCHG ;CHANGES
MOVE T2,CPG ;SET UP CURRENT PAGE
MOVEM T2,CPGL
TRNE FL,ORDF ;WAS THERE AN ORDER ERROR?
NERROR ORDER ;YES, FLAG IT
JUMPE T1,COMND ;CHECK TO SEE IF LOSAGE NOW
CAME T1,PGMK
CAMLE T1,INCST
JRST COMND
NERROR ORDER
NUMB4: ;PAGE MARK
AOS CPG ;NOW ON A HIGHER PAGE
MOVE T1,[<ASCII /00000/>!1]
MOVEM T1,CLN ;SET TO FIRST LINE ON PAGE
TRO FL,LINSN ;WE SAW ONE
PUSHJ P,FINDN ;GET NEXT LINE
PUSHJ P,ONMOV ;IN RANGE?
JRST NUMB3 ;NO - FINISHED
CAMN T1,PGMK ;ANOTHER P. M.
JRST NUMB4
MOVE T1,REFST ;FIRST LINE #
TRNN FL2,ACONST!MONOF
JRST FSTLIN ;IF NOT SPECIAL
MOVE T1,REINC ;ELSE GET INC
TRNN FL2,MONOF
SKIPA T2,(PNTR) ;CURRENT LINE FOR "NA"
MOVE T2,INCST ;ELSE LAST LINE FOR "NP"
PUSHJ P,ASCIAD ;DO ARITHMETIC
JRST FSTLIN ;STASH NUMBER
SUBTTL ALTER COMMAND
ALTER: SETZM LOLN ;FOR START OF PAGE
PUSHJ P,GET2S ;GET THE RANGE
TRNN FL,TERMF ;CHECK FOR PROPER END
NERROR ILC ;UNEND
MOVE T1,LOPG ;START TO PROCESS
MOVEM T1,DPG
MOVE SINDEX,LOLN
PUSHJ P,FIND ;GO GET IT
TRZ FL,LINSN ;NOT SEEN YET
ALT1: PUSHJ P,ONMOV ;CHECK FOR IN RANGE
JRST ALT2 ;NO, FINISH UP
TRO FL,LINSN ;WE DID SEE SOMETHING
CAMN T1,PGMK ;CHEC FOR A PAGE
JRST ALT3 ;DO NNT TRY TO CHANGE THIS
MOVEM T1,CLN ;NOW, IN CASE WE SAID ALTMODE
MOVE T1,CPG ;SAME FOR PAGE
MOVEM T1,CPGL
PUSHJ P,ALTLIN ;GO DO THE ALTER
JRST LEVINS ;HE SAID ALTMODE
PUSHJ P,INSED ;GO INSERT
ALT4: PUSHJ P,FINDN ;GET THE NEXT LINE
PUSHJ P,FILLB ;AND CHECK FOR BUFFER OVERFLOW
MOVE T1,(PNTR) ;GET LINE FOR ONMOV
JRST ALT1 ;CONTINUE LOOP
ALT3: AOS T2,CPG ;WE ARE ON A LATER PAGE NOW
MOVEM T2,CPGL ;SAVE AS .
TRNN FL2,NONUMF ;SKIP IF IN NONUMBER MODE
PUSHJ P,PGPRN ;PRINT HIM A MESSAGE
MOVE T1,[<ASCII /00000/>!1] ;SET TO FIRST? LINE
MOVEM T1,CLN ;FOR .
JRST ALT4 ;CONTINUE PAST IT
ALT2: TRNN FL,LINSN ;WAS THERE ANYTHING THERE?
NERROR NLN ;NO, GIVE ERROR
MOVE T1,CPG ;|ET CURRENT PAGEE
MOVEM T1,CPGL ;SAVE AS .
JRST COMND ;GO
ALTLIN: PUSHJ P,SETALT ;SET UP LINE FOR ALTERATION
ALTN1:
ALTLP2: MOVEI T2,0 ;ZERO REPEAT COUNT
TLZ FL,NEGF ;TURN OFF "-" SEEN FLG
ALTLP: TRZ FL2,ALTDUP ;TURN DUPLEXING BACK OFF
PUSHJ P,GNCH1 ;GET ON CHR IN DDT SUBMODE
TLNE CS,LETF_16 ;CHECK FOR LETTER
TRZ C,40 ;AND CONVERT TO UPPER CASE
MOVSI T1,-ALTLG ;GET LENGTH OF COMMAND TABLE
CAME C,ALTAB1(T1) ;CHECK FOR EQUAL
AOBJN T1,.-1 ;NO, TRY AGAIN
JUMPGE T1,[CAIN C,15 ;IGNORE CR'S
JRST ALTLP
JRST ALTBEL]
MOVE T1,ALTAB2(T1) ;GET TABLE ENTRY IN T1
JUMPL T1,ALTDSP ;"-" ALLOWED IF NEG.
TLNN FL,NEGF ;NO: IS IT SET?
JRST ALTDSP ;OK TO EXECUTE COMMAND
ALTBEL: OUTCHR [7] ;BONG A GONG
CLRBFI ;CLEAR TYPE AHEAD
JRST ALTLP2 ;TRY AGAIN
ALTDSP: TLNN T1,(1B1) ;OK IN ALL MODES?
TRNN FL,READOF ;NO -- CHECK R/O
SKIPA ;YES -- DISPATCH
JRST ALTBEL ;R/O RING BELL
PUSHJ P,0(T1) ;DISPATCH
JRST ALTLP2 ;RESET REPEAT COUNT AND GET NEW COMMAND
JRST ALTLP ;SKIP RETURN FROM DIGITS NO COUNT RESET
ALTAB1: EXP " ","I","D","S","K","Q",12
EXP "C",177,"U"-100,"W","X"
EXP "R","L","P","J","E","-",10,11
EXP "0","1","2","3","4","5","6","7","8","9","0"
ALTLG=.-ALTAB1
ALTAB2: EXP <1B1+ALTSP>,ALTIN
EXP <1B0+ALTDL>,<3B1+ALTSR>,<1B0+ALTKL>
EXP <1B1+ALTALT>,<1B1+ALTFN>,ALTCN
EXP <1B1+ALTBS>,<1B1+ALTCU>,<1B1+ALTWD>,ALTWX,<1B0+ALTRP>
EXP <1B1+ALTLN>,<1B1+APRINT>,AJOIN,<1B1+ALTEX>
EXP <1B1+ALTNEG>,<1B1+ALTBS>,<3B1+ALTTB>
REPEAT ^D10,<<3B1+ALTDG>>
ALTNEG: TLO FL,NEGF
JRST CPOPJ1
SETALT: SETZM LIBUF ;ZERO OUT INTERNAL LINE BUFFER
MOVE T1,[XWD LIBUF,LIBUF+1]
BLT T1,LIBUF+MXWPL+1
MOVEI T1,LIBUF ;SET POINTER TO TRANSFER
MOVE T2,PNTR
MOVE T3,(T2) ;GET THE FIRST WORD (SEQ NUM)
JRST SALT3
SALT2: SKIPE T3,(T2) ;PICK UP A WORD AND CHECK FOR 0
TRNE T3,1 ;CHECK FOR SEQ NTM
JRST SALT1 ;END OF THIS LINE
SALT3: MOVEM T3,(T1) ;SAVE IT AWAY
ADDI T1,1 ;INCREMENT POINTERS
AOJA T2,SALT2
SALT1: MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET UP POINTER
SETZM ALTCNT ;SO FAR WE ARE 0 CHRS INTO LINE
SUBI T1,LIBUF ;GET COUNT OF OLD LINE
HRRZM T1,OCNT ;AND SAVE IT FOR INSED
OFFECHO ;TURN OFF EHCO
TRZ FL2,RUBF!ALTDUP!RUBF2 ;TURN OFF IN RUBOUT FALG AND NO DUPLEXING
SETZM ALTFLG ;NOTHING INSERTED SO FAR
TRNE FL2,NONUMF ;SKIP IF NORMAL
POPJ P, ;ELSE RETURN
MOVE T1,LIBUF ;PRINT LINE NUMBER AND TAB
JRST OUTSN
RPSALT=SALT1
DEFINE OFFRUB
< TRZE FL2,RUBF2
OUTSTR [ASCIZ /\\/]
TRZE FL2,RUBF
OUTCHR ["\"]>
DEFINE ONRUB
< TRZE FL2,RUBF2
OUTSTR [ASCII /\\/]
TRON FL2,RUBF
OUTCHR ["\"]>
GNCH1A: TRNE FL2,COMFLF ;CMD FILE?
JRST [PUSHJ P,RDCHAR
JRST GNCH1C]
INCHRW C
ANDI C,177
GNCH1C: CAME C,ESC ;NEVER DUPLEX ESC
TRNN FL2,ALTDUP ;AND NOT UNLESS DESIRED
POPJ P,
CAIE C,12 ;NOT LINE FEED
CAIN C,15 ;OR RETURN
POPJ P,
CAIN C,177 ;AND FINALLY IGNORE RUBOUT
POPJ P,
OFFRUB ;IF WE ARE DUPLEXING WE ARE NOT DELETING
OUTCHR C ;TYPE
POPJ P,
GNCH1: PUSHJ P,GNCH1A ;GET A CHR IN DDT MODE
CAMN C,ESC ;CONVERT ALTMODE TO 200
MOVEI C,200
TLNN FL,QMODF
CAIE C,"'" ;CHECK FOR QUOTE
JRST GNCH1B ;NO, THIS CHR IS OK
PUSHJ P,GNCH1A ;GET ANOTHER
SKIPE CTBL(C) ;IF 0 HN CTBL, KEEP IT
MOVS C,CTBL(C) ;GET ALTERNATE CODE
ANDI C,177 ;GET RID OF EXTRA BITS
GNCH1B: MOVE CS,CTBL(C) ;LOAD CS
TLNE CS,LETF_16 ;CHECK FOR LETTER
TDC C,CASEBT ;AND APPLY CASE CONVERRION
POPJ P, ;ALL DONE
ALTDG: IMULI T2,^D10 ;ACCUMULATE REPEAT COUNT
ADDI T2,-"0"(C)
JRST CPOPJ1 ;SKIP RETURN SO AT NOT TO 0 RPT. CNT.
ALTTB: MOVEI T2,^D1000 ;LOTS OF SPACES
ALTSP: TLNE FL,NEGF ;CHECK BACKWARDS
JRST ALTBS ;YES: BACK SPACE
OFFRUB
ALTSP2: LDB C,ALTP ;GET THE CHR WE ARE POINTING AT
CAIN C,15 ;IF RETURN THEN AS FAR AS CAN GO
JRST ALTSP1 ;SO QUIT
TRNN FL2,SUPN ;SPECIAL HACK FOR XTEND
PUSHJ P,OCHR ;PRINT IT
IBP ALTP ;ADVANCE POINTER
AOS ALTCNT ;AND COUNT
SOJG T2,ALTSP2 ;DO CORRECT NUMBER OF TIMES
ALTSP1: TRNN FL2,SUPN
PUSHJ P,FORCE ;DUMP IT
POPJ P,
ALTIN: TRO FL2,ALTDUP ;TURN ON DUPLEXING
MOVEM T2,ALTINC ;SAVE IN CASE HE INSERTS A RETURN
ALTIN1: PUSHJ P,GNCH1 ;GET A CHARACTER
CAIN C,15 ;FINISH ON CR
JRST ALTFNZ
CAIN C,12
JRST INSCR ;GO INSERT A CRLF
CAIN C,200 ;FINISH ON ALTMODE
POPJ P, ;GO AWAY
CAIN C,177 ;CHECK FOR BACKSPACE
JRST ALTIBS ;AND DELETE CHR TO LEFT
MOVE T3,ALTP ;GET SET TO SHIFT THINGS
PUSH P,ALTCNT ;SAVE THIS FOR LATER
LDB T1,T3 ;GET CHR FROM LINE
ALTIN2: DPB C,T3 ;SHIFT LINE
JUMPE C,ALTIN3 ;DONE
AOS ALTCNT ;COUNT IT
ILDB C,T3
DPB T1,T3
JUMPE T1,ALTIN3 ;DONE
AOS ALTCNT ;COUNT
ILDB T1,T3
JRST ALTIN2
ALTIN3: MOVE T2,ALTCNT ;SEE IF OVERFLOW HAPPENED
CAIL T2,MXWPL*5
NERROR LTL ;YES
POP P,ALTCNT ;RESTORE OLD COUNT
IBP ALTP ;ADVANCE POINTER
AOS ALTCNT ;AND COUNT
JRST ALTIN1 ;GO GET MORE
INSCR: OFFRUB
OCRLF
SKIPN T1,ALTINC ;DID HE SPECIFY AN INCREMENT?
SKIPA T3,INCR ;NO, USE STANDARD
PUSHJ P,ASCON ;CONVERT TO ASCII
MOVE T1,T3 ;FIND THE NEW LINE NUMBER
MOVE T2,LIBUF ;CURRENT ONE
PUSHJ P,FIXLIN
EXP LIBUF
JRST [RERROR ORDER
PUSHJ P,FINDB ;GET BACK WHERE WE BELONG
PUSHJ P,ERCOR ;TYPE OUT LINE TO CURRENT POINT
JRST ALTIN1] ;AND CONTINUE INSERT
MOVEM T2,LIBUF2 ;SAVE IT
MOVEM T2,CLN ;AND SET AS CURRENT LINE
PUSHJ P,FINDB ;BACK UP TO WHERE WE BELONG
MOVE T1,[XWD LIBUF+1,LIBUF2+1]
BLT T1,LIBUF2+MXWPL+1 ;SAVE OLD BUFFER
PUSH P,ALTP ;SAVE POINTER
MOVEI C,15
DPB C,ALTP ;AND TERMINATE THIS LINE
MOVEI C,12
IDPB C,ALTP
MOVEI C,0 ;FILL OUT LINE WITH NULLS
AINSC2: TLNN ALTP,760000
JRST AINSC3
IDPB C,ALTP
JRST AINSC2
AINSC3: SUBI ALTP,LIBUF-1 ;FIND COUNT
HRRZM ALTP,NCNT
PUSHJ P,INSED ;REPLACE OLD LINE
PUSHJ P,FINDN ;MOVE UP TO NEXT
PUSHJ P,FILLB ;AND DUMP IF OVERFLOW
SETZM OCNT ;THIS IS A NEW LINE GOING IN
MOVE T1,LIBUF2 ;MOVE LINE NUMBER OVER
MOVEM T1,LIBUF
SETZM LIBUF+1
MOVE T1,[XWD LIBUF+1,LIBUF+2]
BLT T1,LIBUF+MXWPL+1 ;ZERO OUT REST
POP P,T2 ;RESTORE POINTER TO REST OF LINE
MOVE ALTP,[POINT 7,LIBUF+1] ;DEST POINTER
ADD T2,[XWD 70000,LIBUF2-LIBUF] ;ADJUST INPUT POINTER
MOVEI C,11 ;AND SET UP THE TAB
MOVNEW: IDPB C,ALTP
CAIN C,12
JRST DONNEW ;FINISHED MOVING REST OF LINE
ILDB C,T2 ;PICK UP ONE
JRST MOVNEW
DONNEW: SUBI ALTP,LIBUF ;GET COUNT
MOVEI ALTP,1(ALTP) ;USED TO BE - MOVEI AC,1-LIBUF(AC)
MOVEM ALTP,NCNT
PUSH P,ALTP ;AND SAVE
PUSHJ P,INSED ;INSERT
MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET UP FOR ALTER
SETZM ALTCNT
POP P,OCNT ;SET FOR OLD COUNT
MOVE T1,LIBUF
TRNN FL2,NONUMF ;SKIP IF NOT PRINTING
PUSHJ P,OUTSN
SETOM ALTFLG ;WE HAVE INSERTED AND ALTALT SHOULD CALL FILLB
JRST ALTIN1 ;AND CONTINUE INSERTING
ALTIBS: MOVEI T2,0 ;SET COUNT TO 0
MOVEM ALTP,SVALTP ;SAVE POINTER
PUSHJ P,ALTBS ;DO A BACKSPACE
EXCH ALTP,SVALTP ;GET BACK AND SAVE CURRENT
PUSHJ P,ALTDL3 ;DELETE THAT CHR
JRST ALTIN1 ;GET MORE
ALTDL: TLNE FL,NEGF ;BACKWARDS?
JRST ALTBDL ;YES:
MOVEM ALTP,SVALTP ;SAVE CURRENT POINTER POSITHON
ALTDL1: LDB C,ALTP ;GET CURRENT CHR
CAIN C,15 ;AT END OF LINE?
JRST ALTDL5 ;YES, GO FINISH OFF
TRNN FL,EXTOG ;PRINT ONLY IF NON-EXPERT
PUSHJ P,ALTDPN ;YES: PRINT CHAR
IBP ALTP ;ADVANCE POINTER
SOJG T2,ALTDL1 ;CHECK COUNT AND CONTINUE
ALTDL5: PUSHJ P,FORCE ;FORCE OUTPUT
ALTDL3: MOVE T3,SVALTP ;GET BACK POINTER
ALTDL4: LDB C,ALTP ;MOVE LINE DOWN
DPB C,T3
JUMPE C,ALTDL2 ;DONE?
IBP ALTP ;ADVANCE POINTERS
IBP T3
JRST ALTDL4
ALTDL2: MOVE ALTP,SVALTP ;RESTORE POINTER AGAIN
POPJ P, ;AND LEAVE
APRINT: PUSH P,ALTCNT ;SAVE CURRENT COUNT
PUSHJ P,ALTLN ;PRINT REST OF LINE AND START OVER
POP P,T2 ;GET BACK COUNT
CAILE T2,0 ;AND SPACE IF NOT 0
JRST ALTSP
POPJ P,
ALTDPN: PUSH P,C
MOVEI C,"\"
TRNN FL2,RUBF2
PUSHJ P,OCHR
TRZE FL2,RUBF
PUSHJ P,OCHR
TRON FL2,RUBF2
PUSHJ P,OCHR
POP P,C
JRST OCHR
ALTSR: OFFRUB
PUSHJ P,GNCH1 ;GET THE CHARACTER TO SEARCH FOR
ALTSR1: PUSH P,T2 ;SAVE NUMBER OF TIMES TO SEARCH
PUSHJ P,ALTCS ;CALL COMMON SEARCH ROUTINE
PUSH P,C ;SAVE THE CHARACTER
PUSHJ P,ALTSP ;GO SPACE CORRECT NUMBER
POP P,C ;RESTORE CHR
POP P,T2 ;AND COUNT
SOJG T2,ALTSR1 ;CONTINUE
POPJ P,
ALTCS: MOVEI T2,1 ;CREATE A REPEAT COUNT
TLNE FL,NEGF ;BACKWARDS?
JRST ALTBCS ;YES: SEARCH BACKWARDS
LDB T3,ALTP ;CHEC TO SEE IF AT END OF LINE
CAIN T3,15
POPJ P,
MOVE T1,ALTP ;GET A COPY OF THE POINTER
ALTCS1: ILDB T3,T1 ;GET A CHARACTER
CAIE T3,15 ;DONE IF END OF LINE
CAMN T3,C ;OR A MATCH
POPJ P,
AOJA T2,ALTCS1 ;ELSE KEEP COUNT AND KEEP LOOKING
ALTKL: PUSHJ P,GNCH1 ;ALMOST LINE ALTSR
ALTKL1: PUSH P,T2
PUSHJ P,ALTCS
CAIE T3,0 ;OFF FRONT END - SKIP
CAIN T3,15 ;BUT GIVE UP IF CHR NOT FOUND
JRST T2POPJ
PUSH P,C
PUSHJ P,ALTDL ;DELETE THAT NUMBER
POP P,C
POP P,T2
SOJG T2,ALTKL1
POPJ P,
T2POPJ: POP P,T2 ;NEED TO CLEAR STACK
POPJ P,
ALTALT: OFFRUB
SKIPN ALTFLG ;SHOULD WE DO A FILLB?
JRST ALTAL1
PUSHJ P,FINDN
PUSHJ P,FILLB ;YES, WE HAVE INSERTED SOMETHING
ALTAL1:
ONECHO ;DUMPLEXING BACK ON
JRST T1POPJ ;AND RETURN
ALTFNZ:
PUSHJ P,GNCH1
ALTFN:
MOVEI T2,MXWPL*5+100 ;FINISH UP LINE
PUSHJ P,ALTSP ;BY PRINTING A LARGE NUMBER OF SPCAES
ALTFNX:
OCRLF
ONECHO ;GET OUT OF NON-DUPLEX MODE
ALTFN1: ILDB C,ALTP ;LOOK ONE CHR OVER
CAIE C,12 ;THIS SHOULD BE THE LINE FEED
NERROR ILFMT ;SOMETHING IS WRONG
MOVEI C,0 ;ZERO REMAINDER OF LINE
ALTFN2: TLNN ALTP,760000 ;ALL DONE?
JRST ALTFN3 ;YES
IDPB C,ALTP ;NO, PUT IN ANOTHER 0
JRST ALTFN2
ALTFN3: SUBI ALTP,LIBUF-1 ;GET SIZE OF NEW LINE
HRRZM ALTP,NCNT ;AND SAVE FOR INSED
AOS -1(P) ;SET FOR SKIP RETURN
JRST T1POPJ ;RETURN TO CALLER OF ALTLIN
ALTCU: OFFRUB
OUTSTR [ASCIZ /^U
/]
JRST SETALT ;GO RESTART LINE AND FORGET EDIT SO FAR
ALTRP: PUSHJ P,ALTDL ;REPLACE IS DELETE THEN INSERT
TLZ FL,NEGF
MOVEI T2,0
JRST ALTIN
ALTCN: OFFRUB
TRO FL2,ALTDUP ;TURN ON DUPLEXING
ALTCN2: LDB C,ALTP ;AT END OF LINE?
CAIN C,15
POPJ P, ;YES, STOP
ALTCN1: PUSHJ P,GNCH1 ;GET A CHARACTER
CAIE C,177 ;DO NOT LET HIM INSERT A RUBOUT
CAIN C,15 ;IGNORE CRET
JRST ALTCN1
CAIE C,200 ;STOP ON ALTMODE AND LINE FEED
CAIN C,12
POPJ P,
DPB C,ALTP ;REPLACE IT
IBP ALTP ;ADVANCE POINTER
AOS ALTCNT ;AND COUNT
SOJG T2,ALTCN2 ;CONTINUE
POPJ P,
ALTEX: OFFRUB
ALTEX1: LDB C,ALTP
CAIN C,15
JRST ALTFNX
IBP ALTP
AOS ALTCNT
JRST ALTEX1
AJOIN: OFFRUB
PUSHJ P,FINDN ;GO SEE IF NEXT LINE IS REALLY THERE
CAME T1,PGMK
SKIPN T1
JRST ILCER ;MAKE IT ILLEGAL IF NO LINE THERE
MOVEM T1,LIBUF2 ;SAVE ITS NUMBER
SETZM LIBUF2+1
MOVE T1,[XWD LIBUF2+1,LIBUF2+2]
BLT T1,LIBUF2+MXWPL+1 ;CLEAR OUT REST OF BUFFER
PUSH P,ALTP ;SAVE POINTER TO THIS LINE
ADD ALTP,[XWD 70000,0] ;BACK IT UP
MOVE T2,[POINT 7,LIBUF2+1]
MOVEI C,11
MOVEI T1,6 ;COUNT THE CHARACTERS
MOVLIN: IDPB C,T2
ILDB C,ALTP
CAIE C,15 ;END OF LINE?
AOJA T1,MOVLIN ;KEEP COUNT
MOVEI ALTP,1(PNTR) ;GET POINTER TO SECOND LINE
HRLI ALTP,(<POINT 7,0,6>)
ATRN1: ILDB C,ALTP
IDPB C,T2
ADDI T1,1
CAIL T1,MXWPL*5+6 ;CHECK SIZE
JRST LTLER
CAIE C,12
JRST ATRN1 ;NOT DONE YET
EXCH T2,(P) ;SAVE OUTPUT POINTER AND GET OLD ALTP BACK
SUBI ALTP,-1(PNTR) ;GET OLD COUNT OF SECOND LINE
PUSH P,ALTP ;AND SAVE IT
MOVEI C,15 ;FINISH CURRENT LINE
DPB C,T2
MOVEI C,12
IDPB C,T2
MOVEI C,0
INSC2: TLNN T2,760000
JRST INSC3 ;FILL WITH NULLS
IDPB C,T2
JRST INSC2
INSC3: SUBI T2,LIBUF-1 ;GET COUNT
HRRZM T2,NCNT
PUSHJ P,FINDB ;BACK UP TO POINT TO IT
PUSHJ P,INSED
PUSHJ P,FINDN
PUSHJ P,FILLB
POP P,OCNT ;OLD CONT
HRRZS OCNT
POP P,ALTP ;GET OUTPUT POINTER BACK
SUBI ALTP,LIBUF2-1
HRRZM ALTP,NCNT
MOVE T1,[XWD LIBUF2,LIBUF]
BLT T1,LIBUF+MXWPL+1
PUSHJ P,INSED
SETOM ALTFLG ;MARK AS NEED TO DO FILLB
MOVE T1,NCNT ;GET THE COUNT JUST USED
MOVEM T1,OCNT ;AND SET AS THE OLD COUNT
MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET UP
SETZM ALTCNT
OCRLF
MOVE T1,LIBUF
MOVEM T1,CLN ;SET UP CURRENT LINE
TRNE FL2,NONUMF ;SKIP IF NORMAL
POPJ P,
JRST OUTSN ;AND PRINT NUMBER
LTLER: RERROR LTL
POP P,ALTP ;RESTORE ALTP
SKIPA
ILCER: RERROR NNN
PUSHJ P,FINDB ;MOVE BACK TO RIGHT PLACE
ERCOR: PUSH P,ALTCNT ;SAVE COUNT
SETZM ALTCNT
MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET BACK TO START
PUSHJ P,ALTCBS ;PRINT LINE NUMBER
POP P,T2 ;COUNT
JUMPN T2,ALTSP ;AND SPACE OVER
POPJ P, ;NO SPACES TO DO
ALTWD: OFFRUB
ALTWD1: PUSH P,T2 ;SAVE COUNT IF ANY
PUSHJ P,ALTWS ;SKIP OVER WORD
ANDI T2,-1 ;CLR FLAG IN CASE
PUSHJ P,ALTSP ;SPACE CORRECTLY
POP P,T2 ;RESTORE COUNT
SOJG T2,ALTWD1 ;CONTINUE
;ROUTINE TO SKIP OVER NEXT WORD
ALTWS: HRROI T2,0 ;SET FLG AND COUNT
MOVE T1,ALTP ;GET POINTER
LDB T3,T1 ;AND FIRST CHAR
JRST .+2 ;CHECK FOR CR & GO
ALTWS1: ILDB T3,T1 ;GET A CHARACTER
CAIN T3,15 ;DONE IF END OF LINE
ALTWS2: POPJ P,
MOVE T3,CTBL(T3);FETCH CHARATER TABLE ENTRY
JUMPE T3,ALTWS4 ;SKIP BLANKS ETC...
ANDI T2,-1 ;CLR FLAG
JUMPG T3,ALTWS3 ;SKIP LETTERS & NUMBERS
TRNN FL2,QSEPF ;SEPARATORS
TRNN T3,NSEPF ;TODAY
POPJ P, ;REAL BREAK - QUIT!
ALTWS3: AOJA T2,ALTWS1 ;KEEP COUNT AND CONTINUE
ALTWS4: JUMPL T2,ALTWS3 ;FIRST BLNKS
AOS T2
ALTWS5: ILDB T3,T1
CAIE T3,15 ;QUIT ON CR
SKIPE CTBL(T3) ;OR FIRST NON-BLANK
POPJ P,
AOJA T2,ALTWS5
ALTWX: PUSHJ P,ALTWS ;SKIP WORD
ANDI T2,-1 ;CLR FLAG
PUSHJ P,ALTDL ;DELETE CHARS
MOVEI T2,0
JRST ALTIN ;DO INSERT
ALTBS: PUSHJ P,ALTBAK ;GET PREVIOUS CHAR
JUMPE T3,ALTCBS ;JUMP IF DONE
ONRUB
MOVE C,T3
PUSHJ P,OCHR
SOS ALTCNT ;DECREASE COUNT
SOJG T2,ALTBS ;MORE,MORE
PUSHJ P,FORCE
POPJ P,
ALTCBS: PUSHJ P,FORCE ;FINISH BUFFER
OFFRUB ;NO MORE RUB
OCRLF
TRNE FL2,NONUMF ;MORE NONUMBER STUFF
POPJ P,
MOVE T1,LIBUF ;ALSO PRINT SEQ NUM
JRST OUTSN
ALTLN: MOVEI T2,1000 ;FINISH PRINTING THE LINE
PUSHJ P,ALTSP
MOVE ALTP,[POINT 7,LIBUF+1,13] ;POINTER TO START
SETZM ALTCNT ;RESET COUNT
JRST ALTCBS ;AND PRETEND A BACKSPACE
;COMMON ROUTINES TO MAKE LINE BACKUP
ALTBAK: CAMN ALTP,[POINT 7,LIBUF+1,13]
JRST ALTRTZ ;RETURN ZERO IF AT BEGINNING
ADD ALTP,[POINT 0,0,28]
TLNE ALTP,(<1B0>) ;CHECK WORD OVERFLOW
SUB ALTP,[POINT 0,1,0]
LDB T3,ALTP ;GET CHAR
POPJ P,
ALTRTZ: MOVEI T3,0 ;RETURN 0
POPJ P,
ALTBCS: PUSH P,ALTP ;SAVE PNTR
ALTBC1: PUSHJ P,ALTBAK ;PREV CHAR
JUMPE T3,APOPJ ;END OF LINE
CAMN T3,C ;MATCH?
JRST APOPJ ;YES: RETURN
AOJA T2,ALTBC1 ;NO: COUNT AND CONTINUE
APOPJ: POP P,ALTP ;RESTORE PNTR
POPJ P, ;RETURN
ALTBDL: MOVEM ALTP,SVALTP ;SAVE PNTR
ALTBD1: PUSHJ P,ALTBAK ;BACK A CHAR
JUMPE T3,ALTBD2 ;DONE IF NO MORE
MOVE C,T3 ;FOR PRINTING
TRNN FL,EXTOG ;PRINT IF NON-EXPERT
PUSHJ P,ALTDPN
SOJG T2,ALTBD1
ALTBD2: PUSHJ P,FORCE ;FORCE PRINTING
PUSH P,ALTP ;SAVE NEW PNTR
MOVE T3,SVALTP ;GET SET TO MOVE LINE
ALTBD3: LDB C,T3
DPB C,ALTP ;MOVE CHAR
JUMPE C,APOPJ ;DONE IF ZERO
IBP T3 ;ADVANCE PNTRS
IBP ALTP
JRST ALTBD3
SUBTTL THE _ COMMAND
SET: PUSHJ P,SCAN ;GET THE THING TO SET TO
TRNN FL,IDF ;MUST BE AN IDENT
NERROR ILC
PUSHJ P,DOSET ;CALL SUBROUTINE TO DO SET COMMAND
NERROR ILC ;ERROR RETURN
JRST COMND ;OK RETURN
DOSET: PUSHJ P,XCODE ;FETCH DISPATCH ARG
TLZ T1,477777 ;CLEAR GIVE ADDRS
PUSH P,T1 ;SAVE DISPATCH
TLNN FL2,INPARS ;SKIP TERM CHECK IF PARSE
PUSHJ P,SCAN ;AND CHECK FOR TERMINATOR
CAIE C,":" ;COLON OK ALSO
CAIN C,"=" ;IS IT AN =?
JRST SETVAR ;YES: SET SOMETHING
POP P,T1 ;GET DISPATCH ADDR
TLNN T1,(1B1) ;BETTER NOT REQUIRE ARG
PUSHJ P,CKTERM ;CHECK LEGAL TERM
POPJ P,
HRRZ T1,T1
JUMPE T1,CPOPJ
PUSHJ P,0(T1) ;DO ROUTINE
JRST CPOPJ1 ;GIVE OK RETURN
SETM33: TRZA FL,M37F!DPYF ;MODEL 33
SETM37: TRO FL,M37F
POPJ P,
CLRSEQ: TDZA T1,T1
SETSEQ: MOVNI T1,1
MOVEM T1,UNSEQF
POPJ P,
SETBAS: TLNN FL2,INPARS ;ILLEGAL IF NOT INITIAL
NERROR ILC
SETOM BASICF
POPJ P,
SETRED: TLNN FL2,INPARS ;ILLEAGL IF NOT INITIAL
NERROR ILC
TRO FL,READOF
POPJ P,
SETDPY: TRO FL,DPYF ;SET TO A DISPLAY
POPJ P,
QON: TLZA FL,QMODF
QOFF: TLO FL,QMODF
POPJ P,
SETDCD: TLOA FL2,PDECID
CLRDCD: TLZ FL2,PDECID
POPJ P,
SETOLD: MOVEI T1,1
JRST STOBAK
CLRBAK: TDZA T1,T1
SETBAK: MOVNI T1,1
STOBAK: MOVEM T1,BAKF
POPJ P,
QSON: TROA FL2,QSEPF
QSOFF: TRZ FL2,QSEPF
POPJ P,
SETCHK: TLOA FL2,DSKCK
CLRCHK: TLZ FL2,DSKCK
POPJ P,
SETNOV: TRZA FL,EXTOG
SETEXP: TRO FL,EXTOG
POPJ P,
SETUPP: TDZA T1,T1
SETLOW: MOVEI T1,40
MOVEM T1,CASEBT
POPJ P,
SETNUM: TRZA FL2,NONUMF
CLRNUM: TRO FL2,NONUMF
POPJ P,
CLRZAP: TDZA T1,T1
SETZAP: MOVNI T1,1
MOVEM T1,DELETF
POPJ P,
SETVAR: TLNN FL2,INPARS
JRST SETV0 ;SKIP OVER EXTRA IF NOT PARSE
TRZ FL,F.LAHD ;CLEAR LOOK-AHEAD
SETZM SAVCHR ;...
SETZM SAVC ;...
SETV0: PUSHJ P,SCAN ;GET AN ARG
MOVE T3,0(P) ;GET WHAT TO DO
TLNN T3,(1B1) ;NEED ARG
JRST SETV2 ;NO: ERROR
TLNN T3,(1B2) ;NEED NUMERIC ARG?
JRST SETV1 ;NO: JUST DISPATCH
TRNN FL,NUMF ;YES: IS IT?
JRST SETV2 ;NOPE - LOSE
TLNE FL2,INPARS
JRST SETV1 ;SKIP TERM CHECK IN PARSE
PUSH P,T2 ;SAVE IT
PUSH P,T1 ;IN BINARY AND ASCII
PUSHJ P,SCAN ;CHECK FOR TERMINATOR
POP P,T1 ;GET BACK ASCID
POP P,T2 ;BINARY
PUSHJ P,CKTERM ;WHICH HAD BETTER BE THERE
JRST SETV2
SETV1: POP P,T3 ;GET DISPATCH
HRRZ T3,T3
JUMPE T3,CPOPJ
PUSHJ P,0(T3) ;DISPATCH
JRST CPOPJ1 ;AND RETURN TO CMD LOOP
SETV2: POP P,0(P) ;PRUNE PDL
POPJ P, ;AND GIVE ERROR RETURN
SETPLN: MOVEM T2,PLINES ;PLINES FOR P
POPJ P,
SETRMR: MOVEM T2,RMAR ;RIGHT MARGIN FOR JUSTIFY
POPJ P,
SETLMR: MOVEM T2,LMAR ;LEFT MARGIN
POPJ P,
SETPMR: MOVEM T2,PMAR ;PARAGRAPH MARGIN
POPJ P,
SETINC: MOVEM T1,INCR ;PERM INCREMENT
MOVEM T1,TECINC ;SETUP OTHER INCR
POPJ P,
SETMLN: MOVEM T1,MAXLN ;MAXIMUM LINE NUMBER
POPJ P,
SETSAV: MOVEM T2,SSAVEN ;STORE IN RESET PLACE TOO
MOVEM T2,SAVEN
POPJ P,
SETISV: MOVEM T2,SISAVN
MOVEM T2,ISAVEN
POPJ P,
SETLEN: MOVEM T2,PAGESZ
POPJ P,
SETNM1: PUSHJ P,READN0 ;GET A FILE SPEC
POPJ P, ;ERROR RETURN
SKIPN RSW ;ERROR IF SWITCHES SEEN
SKIPE SSW
POPJ P,
PUSHJ P,CKTERM ;GRNTEE EOL
POPJ P, ;NOPE
JRST CPOPJ1 ;YEP
SETNAM: PUSHJ P,SETNM1 ;GET FILE SPEC , CHECK ERRORS
NERROR ILC
SKIPE TMPDEV ;DEVICES ILLEGAL
NERROR ILC
MOVE T1,[TMPBLK,,NEWBLK]
BLT T1,NEWBKE ;SET UP NEW BLOCK
POPJ P, ;RETURN
SETRUN: PUSHJ P,SETNM1 ;GET FILE SPEC - CHECK ERRORS
NERROR ILC
SKIPN T1,TMPDEV ;SEE IF DEVICE SPECIFIED
MOVSI T1,'SYS' ;NO: USE SYS
MOVEM T1,TMPDEV ;SAVE IT
MOVE T1,[TMPBLK,,RUNBLK]
BLT T1,RUNBKE ;SET UP FILE ARGS FOR RUN UUO
POPJ P, ;RETURN
;ROUTINE TO CHECK PROPER TERMINATION
CKTERM: TLNE FL2,INOPTF ;CHECK IF OPTION FILE
JRST CKTRM1
TLNE FL2,INPARS ;SEE IF CMD STRING
JRST CPOPJ1 ;ALWAYS SAY PROPER TERM - PARSE WILL CHECK
CKTRM0: TRNE FL,TERMF ;PROPER LINE TERM?
AOS (P) ;YES
POPJ P, ;NON-SKIP IF NO
CKTRM1: CAIE C,"/" ;ALLOW SPECIAL CHARS
CAIN C,"," ;IF IN OPTION FILE
JRST CPOPJ1
CAIN C,"-" ;IF NO SPEC CHRS FOUND
JRST CPOPJ1
JRST CKTRM0 ;ALSO CHECK EOL
;HANDLE OPTION FILES
SETOPT: TRNE FL,IDF ;CHECK FOR IDENT
SKIPN T1,ACCUM ;AND NON-ZERO ATOM
NERROR ILC
MOVEM T1,OPTION ;SET UP OPTION
TLNE FL2,INPARS ;INITIAL
JRST OPTSWT ;YES: USE SPECIIAL ROUTINE
PUSHJ P,SCAN ;CHECK TERM
PUSHJ P,CKTERM
NERROR ILC ;LOSE
PUSHJ P,DOOPT
JRST SETOP1 ;NOT FOUND
JRST SETOP2 ;GROSS ERROR
POPJ P, ;OK RETURN
SETOP1: OUTSTR [ASCIZ /? Option not found
/]
POPJ P,
SETOP2: OUTSTR [ASCIZ /? Syntax error in option file
/]
POPJ P,
SETSTP: MOVEM T1,TECINC ;SET UP INCRS
MOVEM T1,INCR
POPJ P,
SETFST: MOVEM T1,TECFST ;SET UP START
POPJ P,
SUBTTL = COMMAND
GIVE: PUSHJ P,SCAN ;FIND OUT WHAT HE WANTS TO KNOW
CAIN C,"." ;CURRENT LINE/PAGE?
JRST GVDOT ;YES
TRNN FL,IDF ;IF NOT, MUST BE AN IDENT
NERROR ILC
PUSHJ P,XCODE ;FETCH ACTUAL SIXBIT ARG
HLRZ T1,T1 ;GET GIVE ADDRS
TRZ T1,3B20 ;CLEAR FUNNY BITS
JUMPE T1,XERR
PUSH P,T1 ;SAVE DISPATCH
PUSHJ P,SCAN ;CHECK FOR TERM
TRNN FL,TERMF
NERROR ILC
POP P,T1 ;NOW FIND OUT WHAT HE WANTS
PUSHJ P,0(T1) ;GIV INFO
JRST COMND ;AND RETURN
GIVBIG: TRNE FL,BGSN ;HAVE WE SEEN THAT PAGE
JRST GVBG1 ;YES, ALL IS OK
MOVSI T1,1 ;WILL HAVE TO SEARCH FOR IT
MOVEM T1,DPG
MOVEI SINDEX,0
PUSHJ P,FIND
TRNN FL,BGSN ;SHOULD HAVE SEEN IT NOW
ERROR ICN ;WE ARE IN TROUBLE
GVBG1: MOVE T1,BGPG ;GET IT
GIV2: MOVEI T3,OCHR ;ROUTINE FOR DECIMAL PRINTER TO OUTPUT TO
PUSHJ P,DECPR ;PRINT DECIMAL
GIV3: PUSHJ P,FORCE ;FORCE OUTPUT
GIV1:
OCRLF
POPJ P,
GVCASE:
TRNE FL,DPYF
OUTSTR [ASCIZ /Display /]
TRNE FL,M37F
OUTSTR [ASCIZ /Model 37 /]
TLNE FL,QMODF
OUTSTR [ASCIZ /C64 /]
TRNE FL2,QSEPF
OUTSTR [ASCIZ /Separators /]
MOVEI T1,[ASCIZ /Lower
/]
SKIPN CASEBT
MOVEI T1,[ASCIZ /Upper
/]
;PRINT CURRENT CASE
OUTSTR @T1
POPJ P,
GIVER: SKIPN T1,SVERN
POPJ P,
OUTSTR @ETBL2-1(T1)
POPJ P,
GVRM: MOVE T1,RMAR ;RIGHT MARGIN
JRST GIV2
GVMLN: MOVE T1,MAXLN ;MAXIMUM LINE NUMBER
PUSHJ P,OUTSN
JRST GIV1
GVLM: MOVE T1,LMAR ;LEFT MARGIN
JRST GIV2
GVPM: MOVE T1,PMAR ;PARAGRAPH LEFT MARGIN
JRST GIV2
GVPG: MOVE T1,PAGESZ
JRST GIV2
GVPLN: MOVE T1,PLINES
JRST GIV2
GVSAV: SKIPGE T1,SAVEN ;SAVE LEFT
MOVEI T1,0
JRST GIV2
GVISAV: SKIPGE T1,ISAVEN ;ISAVE LEFT
MOVEI T1,0
JRST GIV2
GIVDSK: PUSHJ P,TELSPC
POPJ P,
GIVCHK: TLNN FL2,DSKCK
OUTSTR [ASCIZ "No "]
OUTSTR [ASCIZ "disk check
"]
POPJ P,
GIVDCD: TLNN FL2,PDECID
OUTSTR [ASCIZ "No "]
OUTSTR [ASCIZ "auto decide
"]
POPJ P,
GIVBAK: SKIPN BAKF
OUTSTR [ASCIZ "No "]
OUTSTR [ASCIZ "backup file will be created
"]
POPJ P,
GIVSEQ: SKIPE UNSEQF
OUTSTR [ASCIZ "No "]
OUTSTR [ASCIZ "sequence numbers will be on output file
"]
POPJ P,
GVINC: MOVE T1,INCR ;GET CURRENT INCREMENT
PUSHJ P,OUTSN ;GO PRINT IT
JRST GIV1 ;AND A CRRET
GVDOT: PUSHJ P,SCAN ;SEE IF A TERMINATOR IS THERE
TRNN FL,TERMF
NERROR ILC ;NO TERMINATOR
MOVE T2,CLN ;GET CURRENT LINE
MOVE T1,CPGL ;AND CURRENT PAGE
GVDOT1: MOVEM T2,LINOUT
OUTSTR LINOUT ;PRINT IT
PUSHJ P,GIV2 ;PRINT PAGE
JRST COMND ;AND RETURN
OCTPR: SKIPA CS,[^O10]
DECPR: MOVEI CS,^D10
RDXPR: IDIVI T1,0(CS)
HRLM T2,(P)
SKIPE T1
PUSHJ P,RDXPR
HLRZ C,(P)
ADDI C,"0"
JRST (T3) ;EXCEPT HAS ARBITRARY OUTPUT ROUTINE
GVSTR: MOVEI T1,SRPNT ;GET THE POINTER TO POINTER BLOCK
HRLI T1,-SRNUM ;SET COUNT
OUTSTR [ASCIZ / Find:
/]
PUSHJ P,GVSTR3
MOVEI T1,R2PNT
HRLI T1,-SRNUM
OUTSTR [ASCIZ / Substitute:
/]
PUSHJ P,GVSTR3
MOVEI T1,R1PNT
HRLI T1,-SRNUM
OUTSTR [ASCIZ / For:
/]
PUSHJ P,GVSTR3
IFN EXTEND,<
OUTSTR [ASCIZ / Line-contents:
/]
MOVEI T4,0
MOVEI T5,LSNUM
MOVEI T3,OCHR
GVST1: MOVEI T1,1(T4)
PUSHJ P,DECPR
MOVEI C,":"
PUSHJ P,OCHR
PUSHJ P,FORCE
OCRLF
MOVEI T1,-1(T5)
IMULI T1,SRNUM
ADDI T1,LSPNT
HRLI T1,-SRNUM
PUSHJ P,GVSTR3
ADDI T4,1
SOJG T5,GVST1
>
POPJ P,
GIVFST: MOVE T1,TECFST ;GET CURRENT START
PUSHJ P,OUTSN ;PRINT IT
JRST GIV1 ;CRLF AND RETURN
GIVSTP: MOVE T1,TECINC ;GET INPUT INCR
PUSHJ P,OUTSN ;PRINT
JRST GIV1 ;AND RETURN
GIVLOC: MOVE T2,BUFP ;GIVE HIM FIRST LOC IN BUFFER
SKIPN T2,0(T2) ;IF ANYTHING THERE
MOVE T2,[ASCII /00000/]
MOVE T1,OPG ;OUTPUT PAGE -1
AOJA T1,GVDOT1
GIVZAP: OUTSTR [ASCIZ "Input file will "]
SKIPN DELETF ;GIVE CORRECT MESSAGE
OUTSTR [ASCIZ "NOT "]
OUTSTR [ASCIZ "be deleted.
"]
POPJ P,
GVSTR3: SKIPN T2,(T1) ;IS THERE ONE THERE?
POPJ P, ;NO, DONE
GVSTR2: ILDB C,T2 ;NEXT CHR
JUMPE C,GVSTR1 ;DONE
PUSHJ P,OCHR ;PRINT IT
JRST GVSTR2 ;AND CONTINUE
GVSTR1: PUSHJ P,FORCE ;CLEAR OUTPUT DEVICE
OCRLF
AOBJN T1,GVSTR3 ;IF THERE IS ONE
POPJ P,
GVNAM: MOVEI T4,ORGBLK
SKIPE NEWNAM ;NEW NAME GIVEN?
MOVEI T4,NEWBLK ;YES - USE IT
GVNM1: PUSHJ P,GVNAM0
JRST GIV1
GVRUN: SKIPN RUNNAM ;NEW NAME GIVEN?
JRST GVRUN1 ;NO - JUST TELL HIM OLD INFO
MOVEI T4,RUNBLK ;YES - USE NEW INFO
JRST GVNM1 ;PRINT & RETURN
GVRUN1: OUTSTR [ASCIZ "SYS:COMPIL"]
JRST GIV1
;ROUTINE TO PRINT FILE NAME INFO POINTED TO BY T4
GVNAM0: SKIPE T2,DEV(T4) ;SEE IF A DEVICE
CAMN T2,[SIXBIT "DSK"]
JRST GVNAM1 ;DON'T PRINT IT IF 'DSK'
PUSHJ P,PRTSX6 ;PRINT DEVICE NAME IN T2
MOVEI C,":" ;AND A COLON
PUSHJ P,OCHR
GVNAM1: MOVE T2,NAM(T4) ;GET A NAME
PUSHJ P,PRTSX6
HLLZ T2,EXT(T4) ;SEE IF THERE IS AN EXTENSION
JUMPE T2,GVNAM2 ;JUMP IF THERE ISN'T
MOVEI C,"." ;A PERIOD
PUSHJ P,OCHR
PUSHJ P,PRTSX3
GVNAM2: SKIPN PTH(T4) ;LOOK FOR PATH INFO
JRST FORCE ;NONE - DUMP BUFFER & RETURN
MOVEI C,"[" ;OPEN BRACKET
PUSHJ P,OCHR
MOVEI T3,OCHR ;SETUP FOR OCTPR
HLRZ T1,PTH(T4) ;GET PROJ #
PUSHJ P,OCTPR
MOVEI C,"," ;A COMMA SEPARATOR
PUSHJ P,OCHR
HRRZ T1,PTH(T4) ;GET PROG #
PUSHJ P,OCTPR ;PRINT IT
HRLI T4,-<SFDLVL+1> ;SET UP FOR FULL PATH
JRST GVNAM4
GVNAM3: MOVEI C,","
PUSHJ P,OCHR ;DUMP A COMMA
PUSHJ P,PRTSX6 ;PRINT ATOM IN T2
GVNAM4: SKIPE T2,PTH+1(T4) ;IS THERE MORE?
AOBJN T4,GVNAM3 ;YES - SEE IF COUNT EXPIRED
MOVEI C,"]" ;CLOSING BRACKET
PUSHJ P,OCHR
JRST FORCE ;DUMP BUFFER & EXIT
PRTSX3: MOVEI T3,3 ;3 CHARS
TRZA T2,-1 ;CLEAR RH
PRTSX6: MOVEI T3,6 ;6 CHARS
MOVEI T5,GVOSX ;OUTPUT ROUTINE
JRST PRTSX
GVOSX: MOVE C,T1 ;COPY CHAR INTO C
JRST OCHR ;AND OUTPUT IT
COMMENT ! THIS HERE IS THE UNIQUE INITIAL SEGMENT DECODER
STOLEN FROM THE PDP10 T-S MONITOR (SEE COMCON).
IT TAKES THE ARGUMENT IN LOC 'ACCUM' AND RETURNS THE
FULL SIXBIT VALUE IN SAME. !
DECODE:
MOVE T1,ACCUM ;FETCH ARG
MOVNI T2,1 ;SET MASK ALL ONES
LSH T2,-6 ;CLEAR OUT ONE MORE CHAR
LSH T1,6 ;SHIFT 1 COMMAND CHAR OFF
JUMPN T1,.-2 ;LUP UNTIL ALL GONE
EXCH T2,ACCUM ;FETCH ARG IN T2 & SAVE MASK
MOVNI T3,1 ;CLEAR FOUND COUNT
LUP: MOVE T4,@S1 ;FETCH TABLE ENTRY
TDZ T4,ACCUM ;MASK OUT CHARS NOT TYPED
CAMN T2,@S1 ;EXACT MATCH?
JRST FOUND ;YES: THIS IS IT
CAME T2,T4 ;CLOSE MATCH?
JRST LNEXT ;NO: KEEP TRYING
AOJG T3,LNEXT ;FIRST TIME?
HRRZ T5,S2 ;YES: REMBER INDEX
LNEXT: AOBJN S2,LUP ;NO: KEEP LOOKING
SKIPN T3 ;FIND ONLY ONE?
MOVE S2,T5 ;YES: OK TO USE SAVED VALUE
FOUND: POPJ P, ;RETURN
XCODE: PUSH P,S1 ;SAVE SPECIAL ACS
PUSH P,S2
MOVE S1,[S2,,NAMTAB]
MOVSI S2,-NAMLEN
PUSHJ P,DECODE
MOVE T1,NAMDSP(S2) ;GET DISPATCH ENTRY
POP P,S2 ;RESTORE SPECIAL ACS
POP P,S1
POPJ P,
;THIS IS THE FULL NAME TABLE
DEFINE NAMES <
X (R,SETRED,0,0)
X (RONLY,SETRED,0,0)
X (READONLY,SETRED,0,0)
X (UPPER,SETUPP,0,0)
X (LOWER,SETLOW,0,0)
X (M37,SETM37,0,0)
X (M33,SETM33,0,0)
X (DPY,SETDPY,0,0)
X (NOVICE,SETNOV,0,0)
X (EXPERT,SETEXP,0,0)
X (C128,QON,0,0)
X (C64,QOFF,0,0)
X (SEPARATORS,QSON,0,0)
X (NONSEPARATORS,QSOFF,0,0)
X (RMAR,SETRMR,GVRM,XNUMF)
X (LMAR,SETLMR,GVLM,XNUMF)
X (PMAR,SETPMR,GVPM,XNUMF)
X (MAXLN,SETMLN,GVMLN,XNUMF)
X (INCREMENT,SETINC,GVINC,XNUMF)
X (ERROR,0,GIVER,0)
X (CASE,0,GVCASE,0)
X (STRING,0,GVSTR,0)
X (BIG,0,GIVBIG,0)
X (LOCATION,0,GIVLOC,0)
X (NAME,SETNAM,GVNAM,XVARF)
X (RUN,SETRUN,GVRUN,XVARF)
X (LENGTH,SETLEN,GVPG,XNUMF)
X (SAVE,SETSAV,GVSAV,XNUMF)
X (ISAVE,SETISV,GVISAV,XNUMF)
X (CHECK,SETCHK,GIVCHK,0)
X (NOCHECK,CLRCHK,0,0)
X (NUMBER,SETNUM,0,0)
X (NONUMBER,CLRNUM,0,0)
X (DISK,0,GIVDSK,0)
X (DSK,0,GIVDSK,0)
X (DECIDE,SETDCD,GIVDCD,0)
X (NODECIDE,CLRDCD,0,0)
X (DELETE,SETZAP,GIVZAP,0)
X (NODELETE,CLRZAP,0,0)
X (BAK,SETBAK,GIVBAK,0)
X (NOBAK,CLRBAK,0,0)
X (OLD,SETOLD,0,0)
X (OPTION,SETOPT,0,XVARF)
X (BASIC,SETBAS,0,0)
X (UNSEQUENCE,SETSEQ,0,0)
X (SEQUENCE,CLRSEQ,GIVSEQ,0)
X (START,SETFST,GIVFST,XNUMF)
X (STEP,SETSTP,GIVSTP,XNUMF)
X (PLINES,SETPLN,GVPLN,XNUMF)
>
DEFINE X(A,B,C,D) <
EXP <SIXBIT /A/>>
NAMTAB:
NAMES
NAMLEN==.-NAMTAB
DEFINE X(A,B,C,D) <
D+C,,B
>
XNUMF==3B20 ;SET NEEDS NUMERIC ARG
XVARF==1B19 ;SET NEEDS ARG
NAMDSP:
NAMES
XERR,,XERR
XERR: NERROR ILC
SUBTTL LIST COMMAND
IFN LSTSW,<
LIST: TRZ FL2,SUPN ;ASSUME WE ARE GOING TO LIST LINE NUMBERS
SETZM LOLN ;FOR START OF PAGE
PUSHJ P,SCAN ;GET SOME INFORMATION
CAIE C,"," ;IS THERE A SWITCH?
JRST LIST9 ;NO
PUSHJ P,SCAN ;YES, SCAN FOR IT
MOVS T1,ACCUM
CAIE T1,(<SIXBIT /S />) ;IS IT S?
NERROR ILC ;NO, LOSE
TRO FL2,SUPN ;YES, SUPPRESS LINE NUMBERS
PUSHJ P,SCAN ;AND SCAN PAST IT
LIST9: TRNN FL,TERMF ;JUST A TERMINATOR
JRST LIST7 ;NO, GO LOOK FOR A COMMAND STRING
MOVEI T1,1 ;LIST ENTIRE FILE
MOVEM T1,LOPG
MOVSI T1,1 ;FROM 1 TO IMPOSSIBLY HIGH
MOVEM T1,HIPG
TRZ FL,CNTF ;MAKE SURE THAT THIS FLAG IS OFF
JRST LIST8 ;GO START WORK
LIST7: PUSHJ P,GET2 ;HAVE ALREADY SCANNED, GET 2 NUMBERS
CAIE C,"," ;IS THERE A SWITCH?
JRST LIST10 ;NO
PUSHJ P,SCAN ;YES, SCAN FOR IT
MOVS T1,ACCUM
CAIE T1,(<SIXBIT /S />) ;IS IT S?
NERROR ILC ;NO, LOSE
TRO FL2,SUPN ;YES, SUPPRESS LINE NUMBERS
PUSHJ P,SCAN ;AND SCAN PAST IT
LIST10: TRNN FL,TERMF ;END OK?
NERROR ILC
LIST8: TRZ FL,LINSN ;NONE SEEN YET
MOVEI T1,LPTBUF ;GET SET TO INIT THE LPT
EXCH T1,.JBFF##
PUSH P,T1 ;SAVE OLD
MOVSI T1,'LPT' ;DEFAULT DEVICE NAME
MOVEM T1,LPDEVI+1
OPEN LPT,LPDEVI ;GET IT
SKIPA ;FAILED - TRY DSK
JRST LIST8A ;LPT OK - USE IT
MOVE T1,OUDEVI+1 ;GET DSK NAME
MOVEM T1,LPDEVI+1
OPEN LPT,LPDEVI
NERROR UNA
LIST8A: OUTBUF LPT,1 ;ASK FOR ONE BUFFER
MOVEI T2,LPTBUF ;FIND OUT HOW BIG IT IS
EXCH T2,.JBFF##
SUBI T2,LPTBUF ;THE SIZE
MOVEI T1,203 ;THE SPACE RESERVED FOR IT
IDIV T1,T2 ;GET NUMBER THAT WILL FIT THERE
OUTBUF LPT,(T1) ;AND ASK FOR THAT MANY
POP P,.JBFF## ;RESTORE JOBFF
MOVE T1,[OCRBLK,,TMPBLK]
BLT T1,TMPBKE ;SETUP OUTPUT SPECS
SKIPN T1,NEWNAM ;SEE IF NEW NAME
MOVE T1,ORGNAM ;ELSE USE ORIGINAL
MOVEM T1,TMPNAM
MOVSI T1,'LPT' ;USE THIS EXTENSION
HRR T1,ORGPRT ;AND THIS PROTECTION
MOVEM T1,TMPEXT
XENTR LPT,TMPBLK ;GO CREATE FILE
NERROR UNA ;NOPE!
MOVE T1,[XWD PGHS,PGHD] ;GET A COPY OF THE BLANK HEADER
BLT T1,PGHD+7
MOVE C,[POINT 7,PGHD,27] ;START TO FILL IT
MOVEI T3,6 ;6 CHRS IN FILE NAME
MOVEI T5,HDOSX ;OUTPUT ROUTINE
MOVE T2,ORGNAM ;USE THE ORIGINAL NAME
PUSHJ P,PRTSX ;PUT IT IN THE HEADER
SKIPN T2,ORGEXT ;GET THE EXTENSION
JRST LIST1 ;NONE THERE, IGNORE
MOVEI T1,"." ;A DOT BETWEEN
IDPB T1,C
MOVEI T3,3 ;ONLY 3 CHRS HERE
TRZ T2,-1 ;CLEAR RH
PUSHJ P,PRTSX
LIST1: MOVE ALTP,[POINT 7,PGHD+3] ;TIME+DATE (ALTP IS FREE)
DATE T1, ;GET DATE
IDIVI T1,^D31 ;LEAVES DAY IN T2
PUSH P,T1 ;SAVE PARTIAL
MOVEI T1,1(T2) ;GET DAY (MUST ADD 1)
MOVEI T3,HDOCH ;PLACE FOR DECPR TO PUT THINGS
PUSHJ P,DECPR
MOVEI C,"-" ;SEPARATE
IDPB C,ALTP
POP P,T1 ;GET MONTH-YEAR BACK
IDIVI T1,^D12 ;MONTH-1 IN T2
SKIPA T4,[POINT 7,MONTAB(T2)]
IDPB C,ALTP
ILDB C,T4
JUMPN C,.-2 ;LOOP UNTIL NULL
MOVEI C,"-" ;SEPARATE
IDPB C,ALTP
ADDI T1,^D64 ;CONVERT TO REAL YEAR
PUSHJ P,DECPR
IBP ALTP ;SKIP OVER A SPACE
MSTIME T1, ;GET THE TIME
IDIVI T1,^D60000 ;CONVERT TO MINUTES
IDIVI T1,^D60 ;NOW TO HOURS
PUSH P,T2 ;SAVE MINUTES
PUSHJ P,DECPR ;PRINT
MOVEI T1,":"
IDPB T1,ALTP
POP P,T1 ;GET MINUTES BACK
MOVEI T2,"0" ;MAKE SURE THERE ARE 2 DIGITS
CAIG T1,^D9
IDPB T2,ALTP
PUSHJ P,DECPR
SETOM LOGPG ;LOGICAL PAGE TO 0
MOVE T1,LOPG ;GET SET TO PRINT
MOVEM T1,DPG
MOVE SINDEX,LOLN
PUSHJ P,FIND ;GO FIND IT
SETZM LSTCNT ;COUNT OF NUMBER OF LINES PER PAGE
LST2: PUSHJ P,ONMOV ;CHECK RANGE
JRST LST6 ;FINISH UP
TRO FL,LINSN ;YEP, WE HAVE SEEN ONE
CAMN T1,PGMK ;CHECK FOR PAGE MARK AND HANDLE SPECIAL
JRST LST4
MOVEM T1,CLN ;THE CURRENT LINE
MOVEI T2,0 ;COUNT OF NUMBER OF CHRS SEEN
SOSLE LSTCNT ;CHECK TO SEE IF RUN OUT
JRST LST2A ;NO - PROCEED
MOVEI C,14 ;OUTPUT A FORM-FEED
PUSHJ P,POCHR
PUSHJ P,HDPRNT ;GO PRINT HEADING
LST2A: MOVE T1,PNTR ;GET THE POINTER
TRNN FL2,SUPN ;DO WE WANT TO SUPPRESS LINE NUMBERS?
JRST LST3A ;NO
AOS T1 ;YES, SKIP A WORD
HRLI T1,(<POINT 7,0,6>) ;AND A CHARACTER
ADDI T2,6 ;AND TELL PEOPLE WE HAVE DONE SO
JRST LST3 ;BEFORE GOING ON OUR WAY
LST3A: HRLI T1,(<POINT 7,0>) ;AND SET UP BYTE POINTER
LST3: ILDB C,T1 ;GET CHR
CAIGE C,11 ;CHECK ALL SPECIAL CASES
JRST LST3B
CAIGE C,15
JRST SPHD
CAIN C,15
JRST LST5
CAIE C,"'"
CAIGE C,40
JRST LST3B
CAIGE C,140
JRST LST5
LST3B: TLNE FL,QMODF ;CHECK QUOTE MODE
JRST LST5
PUSH P,C
MOVEI C,"'"
PUSHJ P,POCHR
ADDI T2,1
POP P,C
LDB C,[POINT 7,CTBL(C),10]
LST5: PUSHJ P,POCHR ;PRINT IT
AOJA T2,LST3 ;COUNT AND CONTINUE
SPHD: CAIN C,12 ;LINE FEED IS END OF LINE
JRST [PUSHJ P,POCHR ;PRINT IT
PUSHJ P,FINDN ;GET NEXT
JRST LST2] ;AND GO
CAIN C,11 ;COUNT SPECIAL FOR TAB
JRST [ADDI T2,10
ANDCMI T2,7
PUSHJ P,POCHR
JRST LST3]
CAIN C,14
JRST [PUSHJ P,POCHR ;FORM FEED GETS A HEADING
PUSHJ P,HDPRNT
JRST LST3]
CAIN C,"\" ;NEEDS DELETE,DELETE
JRST [MOVEI C,177
PUSHJ P,POCHR
JRST LST5] ;AND AGAIN
CAIE C,13 ;VERT.TAB
ERROR ICN ;CONFUSED
PUSHJ P,POCHR
MOVE T3,LSTCNT
CAIG T3,<%LPP+2>/3
JRST [PUSHJ P,HDPRNT
JRST LST3]
CAIG T3,<2*<%LPP+2>>/3
MOVEI T3,<%LPP+2>/3
CAIL T3,<2*<%LPP+2>>/3
MOVEI T3,<2*<%LPP+2>>/3
MOVEM T3,LSTCNT
JRST LST3
LST4: MOVEI C,14 ;PRINT A FORM FEED
SOSLE LSTCNT ;BUT ONLY IF WE ARE NOT ALREADY THERE
PUSHJ P,POCHR
AOS T1,CPG ;GET PAGE CORRECTLY
MOVEM T1,CPGL
SETOM LOGPG ;ZERO LOGICAL PAGE AGAIN
MOVEI T2,0 ;THIS MUST BE ZERO SO GET IT THAT WAY
PUSHJ P,HDPRNT ;PRINT A HEADER
AOS LSTCNT ;INCREASE BY 1 TO MAKE IT COME OUT RIGHT
PUSHJ P,FINDN ;ADVANCE
JRST LST2 ;AND CONTINUE
LST6: RELEAS LPT,0 ;GET RID OF IT
TRZ FL2,SUPN ;TURN THIS OFF SO * PRINTS
TRNN FL,LINSN ;WERE ANY SEEN?
NERROR NLN ;NO, ERROR
MOVE T1,CPG ;SET UP PAGE
MOVEM T1,CPGL
JRST COMND ;AND GET MORE COMMANDS
POCHR: SOSG LOBUF+2 ;ROOM FOR MORE?
OUTPUT LPT,0
IDPB C,LOBUF+1
POPJ P,
HDPRNT: PUSH P,T1 ;SAVE POINTER
TRNE FL2,SUPN ;IF PRETTY PRINTING
JRST HDPR3 ;WE DON'T REALLY WANT TO DO THIS
MOVEI C,15 ;GET TO LEFT OF PAGE
PUSHJ P,POCHR
MOVE T1,[POINT 7,PGHD] ;GET SET TO PRINT HEADER
HDPR1: ILDB C,T1 ;GET A CHARACTER
JUMPE C,HDPR2 ;DONE?
PUSHJ P,POCHR ;PRINT IT
JRST HDPR1 ;CONTINUE
HDPR2: PUSH P,T2 ;SAVE CHARACTER COUNT
MOVE T1,CPG ;GET CURRENT PAGE
MOVEI T3,POCHR ;WHERE TO PRINT IT
PUSHJ P,DECPR ;PRINT
AOSG T1,LOGPG ;SEE IF OK TO PRINT
JRST HDPR3
MOVEI C,"-"
PUSHJ P,POCHR
PUSHJ P,DECPR
HDPR3: MOVEI C,15 ;NOW RET AND 2 LFDS
PUSHJ P,POCHR
MOVEI C,12
PUSHJ P,POCHR
PUSHJ P,POCHR
MOVEI T1,%LPP ;RESET LINE COUNT
MOVEM T1,LSTCNT
TRNN FL2,SUPN ;IF IN SUPPRESS MODE WE DID NOT SAVE
POP P,T2 ;GET BACK COUNT OF CHRS
JUMPE T2,T1POPJ ;IF 0 THEN ALL OK
MOVE T3,T2 ;GET COPY
MOVEI C," " ;PRINT CORRECT NUMBER OF SPACES
PUSHJ P,POCHR
SOJG T3,.-1
T1POPJ: POP P,T1 ;RESTORE POINTER
POPJ P,
;ROUTINE TO PRINT IN SIXBIT THE ATOM FOUND IN T2
; T5 CONTAINS THE OUTPUT ROUTINE ADDRS
; T3 CONTAINS THE MAX NUMBER TO OUTPUT
PRTSX: MOVEI T1,0 ;SET TO RECIEVE A CHR
LSHC T1,6 ;GQT ONE
ADDI T1,40 ;CONVERT
PUSHJ P,(T5) ;DUMP A CHAR
SKIPE T2 ;ONLY SPACES LEFT?
SOJG T3,PRTSX ;OR COUNT RUN OUT?
POPJ P, ;RETURN
HDOCH: IDPB C,ALTP ;PUT CHRS FROM DECPR INTO HEADER
POPJ P,
HDOSX: IDPB T1,C
POPJ P,
MONTAB: ASCII "JAN"
ASCII "FEB"
ASCII "MAR"
ASCII "APR"
ASCII "MAY"
ASCII "JUN"
ASCII "JUL"
ASCII "AUG"
ASCII "SEP"
ASCII "OCT"
ASCII "NOV"
ASCII "DEC"
>
IFE LSTSW,<
LIST: NERROR ILC
>
SUBTTL REPLACE COMMAND
;RE-TYPE (REPLACE) COMMAND
REPLAC: SETZM LOLN ;I REALLY SHOULD PUT THIS ELSEWHERE
SETZM PGDELS ;INIT PAGE DELETED COUNTER
TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
NERROR ILC
PUSHJ P,GET2S ;WHAT DO WE WANT TO REPLACE?
TRZ FL,LINSN ;CLR FOR NOW
PUSHJ P,INSINC ;GO GET INCR
PUSHJ P,DELSUB ;DELETE SOME STUFF
SKIPN T1,LOLN ;WHERE TO START INSERTING
MOVE T1,[<ASCII /00100/>!1]
MOVEM T1,HILN ;SET UP FOR INSERT CODE
MOVE T2,LOPG
MOVEM T2,HIPG ;...
SKIPE PGDELS ;OK IF NONE DELETED
SKIPN T1,(PNTR) ;OR AT EOF
JRST REPLC1
CAME T1,PGMK ;ALSO END OF PAGE
CAMLE T1,FDELLN ;OR REALLY IN ORDER
JRST REPLC1
AOS CPG ;INSERT PAGE MARK TO PREVENT INSANITY
AOS INPG ;ADJUST PAGE COUNTERS
AOS BGPG
MOVE T1,PGMK ;SET UP PAGE MARK TO INSERT
MOVEM T1,LIBUF
MOVE T1,PGMKW2
MOVEM T1,LIBUF+1
SETZM OCNT ;STUFF FOR INSED
MOVEI T1,2
MOVEM T1,NCNT
PUSHJ P,INSED ;PUT IT IN
PUSHJ P,FINDN ;CREEP PAST IT
PUSHJ P,FILLB ;IN CASE OVERFLOW
OUTSTR [ASCIZ /%Page mark inserted to prevent order error
/]
REPLC1: PUSHJ P,DOINS ;LET HIM TYPE FOR A WHILE
JRST COMND ;RETURN
;SUBROUTINE TO DELETE THE LINE POINTED TO BY PNTR
DODEL: SETZM NCNT ;NEW IS 0
MOVEM T1,LDELLN
PUSHJ P,GETLTH ;OLD LENGTH
MOVEM T1,OCNT
AOS DELCNT ;COUNT OF LINES DELETED
SKIPE FDELLN ;FIRST TIME HERE
JRST INSED ;NO: GO INSERT AND RETURN
MOVE T1,LDELLN ;YES: SET UP FIRST LINE ETC.
MOVEM T1,FDELLN
MOVE T1,CPG
MOVEM T1,FDELPG
JRST INSED ;AND GO INSERT
SUBTTL COMMON SEARCH ROUTINES FOR F AND S
COMMENT ! SOME COMMON ROUTINES FOR SEARCHING FILES!
COMMENT ! THIS ROUTINE GENERATES CODE FOR FINDING A MATCH
FOR THE FIRST CHARACTER OF A SEARCH STRING. THE POINTER
TO A SET OF BYTE POINTERS FOR SEARCH STRINGS IS IN T1 !
CODSR: MOVEI T2,CODEBF ;SET UP POINTER TO PLACETO PUT CODE
MOVEI ALTP,0 ;THE NUMBER OF THE CURRENT STRING
HRLI T1,-SRNUM ;THE NUMBER OF STRINGS
CODS5: TLZ FL,NEGF!DEMCHR ;TURN OFF THE SEEN FLAG
MOVE T3,(T1) ;GET A POINTER
JUMPE T3,ENDCOD ;A ZERO BYTE POINTER IS END OF CODE
READCD: ILDB C,T3 ;PICK UP A CHARACTER IN STRING
JUMPE C,[TLNE FL,DEMCHR ;DID WE REALLY WANT ONE
NERROR ISS ;YES, LOSE
SUBI T2,2 ;NO, ALWAYS MATCH
JRST COMXCT]
CAIN C,"" ;ARBIRARY NUMBER OF SOMETHING
JRST ARBCD
CAIN C,24 ;ANY CHARACTER
JRST ANYCD
CAIN C,"" ;NOT THIS ONE
JRST [TLC FL,NEGF
TLO FL,DEMCHR ;WE REALLY JEED IT
JRST READCD]
CAIN C,"|" ;SEPERATOR
JRST SEPCD
CAIN C," " ;QUOTE THE NEXT CHARACTER
JRST QUOTE
COMLET: MOVE CS,CTBL(C) ;GET THE MAJIC BITS
TLNN FL,EXCTS1!EXCTSR ;IS THIS AN EXACT SEARCH?
TLNN CS,LETF_16 ;OR NOT A LETTER
JRST NORMCR ;YES JUST THE TEST
HRLI C,(<CAIE C,>) ;DO A CAIE
MOVEM C,(T2)
XOR C,[XWD 4000,40] ;CAIN .XOR. CAIE = 4000,,0
MOVEM C,1(T2)
TLNE FL,NEGF ; THAT CHR
JRST GENSKP ;GENERATE A SKIPA
COMXCT: MOVE C,[XCT JSPR] ;THE CALL TO SEARCH FURTHER
DPB ALTP,[POINT 4,C,12] ;AC FIELD GIVES STRING NUMBER
MOVEM C,2(T2)
ADDI T2,3 ;ADVANCE OUTPUT POINTER
ENDSTR: ADDI ALTP,1 ;NEXT STRING
AOBJN T1,CODS5 ;IF ANY
ENDCOD: MOVE C,[JRST COMSRT] ;A RETURN
MOVEM C,(T2)
POPJ P,
SEPCD: MOVE C,[SKIPG CS,CTBL(C)] ;GET BITS
MOVEM C,(T2)
MOVE C,[TRNE CS,NSEPF] ;CHECK FOR %,$,OR .
TRNE FL2,QSEPF ;SEPARATORS?
MOVSI C,(<SKIPA>) ;YES;
MOVEM C,1(T2)
TLNE FL,NEGF ;SKIPA IN NORMAL CASE
JRST COMXCT
GENSKP: MOVSI C,(<SKIPA>)
MOVEM C,2(T2)
AOJA T2,COMXCT ;SO XCT WILL GO IN RIGHT PLACE
QUOTE: ILDB C,T3 ;GET NEXT CHR
JUMPE C,[NERROR ISS] ;END OF STRING IS ILLEGAL
JRST COMLET ;TREAT AS NORMAL CHARACTER
NORMCR: HRLI C,(<CAIN C,>) ;EXACT OR NOT LETTER
TLNE FL,NEGF
TLC C,4000 ;CAIN .XOR. CAIE = 4000,,0
NORMC1: MOVEM C,(T2)
SOJA T2,COMXCT ;MAKE THE XCT GO IN RIGHT PL@CE
ANYCD: MOVE C,[CAIE C,15] ;SPECIAL FOR EOL
TLNE FL,NEGF
TLC C,4000 ;CAIN .XOR. CAIE = 4000,,0
JRST NORMC1
ARBCD: ILDB C,T3 ;GET NEXT
CAIN C,"" ;JUST CHECK VALIDITY
JRST ARBCD
CAIN C," "
ILDB C,T3
JUMPE C,[NERROR ISS] ;END OF STRING ERROR
JRST READCD ;LOOK FOR FIRST OTHER CHR
JSPR: JSP T1,SRCRET ;CALL CONTINUE SEARCH
;READ INTHE STRING TO SEARCH FOR
;T3 HAS PLACE TO PUT POINTERS T1 A BYTE POINTER FOR STRINGS
SSTRNG: MOVEI T2,SRBLG ;THE PERMISSIBLE LENGTH
HRLI T3,-SRNUM ;T3 HAS POINTER TO PLACE BYTE POINTERS
SSTR0: MOVEM T1,SVPT ;SAVE THE POINTER FOR END OF STRING
SSTR1: PUSHJ P,GNCH ;GET A CHR
CAIN C,200 ;ALTMODE TERMINATES
JRST SSTEND
CAIN C,15 ;IGNORE RETURNS
JRST SSTR1
CAIN C,12 ;LINE FEED IS END OF ONE STRING
JRST SSTR2
IDPB C,T1 ;PUT IN OUTPUT STRING
SOJG T2,SSTR1
SSTR3: RERROR STL ;THE STRING WAS TOO LONG
SSTR4: HRLZ T1,T3 ;ZERO OUT FIRST POINTER
MOVNS T1
ADDI T1,-SRNUM(T3) ;FIND START
SETZM (T1)
JRST COMND
SSTR2: CAMN T1,SVPT ;NULL STRING?
JRST [HLRZ C,T3 ;FIRST ONE?
CAIE C,-SRNUM ;WELL?
JRST .+1 ;NO
MOVEI C,12 ;RETURN A LINE FEED
POPJ P,]
RETSTR: MOVEI C,0 ;TERMINATE STRING WITH 0
IDPB C,T1
SOJLE T2,SSTR3
MOVE C,SVPT ;SET UP POINTER
MOVEM C,(T3)
AOBJN T3,SSTR0 ;IF ROOM FOR MORE, GET THEM
RERROR TMS ;TOO MANY GIVEN
JRST SSTR4
SSTEND: CAIN T2,SRBLG ;DID WE SEE ANY?
POPJ P, ;NO, RETURN
MOVEI C,0 ;YES, TERMINATE LAST
IDPB C,T1
MOVE T1,SVPT
MOVEM T1,(T3) ;SET POINTER
SSTR5: AOBJP T3,CPOPJ1 ;ZERO OUT OTHER POINTERS
SETZM (T3)
JRST SSTR5
;THE SEARCH ITSELF
COMSRC: MOVEM T2,BUFSAV ;SAVE THE POINTER TO STRINGS
MOVNI T3,1 ;THE COUNT OF HOW FAR INTO LINE WE ARE
MOVEI ALTP,1(PNTR) ;SET BYTE POINTER
HRLI ALTP,(<POINT 7,0,6>)
MOVEI C,15 ;START WITH A LINE DELIMITER
JRST CODEBF ;GO SCAN
COMSRT: ILDB C,ALTP ;WE RETURN HERE IF NO MATCH FOR THIS ONE
CAIE C,15 ;DONE?
AOJA T3,CODEBF ;NO, GO ON
POPJ P, ;YES, NON-MATCH RETUNR
SRCRET: PUSH P,T1 ;SAVE THE RETURN ADDRESS
PUSH P,ALTP ;AND THE STRING POINTER
PUSH P,C ;AND THE CHARACTER
LDB T1,[POINT 4,-1(T1),12] ;GET STRING NUMBER
ADD T1,BUFSAV ;POINT TO BYTE POINTER
SKIPN T1,(T1) ;GET IT
ERROR ICN ;THERE SHOULD BE ONE THERE
MOVE T2,[POINT 7,ARBBUF] ;SET UP ARBIT MATCH
MOVEI T4,MXWPL*^D10 ;POINTER AND COUNT
SETZM ARBCNT ;THE NUMBER OF ARBITRARY MATCHES SEEN
TLZ FL,ARBITG ;OFF AT START
PUSHJ P,LINMAT ;GO CHECK FOR MATCH
JRST LOSE ;WE LOSE, CONTINUE SCAN
MOVEM ALTP,SRCALP ;POINTER TO END OF STRING
POP P,C ;RESTORE
POP P,ALTP
POP P,T1
CPOPJ1: AOS (P) ;SKIP RETURN
POPJ P,
LOSE: POP P,C ;RESTORE
POP P,ALTP
POPJ P, ;AND CONTINUE SEARCH
NXTCHR: CAIN C,12 ;WAS THAT LAST OF LINE?
POPJ P, ;YES, LOSE
ILDB C,ALTP ;NO, TRY NEXT
LINMAT: PUSHJ P,CHRMAT ;CHECK FOR MATCH
POPJ P, ;NONE, RETURN
CAIE CS,0 ;IS SO ALL DONE
JRST NXTCHR ;NO, TRY MORE
JRST CPOPJ1 ;SKIP RETURN
CHRMAT: TLZ FL,NEGF!DEMCHR ;NO SEEN AND CHR CAN BE 0
READCH: ILDB CS,T1 ;GET NEXT
JUMPE CS,MATCH ;END OF STRING IS USUALLY GOOD
CAIN CS,"" ;CHEC FOR NEGATE
JRST [TLC FL,NEGF
TLO FL,DEMCHR ;MUST BE FOLLOWED BY A CHR
JRST READCH]
CAIN CS,"|" ;SEPERATOR?
JRST SEP
CAIN CS,"" ;ARBITRARY NUMBER
JRST ARBIT
CAIN CS,24 ;ANY?
JRST ANY
CAIN CS," " ;QUOTE NEXT?
JRST [ILDB CS,T1
JUMPN CS,.+1 ;MUST HAVE ONE THERE
NERROR ISS] ;ELSE ILLEGAL
CAMN C,CS ;ARE THEY THE SAME
JRST ISTRU1 ;YES, CHECK NEGF
MOVE T5,CTBL(CS) ;GET BITS
TLNN FL,EXCTS1!EXCTSR ;EXACT?
TLNN T5,LETF_16 ;OR NOT LET
JRST ISFALS ;NO MATCH
XORI CS,40 ;CHECK OTHER CASE
CAMN C,CS
JRST ISTRU1
JRST ISFALS ;LOSE
MATCH: TLNE FL,DEMCHR ;DID WE NEED A CHARACTER THERE?
NERROR ISS ;YES, ILLEGAL STRING
JRST CPOPJ1 ;OK RETURN
ANY: CAIE C,15
JRST ISTRU ;YES THIS IS ANY CHR
ISFALS: CAIN C,15 ;IS IT A RETURN
AOSA T4 ;ADJUST COUNT AND ENTER A NULL STRING
IDPB C,T2 ;SAVE IN ARBIT
MOVEI T5,0
IDPB T5,T2
SUBI T4,2 ;COUNT THEM
JUMPLE T4,ILFMTR ;THIS LINE MUST HAVE ILLEGAL FORMAT
AOS ARBCNT ;ONE MORE SEEN
ISFAL1: TLNE FL,NEGF ;WAS NEG FLAG ON?
AOS (P) ;YES, A MATCH
POPJ P,
SEP: MOVE T5,CTBL(C) ;GET TABLE ENT
JUMPG T5,ISFALS ;NOT A SEP
TRNN FL2,QSEPF ;CHECK . % $
TRNN T5,NSEPF ;CHECKING - DO WE HAVE ONE?
JRST ISTRU ;NO: SEP
JRST ISFALS ;YES: NOT A SEP
ISTRU: CAIN C,15
AOSA T4
IDPB C,T2 ;SAVE CHR
MOVEI T5,0
IDPB T5,T2
SUBI T4,2
JUMPLE T4,ILFMTR
AOS ARBCNT
ISTRU1: TLNN FL,NEGF ;NEGATE?
AOS (P) ;NO, MATCH
POPJ P,
ILFMTR: MOVE T2,CPG ;GIVE HIM AN ERROR MESSAGE AND PAGE
PUSHJ P,PGPRN ;AND LINE
MOVE T1,(PNTR)
PUSHJ P,OUTSN
NERROR ILFMT
ARBIT: TLNN FL,NEGF ;THIS HAS NO MEANING
TLOE FL,ARBITG ;ARE WE SEEING
NERROR ISS ;YES, ILLEGAL STRING
PUSH P,T1 ;SAVE SEARCH POINTER
MOVEI T5,0 ;SET ARBITRARY STRING TO NULL
IDPB T5,T2
SOJLE T4,ILFMTR
AOS ARBCNT
PUSH P,ARBCNT ;SAVE IN CASE WE COME BACK WITH NO MATCH
PUSH P,T2
PUSH P,T4
PUSH P,C
CHKTHS: TLO FL,DEMCHR ;NEED A CHARACTER NOW
PUSHJ P,READCH ;CALL SELF RECURSIVELY
JRST PROCED ;THIS COULD NOT MATCH JUST SCAN ON
MOVE T2,-3(P) ;RESTORE ARBIT COUNT
MOVEM T2,ARBCNT
MOVE T4,-1(P) ;AND ARBIT CHR COUNT
MOVE T2,-2(P) ;AND POINTER
PUSH P,ALTP ;SAVE CHR POINTER
TLZ FL,ARBITG ;CAN SEE ANOTHER NOW
PUSHJ P,LINMAT ;A MATCH
JRST RECUR ;NO, TRY FOR ANOTHER OF THAT CHR
SUB P,[XWD 7,7] ;GET ALL THAT JUNK OFF STACK
JRST CPOPJ1 ;AND RETURN TO CALLER OF LINMAT
RECUR: POP P,ALTP ;GET BACK POINTER
POP P,C ;AND CHR
MOVE T4,-2(P) ;RESTORE COUNT
MOVEM T4,ARBCNT
POP P,T4
POP P,T2 ;ALSO CHR COUNTER AND POINTER
DPB C,T2 ;PUT IN THAT CHR
MOVEI T5,0 ;AN@ TERMINATOR
IDPB T5,T2
SOJLE T4,ILFMTR
PUSH P,T2
PUSH P,T4 ;RESAVE
MOVE T1,-3(P) ;RESTORE SEARCH POINTER
ILDB C,ALTP ;GET ANOTHER CHR
PUSH P,C ;SAV IT
TLZ FL,NEGF ;TURN THIS OFF FOR RECURSION
CAIE C,12 ;END OF WORLD?
JRST CHKTHS
SUB P,[XWD 5,5] ;RECUCE STACK
POPJ P, ;AND ERROR RET
PROCED: TLZ FL,ARBITG!NEGF ;JUST GO ON
POP P,C
POP P,T4
POP P,T2
POP P,ARBCNT
POP P,(P) ;GET RID OF EXTRA POINTER
JRST CHRMAT ;CONTINUE MATCH SCANNING
SUBTTL FIND COMMAND (SEARCHES)
;DO A SEARCH OF A FILE
SEARCH: TLZ FL,ASSMF ;CLEAR ALL FLAGS
SETZM LOLN ;JUST LIKE EVERYONE ELSE HAS TO
SETZM SRCNT ;START WITH ZERO
MOVE T1,[POINT 7,SRBUF] ;SET UP BYTE POINTER
MOVEI T3,SRPNT ;AND POINTER TO BYTE POINTER TABLE
PUSHJ P,SSTRNG ;GET A SEARCH STRING
JRST [SKIPN SRPNT ;WAS STRING SET?
NERROR NSG ;NO, TELL HIM
CAIN C,12
JRST ASSMD1 ;SPECIAL CONTINUE MODE
JRST .+1] ;YES, USE OLD ONE
TLZ FL,NUMSRF!ALTSRF!EXCTSR ;CLEAR FLAGS
PUSHJ P,SCAN ;CHECK FOR WHAT COMES AFTER
TRNN FL,TERMF ;IF TERMINATOR
CAIN C,"," ;OR ,
JRST ASSMDT ;SET UP LIMITS SPECIALLY
CAIE C,"!"
CAIN C,":"
JRST ASSMDT ;LET HIM SPECIFY 2ND HALF OF RANGE
PUSHJ P,GET2 ;ELSE CALL USUAL LIMIT ROUTINE
SRC4: MOVE T1,HILN ;SAVE END OF RANGE
MOVEM T1,SRHILN
MOVE T1,HIPG
MOVEM T1,SRHIPG
CAIE C,"," ;ANY MORE ARGUMENTS?
JRST SRC1 ;NO, CHECK TERMINATOR AND PROCEED
PUSHJ P,SCAN ;YES, SEE WHAT IT IS
TRNN FL,IDF ;SHOULD BE IDENT OR NUMBER
JRST SRC2 ;NOT IDENT, CHECK FOR NUMBER OF SEARCHES
MOVS T1,ACCUM ;GET THE IDENT
CAIN T1,(<SIXBIT /N />) ;AND FIND OUT WHAT IT IS
TLO FL,NUMSRF
CAIN T1,(<SIXBIT /A />)
TLO FL,ALTSRF ;FIRST CHECK FOR A OR N
TRNE FL,READOF ;IF READ ONLY AND ALTER
TLNN FL,ALTSRF
SKIPA
NERROR ILC ;WE DO NOT PERMIT IT
TLNN FL,NUMSRF!ALTSRF ;WAS IT EITHER?
JRST SRC3 ;NO, CHECK E
PUSHJ P,SCAN ;CONTINUE LOOKING
CAIE C,","
JRST SRC1 ;NO MORE ARGUMENTS
PUSHJ P,SCAN ;WELL WHAT KIND IS THIS ONE?
TRNN FL,IDF ;MORE IDENTS?
JRST SRC2 ;NO, MUST BE NUMBER OF SEARCHES
MOVS T1,ACCUM
SRC3: CAIE T1,(<SIXBIT /E />)
NERROR ILC ;NO, HE MUST HAVE MADE A MISTAKE
TLO FL,EXCTSR ;YES, REMEMBER IT
PUSHJ P,SCAN ;AND CHECK FOR MORE
CAIE C,","
JRST SRC1 ;NO MORE
PUSHJ P,SCAN ;ONLY ONE THING IT CAN BE NOW
SRC2: TRNN FL,NUMF
NERROR ILC ;NOPE, LOSE
MOVEM T2,SRCNT ;SAVE AS COUNT OF LINES TO FIND
PUSHJ P,SCAN ;GET TERMINATOR (WE HOPE)
SRC1: TRNN FL,TERMF ;ALLS WELL THAT ENDS WELL
NERROR ILC ;BUT THIS DOSNT
SRCH1A: MOVEI T1,SRPNT ;GET POINTER TO STRINGS
PUSHJ P,CODSR ;AND GENERATE CODE
MOVE T1,LOPG ;GET SET TO HUNT IT
MOVEM T1,DPG
MOVEM T1,SRPG ;FLAG TO SAY IF WE SHOULD PRINT PAGE
MOVE SINDEX,LOLN
PUSHJ P,FIND
TRZ FL,LINSN ;NO LINES YET
SETZM FNDFLG ;NO MATCHES EITHER
ONSRC: PUSHJ P,ONMOV ;CHECK RANGE
JRST ENDSRC ;DONE
TLZE FL,ASSMF ;FIRST TIME AND WANT .+1?
JRST [CAME T1,LOLN ;IS THERE EXACT MATCH?
JRST .+1 ;NO, THIS IS .+1
AOS SVCNT ;PRETEND WE DIDNT SEE IT
JRST SRNXT] ;AND TAKE NEXT
TRO FL,LINSN ;WE SAW ONE
CAMN T1,PGMK ;PAGES ARE SPECIAL
JRST SRCPAG ;SO TAKE GOOD CARE OF THEM
MOVEI T2,SRPNT ;POINTER TO STRINGS
PUSHJ P,COMSRC ;GO SEARCH THIS LINE
JRST SRNXT ;LOSER
SETOM FNDFLG ;FOUND!
MOVEM T3,SVCCNT ;SAVE AWAY THE CHARACTER COUNT
MOVE T2,CPG ;GET CURRENT PAGE
TRNN FL2,NONUMF ;DON'T PRINT IF NONUMBER MODE
CAMN T2,SRPG ;SEE IF WE SHOULD PRINT IT
SKIPA
PUSHJ P,PGPRN ;YES
MOVE T2,CPG ;NOW SET IT AS CURRENT
MOVEM T2,CPGL
MOVEM T2,SRPG ;ALSO RESET FLAG
MOVE T2,(PNTR) ;ALSO SET LINE
MOVEM T2,CLN
TLNE FL,ALTSRF ;ARE WE GOING TO EDIT?
JRST SRCALT ;YES, GO SET THINGS UP
TLNE FL,NUMSRF ;DO WE WANT ONLY LINE NUMBERS?
JRST SRCNUM ;YES
MOVE T1,PNTR ;GO PRINT LINE
PUSHJ P,OUTLIN
SRNXTC: SOSG SRCNT ;HAVE WE FOUND ENOUGH
JRST SRFND ;YES, GIVE UP (WE HAVE SEEN AT LEAST ONE)
SRNXT: PUSHJ P,FINDN ;GET NEXT LINE TO LOOK A
JRST ONSRC
SRCNUM: MOVE T1,(PNTR) ;PRINT SEQUENCE NUMBER
PUSHJ P,OUTSN
OCRLF
JRST SRNXTC ;AND GO
ENDSRC: TRZN FL,LINSN ;DID WE SEE ONE?
NERROR NLN ;NULL RANGE
SRFND: SKIPN FNDFLG ;FIND ANY?
RERROR SRF ;NO: TELL HIM
JRST COMND
SRCPAG: AOS CPG ;JUST ADVANCE PAGE COUNTER
JRST SRNXT ;AND PROCEED
SRCALT: PUSHJ P,SETALT ;SET THINGS UP
SKIPLE T2,SVCCNT ;GET COUNT (DO NOT CALL IF 0
PUSHJ P,ALTSP ;SPACE OVER CORRECTLY
PUSHJ P,ALTN1 ;GO ALTER
JRST LEVINS ;HE SAID ALTMODE
PUSHJ P,INSED ;INSERT IT
PUSHJ P,FINDN
PUSHJ P,FILLB ;MAKE SURE WE HAVE NOT GOTTEN TOO BIG
MOVE T1,(PNTR) ;GET POINTER BACK
SOSG SRCNT
JRST COMND ;DONE
JRST ONSRC ;GO ON
ASSMD1: TROA FL,CNTF ;MARK AS KEEP END OF RANGE
ASSMDT: TRZ FL,CNTF ;JUST IN CASE
TLO FL,ASSMF ;WE ASSUME .+1
MOVE T1,CLN ;SET THINGS UP FOR . TO INFINITY
MOVEM T1,LOLN
MOVEM T1,HILN ;AS GOOD AS ANYTHING WITH THE PAGE WE WILL
MOVE T1,CPGL ;USE
MOVEM T1,LOPG
TRZE FL,CNTF ;KEEP END?
JRST NOSPC ;YES
CAIE C,":" ;IF A : OR !
CAIN C,"!"
JRST HALFSP ;GET THE SECOND HALF (.+1 TO GIVEN)
MOVSI T1,377777 ;GET A LARGE PAGE
MOVEM T1,HIPG
JRST SRC4 ;BACK INTO THINGS
HALFSP: MOVEM T1,HIPG ;SET TOP AS /.
PUSHJ P,GET2HF ;GET THE SECOND HALF
JRST SRC4 ;AND GO
NOSPC: MOVE T1,SRHIPG
MOVEM T1,HIPG ;PUT BACK END
MOVE T1,SRHILN
MOVEM T1,HILN
JRST SRCH1A
LEVINS: OCRLF ;YES - PUT OUT CRLF
SETZM ALTSN ;CLEAR FLAG
JRST COMND
SUBTTL ALTMODE AND LINE FEED COMMANDS
NXTLIN: PUSHJ P,NBFIND ;GET CURRENT LINE
CAMN T1,CLN ;DID WE REALLY FIND IT
PUSHJ P,FINDN ;YES, GET NEXT ELSE WE ALREADY HAVE IT
JUMPE T1,[NERROR NLN] ;EOF AND NOT FOUND
OUTCHR [15]
TRNE FL,DPYF
OUTSTR [BYTE (7)32,177,177,177]
NXTL1: CAMN T1,PGMK ;IS THIS A PAGE MARK?
JRST NXTPG ;TREAT SPECIALLY
NBPRNT: MOVEM T1,CLN ;SET AS CURRENT
MOVE T1,PNTR ;GET THE CURRENT POINTE
TRNE FL2,NONUMF
TRO FL2,SUPN
PUSHJ P,OUTLIN ;AND PRINT
TRZ FL2,SUPN
JRST COMND ;DONE
NXTPG: AOS T2,CPG ;WE ARE ON THE NEXT PAGE
MOVEM T2,CPGL
TRNN FL2,NONUMF
PUSHJ P,PGPRN ;TELL HIM
PUSHJ P,FINDN ;FIND A LINE ON IT
JUMPN T1,NXTL1 ;THERE IS ONE THERE, PRINT IT
MOVE T1,[ASCII /00000/] ;END OF FILE, SET TO THAT PAGE
MOVEM T1,CLN
JRST COMND
BAKLIN: PUSHJ P,NBFIND ;GET CURRENT LINE
TRNE FL,BOF ;IF NOT AT START OF FILE
CAME PNTR,BUFP ;OR NOT AT START OF BUFFER
SKIPA
NERROR NLN
OUTCHR [15]
TRNN FL,DPYF
OUTCHR [12]
BAK1: PUSHJ P,FINDB
CAME T1,PGMK
JRST NBPRNT
MOVE T2,CPG
MOVEM T2,CPGL
TRNN FL2,NONUMF
PUSHJ P,PGPRN
TRNE FL,BOF ;CHECK FOR START OF WORLD
CAME PNTR,BUFP
JRST BAK1 ;OK, BACK UP SOME MOR
MOVE T1,[<ASCII /00000/>!1]
MOVEM T1,CLN
JRST COMND
NBFIND: MOVE T1,CPGL ;CURRENT PAGE
MOVEM T1,DPG
MOVE SINDEX,CLN ;AND CURRENT LINE
JRST FIND ;GO FETCH
SUBTTL COPY AND TRANSFER COMMANDS
TRANS: TLOA FL,TRANFL ;SET AS TRANSFER COMMAND
COPY: TLZ FL,TRANFL ;JUST TO MAKE SURE
SETZM HILN ;THIS, TOO MAY PROVE USEFUL
SETZM LOLN ;A GOOD THING TO DO
TRNE FL,READOF ;DO NOT LET HIM IN READ ONLY MODE
NERROR ILC
SETZM SVJRL2 ;NO SECOND JOBREL SAVED
PUSHJ P,GET1S ;GET PLACE TO PUT LINES
MOVE T1,HIPG ;STORE IT AWAY FOR LATER
MOVEM T1,DESTPG
MOVE T1,HILN
MOVEM T1,DESTLN
CAIE C,"_" ;...
CAIN C,"=" ;DOES HE WANT TO COME FROM ANOTHER FILE?
JRST ALTFIL ;YES
TLZ FL,COPFIL ;NO, MAKE SURE FLAG IS OFF
COPY1:
CAIE C,"," ;SHOULD BE COMMA EVEN IF FROM ALTFIL
NERROR ILC ;HE MUST SAY WHERE TO PUT IT
PUSHJ P,COPYP ;PARSE RANGE ARGS
COPY2: SETOM NLIN1 ;LINES ON FIRST PAGE
SETZM NLIN2 ;LINES ON LAST PAGE
TLO FL2,NORENT ;AND REE-ENTER
TLZ FL2,RENTF ;IN CASE HE HAS
TLO FL,ISCOP ;SO WE WILL DO SPECIAL RESET IF ERROR
MOVE ALTP,.JBREL## ;SET UP SAVE POINTER
MOVEM ALTP,SVJRL ;SO WE CAN RESET IT
MOVEI T1,2000(ALTP) ;ASK FOR ANOTHER 1K
CORE T1,
NERROR NEC ;ALL OUT, GIVE UP
HRLI ALTP,-2000 ;SET COUNT OF HOW MUCH IS THERE
SETZM LSTPG ;HAVE SEEN NO PAGES YET
MOVE T1,LOPG ;LOOK FOR SOURCE
MOVEM T1,DPG
MOVE SINDEX,LOLN
PUSHJ P,FIND
TRZ FL,LINSN ;AND NO LINES
TLNN FL,TRANFL ;IS THIS A TRANSFER COMMAND?
JRST GOCOP ;NO, IGNORE ALL THIS SPECIAL STUFF
HRRZM ALTP,STARTD ;SAVE THE START OF DELETED CODE
HRRZM ALTP,ENDD ;AND THE END
MOVE T1,CPG ;GET THE PAGE ON WHICH DELETION STARTS
MOVEM T1,TRANST ;AND SAVE IT
SKIPN -1(PNTR) ;ARE WE AT THE START OF THE BUFFER
TRNN FL,BOF ;AND OF THE WORLD
SKIPA
JRST BEGFIL ;YES, DO NOT LOOK BACK
PUSHJ P,FINDB ;GET THE PREVIOUS LINE
CAMN T1,PGMK ;A PAGE IS SPECIAL
JRST SPCPG
MOVEM T1,BOTLIN ;SAVE IT FOR LATER
PUSHJ P,FINDN ;GO FORWARD AGAIN
JRST GOCOP
SPCPG: SKIPE LOLN ;DO WE INTEND TO ABSORD THIS ONE
JRST BEGFIS ;MOVE FORWARD AND RECORD
SKIPN -1(PNTR) ;CHECK FOR START OF WORLD AGAIN
TRNN FL,BOF
SKIPA
JRST BEGFIS
PUSHJ P,FINDB ;BACK UP
AOS CPG ;FIX PAGE COUNT
PUSH P,T1 ;SAVE THAT LINE
PUSHJ P,FINDN
PUSHJ P,FINDN ;AND GO BACK WHERE WE BELONG
POP P,T1 ;GET LINE NUMBER BACK
CAMN T1,PGMK ;THERE'S THAT PAGE AGAIN
JRST BEGFIA
MOVEM T1,BOTLIN ;SAVE LINE NUMBER
JRST GOCOP
BEGFIS: AOSA CPG
BEGFIA: AOSA CPG
BEGFIF: PUSHJ P,FINDN
BEGFIL: SETOM BOTLIN ;A VERY SMALL NUMBER
GOCOP: SETZM PGDELS ;TOTAL NUMBER OF PAGES DELETED IS 0
SKIPE LOLN ;DID HE ASK FOR THE WHOLE PAGE
JRST NOISTP ;NO
MOVE T1,PGMK ;YES, PUT IN THE PAGE MARK
MOVEM T1,1(ALTP)
MOVE T1,PGMKW2 ;2ND WORD
MOVEM T1,2(ALTP)
HRRZM ALTP,LSTPG
ADD ALTP,[XWD 2,2]
SETZM NLIN1 ;NO LINES ON FIRST PAGE
TLNN FL,TRANFL ;IS THIS A TRANSFER
JRST NOISTP ;NO, START TRANSFER OF DATA
MOVE T1,CPG ;CHECK TO SEE IF WE SHOULD REALLY DELETE
CAIN T1,1 ;NOT IF PAGE 1
JRST RSTSTP
PUSHJ P,FINDB ;GET THAT PAGE
SETZM NCNT ;DELETE
MOVEI T1,2
MOVEM T1,OCNT
PUSHJ P,INSED
PUSHJ P,FINDN1 ;MAKE SURE WE ARE AT THE LINE WE WERE AT
AOS CPG ;KEEP COUNT STRAIGHT
AOSA PGDELS ;ONE DELETED
RSTSTP: HRRZM ALTP,STARTD ;RESET START IF NONE DELETED
HRRZM ALTP,ENDD ;RESET END
NOISTP: MOVE T1,(PNTR) ;MAKE SURE WE HAVE THAT JUNK BACK
ONCOPY: PUSHJ P,ONMOV ;STILL IN RANGE?
JRST ENDCOP ;NO, START INSERTING
TRO FL,LINSN ;WE SAW ONE
CAMN T1,PGMK ;IS IT A PAGE?
JRST MOVPG ;YES, TREAT SPECIAL
AOS NLIN2 ;INCR LINE SEEN
MOVLCT: MOVE T1,PNTR ;START TRANSFER
MOVE T2,(T1) ;PICK UP FIRST WORD (SEQ NUM)
MOVEM T2,LSTLN ;SAVE FOR INC CALC
TRLIN: MOVEM T2,1(ALTP) ;PUT LINE AWAY
AOBJP ALTP,RESTCR ;NEED MORE CORE?
TRLIN1: SKIPN T2,1(T1) ;END OF LING?
JRST NXTLCT
TRNN T2,1
AOJA T1,TRLIN ;NO MOVE NEXT WORD
NXTLCT: TLNN FL,TRANFL ;IS THIS TRANSFER?
JRST NXTLCP ;NO, DON'T DELETE
HRRZM ALTP,ENDD ;SAVE END OF DELETED TEXT
SETZM NCNT
SUBI T1,-1(PNTR) ;GET LENGTH
MOVEM T1,OCNT
PUSHJ P,INSED
PUSHJ P,FINDN1 ;MAKE SURE A LINE IS THERE
SKIPA ;SKIP THE FINDN
NXTLCP: PUSHJ P,FINDN ;YES, GET NEXT
JRST ONCOPY
MOVPG: AOS CPG ;WE ARE ON NEXT PAGE
MOVE T1,NLIN2
SKIPGE NLIN1 ;PUT ON FIRST PAGE IF NOT SOME ALREADY THERE
MOVEM T1,NLIN1
SETZM NLIN2
HRRZM ALTP,LSTPG ;SAVE RECORD OF WHERE SEEN
AOS PGDELS ;RECORD ONE MORE PAGE DELETED
JRST MOVLCT ;NOW MOVE IT
RESTCR: MOVE T2,.JBREL## ;GET END
ADDI T2,2000
CORE T2, ;GET MORE
NERROR NEC
HRLI ALTP,-2000
JRST TRLIN1 ;AND CONTINUE
ENDCOP: TRNN FL,LINSN ;WERE THERE ANY THERE?
NERROR NLN ;NO LOSE
SETZM 1(ALTP) ;MAKE SURE THERG IS AN END FLAG THERE
TLZE FL,COPFIL ;ARE WE COMMING OFF A FILE
PUSHJ P,RSCOP ;YES, RESET POINTERS
MOVE T1,DESTPG ;LOOK FOR DESTINATION
MOVEM T1,DPG
TLNN FL,TRANFL ;IS IT A TRANSFER?
JRST DOINS1 ;NO, PUT THE COPIED TEXT IN
SETZM PGINSD ;NO EXTRA PAGE MARK INSERTED YET
SKIPN T2,(PNTR) ;ARE WE AT EOF
JRST NOPGIN ;YES, DO NOT INSERT A PAGE MARK
CAME T2,PGMK ;ALSO NOT IF PAGE MARK
CAMLE T2,BOTLIN ;OR GREATER THAN LINE LEFT OVER
SKIPA
SETOM PGINSD ;WE WILL HAVE TO INSERT ONE
NOPGIN: MOVN T2,PGDELS ;GET MINUS NUMBER OF PAGES DELETED
SUB T2,PGINSD ;ONE LESS IF A PAGE MARK INSERTED
CAMGE T1,TRANST ;(T1 HAS DEST. PAGE) IF SMALLER THAN START
JRST DOSUB ;EVERYTHING IS OK
CAMN T1,TRANST ;IS IT SAME?
JRST DSEQTR ;SPECIAL CHECK REQUIRED
CAMGE T1,CPG ;INSIDE RANGE DELETED?
NERROR ITD ;LOSE BIG
CAMN T1,CPG ;SAME AS TOP PAGE?
JRST DSEQCP
ADDM T2,DESTPG ;ADJUST PGE WE ARE TO FIND
ADDM T2,DPG
DOSUB: ADDM T2,CPG ;ADJUST FOR REMOVED PAGES
ADDM T2,INPG
ADDM T2,BGPG
SKIPN PGINSD ;SEE IF WE WANT TO INSERT ONE
JRST DOINS1
MOVE T1,PGMK
MOVEM T1,LIBUF
MOVE T1,PGMKW2
MOVEM T1,LIBUF+1
SETZM OCNT
MOVEI T1,2
MOVEM T1,NCNT
PUSHJ P,INSED
PUSHJ P,FINDN ;ADVANCE OVER IT
PUSHJ P,FILLB ;IN CASE OF OVERFLOW
OUTSTR [ASCIZ /%Page mark inserted to prevent order error
/]
JRST DOINS1
ALLSAM: SKIPN LOLN
SKIPE PGINSD ;IF DID NOT DELETE PAGE OR INSERTED ONE
JRST DOSUB ;ALL OK
SKIPE T1,(PNTR) ;ELSE MUST BE IN UPPER PART
CAMN T1,PGMK
NERROR ITD ;THERE IS NO UPPER PART
CAMLE T1,DESTLN
NERROR ITD
SOS T1,DESTPG ;THIS WILL BE ON A LOWER PAGE
MOVEM T1,DPG
JRST DOSUB
DSEQTR: CAMN T1,CPG ;IS IT ALL ON SAME PAGE?
JRST ALLSAM ;YES, SPECIAL CHECKING
SKIPN LOLN ;DID WE START WITH A PAGE
NERROR ITD ;YES, LOSE
SKIPE PGINSD ;WAS THERE A PAGE INSERTED?
JRST DOSUB ;YES, ALL OK
SKIPE T1,(PNTR) ;FIND OUT WHAT THE NEXT LINE IS
CAMN T1,PGMK
JRST DOSUB ;THIS WILL BE OK
CAMG T1,DESTLN ;SEE IF WE ARE IN TROUBLE
NERROR ITD
JRST DOSUB ;OK
DSEQCP: SKIPE PGINSD ;WAS ONE INSERTED
JRST AOSTRA ;SET PAGE PROPERLY
MOVE T1,DESTLN
CAMG T1,BOTLIN
NERROR ITD
SKIPA T1,TRANST
AOSTRA: AOS T1,TRANST
MOVEM T1,DESTPG
MOVEM T1,DPG ;ALSO SET THIS
JRST DOSUB
DOINS1: MOVE SINDEX,DESTLN
PUSHJ P,FIND
PUSH P,T1 ;SAVE LINE FOUND
MOVE T1,CPG
CAMN T1,DESTPG ;PAGES MUST MATCH
JRST DOINS2
TLNN FL,TRANFL ;ONLY TRANSFER
NERROR NSP ;ERROR IF COPY
MOVE T1,PGMK
MOVEM T1,LIBUF
MOVE T1,PGMKW2
MOVEM T1,LIBUF+1
SETZM OCNT
MOVEI T1,2
MOVEM T1,NCNT
PUSHJ P,INSED
PUSHJ P,FINDN
PUSHJ P,FILLB
AOS CPG
AOS INPG
AOS BGPG
OUTSTR [ASCIZ /%Text inserted at end of file
/]
MOVE T1,CPG
DOINS2: MOVEM T1,CPGL ;SET THIS AS CURRENT PAGE
POP P,T1 ;RETRIEVE LINE FOUND
MOVE T2,[<ASCII /00100/>!1]
MOVEM T2,CLN ;AND THIS AS CURRENT LINE
MOVEM T2,SVLNUM
MOVE ALTP,SVJRL ;POINT TO START OF LINES TO COPY
TLZ FL,TRANFL ;THIS FLAG NO LONGER NEEDED
TWOSET: SKIPGE NLIN1 ;DID WE SEE ANY PAGE MARKS?
JRST ONSET ;NO -- JUST NEED ONE INCR
MOVEM T1,HIGH1 ;SAVE THIS FOR LATER
MOVE T3,NLIN2 ;NUMBER OF LINES ON LAST PG
MOVE T2,[<ASCII /00000/>!1]
MOVE T1,T2 ;COMPUTE CORRECT INCR
PUSHJ P,GETDIF ;CALL ROUTINE
JRST ORDSEC ;ORDER PROB
MOVEM T1,START2 ;PLACE TO START FOR LAST PAGE
SKIPN SINCR ;DID HE SAY ONE
JRST [MOVE T1,LSTLN ;LAST LINE SEEN
CAML T1,(PNTR) ;HOW'S IT LOOK?
JRST ONST3 ;NOT GOOD ENOUGH
JRST OKINC2]
CAML T2,SINCR ;SEE WHOSE IS BETTER
JRST OKINC2 ;WE'LL USE HIS
ONST3: MOVEM T2,SINCR ;OURS IS BETTER
ONST2: MOVEM T2,PRNTO2 ;INFOR HIM OF THE CHANGE
OUTSTR ASCIZ2
OKINC2: SKIPG T3,NLIN1 ;CHECK FOR P/M ONLY
JRST INSL2 ;ALL SET FIRST THING IS P/M
MOVE T1,HIGH1 ;RETRIEVE WHAT WE FOUND
MOVE T2,DESTLN ;WHAT HE WANTED
TLO T3,(1B0) ;DON'T LOOK AT NEXT LINE
PUSHJ P,GETDIF
JRST ORDCP2 ;ORDER PROBLEM WILL FOLLOW
MOVEM T1,CLN ;SET UP GOOD THINGS
MOVEM T1,SVLNUM
CAML T2,FINCR ;WHICH IS BETTER
JRST INSL2 ;HIS
MOVEM T2,FINCR ;OURS
JRST ONST1 ;TELL HIM WE CHANGED HIS MIND
ONSET: SKIPG T3,NLIN2 ;GO ANYTHING TO WORRY ABT
JRST INSL2 ;NO -- DO OUR WORST
MOVE T2,DESTLN ;HIS DESIRED PLACE
PUSHJ P,GETDIF ;SEE WHAT THERE IS TO SEE
JRST ORDCOP ;ORDER PROBS
MOVEM T1,SVLNUM ;SET THE GOOD S--T
MOVEM T1,CLN
CAML T2,FINCR ;THE MOMENT OF TRUTH
JRST INSL2 ;THAT CRAFTY FELLOW
MOVEM T2,FINCR ;TELL HIM HE BLEW IT
ONST1: MOVEM T2,PRNTO1 ;PUT IN IN PRINT POSITION
OUTSTR ASCZ1
JRST INSL2 ;HE HAS BEEN TOLD
ORDCP2: SKIPA T2,[ASCII /WAR /]
ORDCOP: MOVE T2,[ASCII /ORDER/]
JRST ONST1
ORDSEC: MOVE T2,[ASCII /ORDER/]
JRST ONST2
;CONVERT INTEGER IN T1 TO SEQ # IN T3
ASCON: MOVSI T3,400000 ;WILL BECOME LOW ORDER BIT
ASCO2: IDIVI T1,^D10
ADDI T2,"0"
LSHC T2,-7
TRNN T3,1 ;HAS IT GOTTEN THERE?
JRST ASCO2
POPJ P,
;CONVERT SEQ # IN T3 TO INTEGER IN T1
NUMCON: MOVEI T1,0
TRZ T3,1 ;GET RID OF LOW ORDER BIT
NUMC1: MOVEI T2,0
LSHC T2,7
IMULI T1,^D10
ADDI T1,-"0"(T2)
JUMPN T3,NUMC1
POPJ P,
INSLN: MOVE T2,FINCR ;GENERATE NEW SEQUENCE NUMBER
SKIPN T1,SVLNUM ;BUT ONLY IF WE ARE SUPPOSED TO
JRST INSL2
PUSHJ P,ASCIAD
MOVEM T1,SVLNUM ;PUT EITHER NGW OR 0 BACK
INSL2: SETZM LIBUF ;ZERO OUT PLACE TO PUT LINE
MOVE T1,[XWD LIBUF,LIBUF+1]
BLT T1,LIBUF+MXWPL+1
MOVEI T1,LIBUF ;SET UP OUTPUT POINTER
SKIPN T2,1(ALTP) ;AT END?
JRST INSDON ;FINISHED
INS1: MOVEM T2,(T1) ;PUT IT AWAY
ADDI ALTP,1 ;NEXT
SKIPN T2,1(ALTP) ;CHECK FOR END OF LING
JRST INS2
TRNN T2,1 ;BY EITHER METHOD
AOJA T1,INS1 ;GO ON WITH TRANSFER
INS2: SUBI T1,LIBUF-1 ;GET COUNT
MOVEM T1,NCNT ;AND SET AS NEW
SETZM OCNT ;OLD IS ZERO
MOVE T1,LIBUF ;GET SEQ NUM
CAMN T1,PGMK ;CHECK FOR PAGE
JRST INSPG ;AND DO SPECIAL
SKIPN T1,SVLNUM ;IF A NON-ZERO NUMBER THEN REPLACE
MOVE T1,LIBUF
MOVEM T1,LIBUF
NOINCR: MOVEM T1,CLN ;SET AS CURRENV LINE
PUSHJ P,INSED ;INSERT IT
PUSHJ P,FINDN ;GET NEXT
PUSHJ P,FILLB ;AND DUMP IF NEEDED
JRST INSLN ;GO PUT IN MORE
INSPG: AOS T3,CPG ;WE ARE ON THE NEXT PAGE
MOVEM T3,CPGL ;SET AS CURRENV
MOVE T1,[<ASCII /00000/>!1] ;SET TO SAY LINE 0
AOS BGPG ;ONE MORE PAGE IN FILE
AOS INPG
SETZM SVLNUM ;DO NOT DO ANY MORE SEQUENCE REPLACEMENT
MOVEI T2,-2(ALTP) ;SINCE WE HAVE ALREADY GONE PAST
CAMN T2,LSTPG ;UNLESS STARTING LAST PAGE
SKIPN T3,SINCR ;ANF SECOND SEQUENCE NUMBER GIVEN
JRST NOINCR
MOVEM T3,FINCR ;SET UP INCREMENT
MOVE T3,START2 ;GET LAST PAGE START
MOVEM T3,SVLNUM
MOVEM T1,CLN
PUSHJ P,INSED ;INSERT IT
PUSHJ P,FINDN ;TO NEXT
PUSHJ P,FILLB ;SLURP
JRST INSL2 ;GO DO IT
INSDON:
COPDON: RELEASE ALTDV,0 ;JUST FOR GOOD MEASURE
TLZE FL,COPFIL ;ARE WE COPYING FROM A FILE (ERRORS ONLY)
PUSHJ P,RSCOP ;YES, CLEAN UP POINTERS
TLZ FL,ISCOP ;RESET COPY FLAG
TLNN FL,TRANFL ;IF TRANSFER, WE MUST REINSERT
JRST COPD1 ;NO
MOVE ALTP,STARTD
REINXT: MOVEI T1,LIBUF
CAMN ALTP,ENDD
JRST COPD1 ;ALL DONE
MOVE T2,1(ALTP)
JRST REINWD
REINS: MOVE T2,1(ALTP)
CAME ALTP,ENDD
TRNE T2,1
JRST ENDLIN ;DONE WITH THIS LINE
REINWD: MOVEM T2,(T1)
ADDI T1,1
AOJA ALTP,REINS
ENDLIN: SETZM OCNT
SUBI T1,LIBUF
MOVEM T1,NCNT
PUSHJ P,INSED ;INSERT LINE
PUSHJ P,FINDN
PUSHJ P,FILLB ;IN CASE OF OVERFLOW
JRST REINXT
COPD1: SKIPN T1,SVJRL2 ;USE THIS IF SET
MOVE T1,SVJRL ;ELSE THIS
CORE T1, ;TO RESTORE PROPER AMOUNT OF CORE
ERROR ICN ;THIS SHOULD NEVER HAPPEN
JRST COMND ;FINISH UP
ALTFIL: TLZE FL,TRANFL ;GIVE WARNING IF TRANSFER
OUTSTR [ASCIZ /% WARNING - Copy assumed
/]
PUSHJ P,SCAN
PUSHJ P,READNM
NERROR ILC
MOVE T1,[TMPBLK,,ALTBLK]
BLT T1,ALTBKE ;SAVE IN CORRECT PLACE
DONNAM: MOVE T1,.JBREL## ;SET THINGS UP
MOVEM T1,SVJRL2
ADDI T1,4000 ;ASK FOR 1 K FOR BUFFERS
TLO FL,ISCOP ;TELL THE WORLD WHAT WE HAVE DONE
CORE T1, ;IS IT THERE?
NERROR NEC
MOVE T1,SVJRL2 ;POINT BUFFERS TO RIGHT PLACE
MOVEM T1,.JBFF##
MOVE T1,ALTDEV ;GET DEVICE
MOVEM T1,ALDEVI+1
OPEN ALTDV,ALDEVI ;DO OPEN
NERROR DNA ;MAYBE ITS HEREDITARY
XLOOK ALTDV,ALTBLK ;LOOK FOR FILE
NERROR FNF
INBUF ALTDV,0 ;GET BUFFER SPACE
PUSH P,SAVEN ;TURN OFF AUTO-SAVE
SETZM SAVEN
MOVE T1,.JBREL##
SUBI T1,2*MXWPL+2 ;SET UP THE VARIOUS POINTERS
PUSH P,FILPT ;SEE STPT FOR MORE INFO
MOVEM T1,FILPT
MOVEI T1,1
PUSH P,CPGL
MOVEM T1,CPGL
MOVE T1,[<ASCII /00000/>!1]
PUSH P,CLN
MOVEM T1,CLN
MOVE T1,.JBFF##
SETZM (T1)
ADDI T1,1
PUSH P,BUFP
MOVEM T1,BUFP
MOVE T1,.JBREL##
SUB T1,BUFP
MOVE T2,T1
SUBI T2,MXWPL+1
PUSH P,MAXWC
MOVEM T2,MAXWC
ASH T1,-1
PUSH P,HLFWC
MOVEM T1,HLFWC
MOVEI T1,1
PUSH P,CPG
PUSH P,INPG
MOVEM T1,CPG
MOVEM T1,INPG
PUSH P,PNTR
MOVE PNTR,BUFP
PUSH P,SVWD
SETZM SVWD
PUSH P,OLDLIN
SETZM OLDLIN
PUSH P,WC
SETZM WC
MOVSI T1,1
PUSH P,BGPG
MOVEM T1,BGPG
PUSH P,BASICF
SETZM BASICF
SKIPE RSW
JRST [SETZM RSW
SETOM SSW ;SET BROWSE MODE ALSO
SETOM BASICF
JRST .+1]
MOVE T1,FL ;SAVE SELECTED FLAGS
AND T1,[XWD TECOF+FSTOPF,READOF!BOF!EOF!EOF2!BGSN]
PUSH P,T1
TRZ FL,EOF!EOF2
TRO FL,READOF!BOF
TLZ FL,TECOF
TLO FL,FSTOPF
MOVEM P,COPDL ;SAVE PDL FOR LATER
TLO FL,COPFIL ;WE ARE USING OTHER FILE POINTERS
PUSHJ P,FILLBF
SKIPN SSW
JRST COPY1
TRNN FL,TERMF ;MUST END HERE
NERROR ILC
TLO FL,SRCOP ;SET THINGS UP
JRST COMND ;AND GO GET COMMANDS
DSCOP: PUSHJ P,GNCH ;GET NEXT CHAR
ANDI C,137 ;FORCE UPPER
CAIN C,"Q" ;CHECK FOR SPECIAL
JRST NOCOP ;YES - DO NOTHING
MOVEM C,SAVC ;BACK UP SCANNER
PUSHJ P,SCAN
TRNN FL,TERMF
NERROR ILC
OUTSTR [ASCIZ /Source lines=/]
SETZM LOLN ;THIS MAY HAVE GOTTEN RESET
SETZM SAVCHR ;CLEAR THINGS OUT
SETZM SSW ;FORGET THIS SWITCH
PUSHJ P,COPYP ;GET SOURCE LINES
TLZ FL,SRCOP ;TURN OFF FLAG
JRST COPY2 ;CONTINUE
COPYP: PUSHJ P,GET2S ;GO GET PLACE TO FIND LINES
MOVE T1,INCR ;SEV INCREMENT AS CURRENT
MOVEM T1,FINCR
SETZM SINCR ;SET NO SECOND INCREMENT
CAIE C,"," ;CHECK FOR MORE ARGUMENTS
JRST COPYP1 ;NO, LOOK FOR TERMINATOR
PUSHJ P,SCAN
CAME T1,[<ASCII /00000/>!1] ;AVOID 0 INCREMENTS
TRNN FL,NUMF ;SHOULD BE INCREMENT, MUST BE NUMBER
NERROR ILC
MOVEM T1,FINCR
PUSHJ P,SCAN
CAIE C,","
JRST COPYP1
PUSHJ P,SCAN
CAME T1,[<ASCII /00000/>!1]
TRNN FL,NUMF
NERROR ILC
MOVEM T1,SINCR
PUSHJ P,SCAN
COPYP1: TRNN FL,TERMF
NERROR ILC ;DID NOT END PROPERLY, LOSE
POPJ P, ;RETURN
NOCOP: PUSHJ P,SCAN ;CHECK EOL
TRNN FL,TERMF
NERROR ILC
TLZ FL,SRCOP ;TURN OFF COPY
JRST COPDON
RSCOP: POP P,T2
MOVE P,COPDL ;GET PDL BACK
POP P,T1
TRZ FL,READOF!BOF!EOF!EOF2!BGSN ;RESTORE SELECTED FLAGS
TLZ FL,TECOF!FSTOPF
IOR FL,T1
POP P,BASICF
POP P,BGPG
POP P,WC
POP P,OLDLIN
POP P,SVWD
POP P,PNTR
POP P,INPG
POP P,CPG
POP P,HLFWC
POP P,MAXWC
POP P,BUFP
POP P,CLN
POP P,CPGL
POP P,FILPT
POP P,SAVEN ;RESTORE AUTO-SAVE
JRST (T2) ;NOW RETURN
COPGET: SOSG ALTBF+2 ;GET A WORD FROM COPY FILE
JRST GETDCT
GETWCT: ILDB T3,ALTBF+1
JUMPE T3,COPGET
POPJ P,
GETDCT: INPUT ALTDV,0
STATO ALTDV,760000
JRST GETWCT
STATZ ALTDV,740000
ERROR DIE
TRO FL,EOF
MOVEI T3,0
POPJ P,
CKTEC2: SETSTS ALTDV,1
MOVSI T3,(<POINT 7,0>)
HLLM T3,ALTBF+1
MOVEI T3,5
IMULM T3,ALTBF+2
AOS ALTBF+2
JRST RDTECO
SUBTTL SUBSTITUTE COMMAND (REPLACES THINGS)
;ALSO KNOWN AS SUBSTITUTE
SUBST: TLZ FL,ASSMF ;DO NOT ASSUME ANYTHING YET
TRNE FL,READOF
NERROR ILC
SETZM LOLN ;A GOOD THING
SETZM PARCNT ;ZERO COUNT FOR SEQUENTIAL PARTIALS
HRLOI T1,377777 ;SET FOR LOTS
MOVEM T1,RPCNT
MOVE T1,[POINT 7,R1BUF]
MOVEI T3,R1PNT
PUSHJ P,SSTRNG ;THIS CODE IS JUST LIKE SEARCH
JRST [SKIPE R2PNT ;BOTH STRINGS MUST HAVE BEEN GIVEN
SKIPN R1PNT
NERROR NSG ;ELSE THERE HAS BEEN AN ERROR
CAIN C,12 ;CHECK FOR JUST A CRRET
JRST ASBMD1 ;AND DO A CONTINUE
JRST NOSTR] ;THERE IS NO STRING
MOVE T1,[POINT 7,R2BUF] ;GET STRING TO REPLACE BY
MOVEI T3,R2PNT
PUSHJ P,SSTRNG
JRST [CAIN C,12
JRST [PUSH P,[.] ;SET UP RETURN
JRST RETSTR] ;AND READ MORE (FISRT NULL)
MOVEM T1,R2PNT ;NULL STRING MEANS DELETE
MOVEI T2,0 ;SO SET A REAL NULL STRING
IDPB T2,T1
JRST .+1]
SUBI T3,R2PNT ;GENERATE NUMBER OF REPLACEMENT STRINGS
MOVEM T3,RSTRCT ;AND SAVE FOR LATER
NOSTR: TLZ FL,NOPRN!DECID!EXCTS1 ;CLEAR FLAGS
PUSHJ P,SCAN ;AND START LOOKING FOR MORE JUNK
TRNN FL,TERMF ;NOTHING
CAIN C,"," ;OR JUST A COMMA
JRST ASBMDT ;THEN SEARCH FROM HERE TO ETERNITY
CAIE C,"!" ;HE ONLY WANTS TO GIVE A STOPPING POINT
CAIN C,":"
JRST ASBMDT
PUSHJ P,GET2 ;GO GET A RANGE
REP4: MOVE T1,HILN ;SAVE FOR POSSIBLE CONTINUE
MOVEM T1,RPHILN
MOVE T1,HIPG
MOVEM T1,RPHIPG
CAIE C,"," ;IS THERE MORE?
JRST REP1 ;NO
PUSHJ P,SCAN ;SEE WHAT IT IS
TRNN FL,IDF ;POSSIBLY AN IDENT
JRST REP2 ;NO MAYBE A NUMBER OF TIMES
MOVS T1,ACCUM
CAIN T1,(<SIXBIT /N />)
TLO FL,NOPRN ;SET FOR NO PRINTING
CAIN T1,(<SIXBIT /D />)
TLO FL,DECID ;HE WANTS TO BE ABLE TO DECIDE
TLNN FL,DECID!NOPRN ;IF NEITHER
JRST REP3 ;THEN TRY FOR E SWITCH
PUSHJ P,SCAN ;SEE IF THERE IS MORE
CAIE C,","
JRST REP1 ;END OF LINE
PUSHJ P,SCAN ;LOOK FOR STILL MORE
TRNN FL,IDF
JRST REP2
MOVS T1,ACCUM
REP3: CAIE T1,(<SIXBIT /E />) ;IS IT THE EXACT SEARCH SWITCH
NERROR ILC ;NO,LOSAGE
TLO FL,EXCTS1
PUSHJ P,SCAN ;ONE LAST TRY
CAIE C,","
JRST REP1 ;GO CHECK TERMINATOR
PUSHJ P,SCAN ;ONLY ONE THING LEFT
REP2: TRNN FL,NUMF
NERROR ILC ;BUT IT WAS NOT
MOVEM T2,RPCNT ;SAVE IT AWAY
PUSHJ P,SCAN
REP1: TRNN FL,TERMF ;ALLS WELL THAT ENDS WELL
NERROR ILC ;BUT NOT THIS ONE
REP1A: MOVEI T1,R1PNT ;GET THE SEARCH CODE
PUSHJ P,CODSR
MOVE T1,LOPG
MOVEM T1,DPG
MOVEM T1,RPPG ;FOR PRINT OUTS
MOVE SINDEX,LOLN
PUSHJ P,FIND ;GET THAT LINE
TRZ FL,LINSN ;NOTHING YET
SETZM FNDFLG ;NO HOW
TLNE FL2,PDECID
TLO FL,DECID ;SET IF PERM MODE ON
ONREP: PUSHJ P,ONMOV ;CHECK FOR STILL IN RANGE
JRST ENDREP ;FINALLY
TLZE FL,ASSMF ;SHOULD WE START WITH .+1
JRST [CAME T1,LOLN ;IS IT THE ONE WE ASKED FOR
JRST .+1 ;NO, USE IT
AOS SVCNT ;JUST IN CASE A ! TYPE OF RANGE
JRST RPNXT]
TRO FL,LINSN ;THIS LINE IS GOOD ENOUGH
CAMN T1,PGMK
JRST RPPAG ;GO TAKE CARE OF PAGE MARKS
MOVEI T2,R1PNT ;DO THE SEARCH
PUSHJ P,COMSRC
JRST RPNXT
SETOM FNDFLG ;FOUND
SKIPGE T3 ;PROTECT AGAINS SPECIAL KILLING TAB
IBP ALTP
PUSH P,T3 ;SAVE COUNT OF HOW FAR INTO LINE
MOVE T3,(PNTR) ;SET UP CURRENT LINE
MOVEM T3,CLN
MOVE T3,CPG
MOVEM T3,CPGL
MOVE T2,[XWD LIBUF,LIBUF+1] ;CLEAR IT OUT
SETZM LIBUF
BLT T2,LIBUF+MXWPL+1 ;WE WILL DO REPLACE HERE
MOVE T2,PNTR ;GET THE POINTER TO THE LINE
MOVE T3,(T2) ;PICK UP THE FIRST WORD
MOVEI T4,LIBUF ;THE PLACE TO PUT IT
JRST SBALT3 ;TRANSFER
SBALT2: SKIPE T3,(T2)
TRNE T3,1 ;IS IT THE END OF THE LINE
JRST SBALT1
SBALT3: MOVEM T3,(T4) ;PUT IT AWAY
ADDI T4,1
AOJA T2,SBALT2
SBALT1: SUBI T4,LIBUF ;GET SIZE LINE USED TO BE
MOVEM T4,OCNT
POP P,CCNT ;GET THE NUMBER OF CHRS INTO LINE
SKIPGE CCNT ;MUST BE .GE. 0
SETZM CCNT
SUBI ALTP,(PNTR) ;CONVERT POINTER TO LIBUF
ADD ALTP,[XWD 70000,LIBUF] ;AND BACK UP ONE
NXTRPL: SETZM PARCNT ;ZERO FOR NEXT REP
LDB T1,[POINT 4,-1(T1),12] ;GET STRING NUMBER
CAMLE T1,RSTRCT ;IS IT LARGER
MOVE T1,RSTRCT ;THEN USE LAST
MOVE T1,R2PNT(T1)
MOVSI T4,70000 ;DECREMENT POINTER
ADDM T4,SRCALP
REPSTR: ILDB C,T1 ;GET THE NEXT CHR
JUMPE C,ENDRP ;THE END OF THE REPLACE STRING
CAIN C,"" ;DOES HE WANT ONE OF THE PARTIAL THINGS
JRST PARSTR ;YES, GO HANDLE THAT
CAIN C," " ;CHECK FOR QUOTING NEXT CHR
JRST INSQT
CAIN C,"" ;SEQUENTIAL PARTIAL
JRST PARORD ;YES, GO HANDLE
PUTSTR: IDPB C,ALTP ;PUT IN THE REPLACEMENT
AOS C,CCNT ;ADVANCE COUNT
CAIL C,MXWPL*5 ;CHECK AGAINST MAX
NERROR LTL ;AND LOSE
JRST REPSTR
ENDRP: MOVE T3,CCNT ;GET COUNT SO SEARCH CAN GO ON
PUSH P,ALTP ;SAVE REPLACE POINTER
PUSH P,SRCALP ;AND THE END OF INPUT POINTER
MOVE ALTP,SRCALP ;CONTINUE FROM HERE
ILDB T1,SRCALP ;SEE WHAT CHAR WE STOPPED ON
CAIE T1,12 ;HAVE WE GONE TOO FAR?
PUSHJ P,COMSRT ;THIS WILL CONTINUE
JRST FINLIN ;ALL DONE WITH MATCHES, FINISH UP
CAIL T3,MXWPL*5 ;ARE THERE TOO MANY?
NERROR LTL
POP P,T2
DOMOV: ILDB C,T2 ;MOVE THE CHRS THAT DID NOT MATCH
CAMN T2,ALTP ;HAVE WE GOTTEN TO THE NEXT MATCH
JRST DONMOV ;YES
IDPB C,(P) ;THE BYTE POINTER IS STILL IN THE STACK
JRST DOMOV
DONMOV: MOVEM T3,CCNT ;PUT THE COUNT BACK IN CORE
POP P,ALTP ;THIS IS NOW THE DEPOSIT POINTER
JRST NXTRPL ;GO DO A REPLACE
FINLIN: POP P,SRCALP ;GET SET TO MOVE TO END
POP P,ALTP
ILDB C,2(P) ;WE JUST HAPPEN TO KNOW ITS STILL THERE
CAIE C,12 ;IF SO WE HAVE EATEN A RETURN
JRST ENDFIN ;ALL IS OK
FINL2: MOVEI C,15
SKIPA ;SO PUT IT IN
ENDFIN: ILDB C,SRCALP
IDPB C,ALTP
AOS CS,CCNT
CAIL CS,MXWPL*5
NERROR LTL
CAIE C,12
JRST ENDFIN ;DONE WHEN WE SEE THE LINE FEED
MOVEI T1,0 ;ZERO OUT REST OF THIS LINE
DOZER: TLNN ALTP,760000 ;POINTER AT END OF LINE?
JRST ZEROD
IDPB T1,ALTP
JRST DOZER
ZEROD: SUBI ALTP,LIBUF ;MOVEI AC,1-LIBUF(AC)
MOVEI ALTP,1(ALTP) ;GET COUNT
MOVEM ALTP,NCNT
TLNE FL,NOPRN ;DID HE WANT PRINTING SUPRESSED
JRST NOPLIN
MOVE T2,CPG ;GET CURRENT PAGE
TRNN FL2,NONUMF ;DON'T PRINT IF NONUMBER
CAMN T2,RPPG ;OR PAGES MATCH
SKIPA
PUSHJ P,PGPRN
MOVE T2,CPG
MOVEM T2,RPPG ;SET AS CURRENT PAGE
MOVEI T1,LIBUF ;PRINT THE LINE
PUSHJ P,OUTLIN
TLNN FL,DECID ;DOES HE WANT THE OPTION OF SAYING NO
JRST NOPLIN ;NO, INSERT IT
NOVCMD: INCHRW T1
ANDI T1,177
OCRLF
CAIN T1,177 ;DID HE SAY RUBOUT(DO NOT INSERT)?
JRST RPNXT1 ;YES, JUST IGNORE THIS LINE
CAIN T1," " ;SPACE MEANS USE IT
JRST NOPLIN
ANDI T1,137 ;FORCE UPPER CASE
CAIE T1,"Q"
CAIN T1,"E" ;DOES HE WANT OUT
JRST ENDREP ;YES: QUIT
CAIN T1,"A"
JRST RPALT
CAIN T1,"G" ;GET OUT OF DECIDE MODE
JRST [TLZ FL,DECID ;LEAVE DECIDE MODE
JRST NOPLIN]
OUTSTR [BYTE (7) 77,40,7,0,0]
CLRBFI ;CLEAR HIM OUT
JRST NOVCMD ;TRY AGAIN
NOPLIN: PUSHJ P,INSED ;ANYTHING ELSE IS OK
PUSHJ P,FINDN ;GET NEXT
PUSHJ P,FILLB ;IN CASE IT GOT LONGER
SOSG RPCNT ;SEE IF OUT OF COUNT
JRST COMND
MOVE T1,(PNTR) ;GET POINTER BACK
JRST ONREP
RPALT: MOVE T1,OCNT ;SAVE COUNT
ADDI T1,LIBUF ;FAKE OUT SETALT
PUSHJ P,RPSALT
PUSHJ P,ALTN1 ;DO ALTER
JRST ENDREP ;QUIT
JRST NOPLINE ;USE IT NOW
ASBMD1: TROA FL,CNTF ;MARK AS KEEP END OF RANGE
ASBMDT: TRZ FL,CNTF ;JUST IN CASE
TLO FL,ASSMF ;WE ASSUME .+1
MOVE T1,CLN
MOVEM T1,LOLN ;SET FOR HERE TO ETERNITY
MOVEM T1,HILN
MOVE T1,CPGL
MOVEM T1,LOPG
TRZE FL,CNTF ;KEEP END?
JRST NOSPSB
CAIE C,":" ;IF A : OR A !
CAIN C,"!"
JRST HALFSB ;GET THE SECOND HALF (.+1 TO GIVEN)
MOVSI T1,377777 ;GET A LARGE PAGE
MOVEM T1,HIPG
MOVEI T1,1 ;SET FOR ONLY ONE
MOVEM T1,RPCNT
JRST REP4 ;ONWARD
HALFSB: MOVEM T1,HIPG ;SET TO AS /.
PUSHJ P,GET2HF ;GET THE SECOND HALF
JRST REP4 ;AND GO
NOSPSB: MOVE T1,RPHIPG
MOVEM T1,HIPG
MOVE T1,RPHILN
MOVEM T1,HILN
JRST REP1A
INSQT: ILDB C,T1 ;GET NEXT CHR
JUMPN C,PUTSTR ;MUST NOT BE 0
NERROR IRS ;THIS STRING IS ILLEGAL
PARSTR: MOVEI CS,0 ;FIND OUT THE NUMBER
PARST1: ILDB C,T1 ;GET A CHR
CAIN C,"" ;CHECK FOR END
JRST ENDNUM
CAIL C,"0" ;MUST BE A DIGIT
CAILE C,"9"
NERROR IRS
IMULI CS,^D10 ;CONVERT
ADDI CS,-"0"(C)
JRST PARST1
ENDNUM: CAILE CS,0
CAMLE CS,ARBCNT ;IS IT IN RANGE
NERROR IRS ;NO SUCH PARTIAL STRING
MOVE T4,[POINT 7,ARBBUF] ;START LOOKING FOR IT
SOJLE CS,FNDRST ;STARTS WITH STRING 1
NXTST: ILDB C,T4
JUMPN C,NXTST ;0 IS END OF A PARTIAL STRING
SOJG CS,NXTST ;LOOK FOR CORRECT STRING
FNDRST: ILDB C,T4 ;NOW INSERT THAT STRING
JUMPE C,REPSTR ;GO FINISH THE REPLACEMENT STRING
IDPB C,ALTP
AOS C,CCNT
CAIL C,MXWPL*5
NERROR LTL
JRST FNDRST
PARORD: AOS CS,PARCNT ;GET NEXT PARTIAL
JRST ENDNUM
RPNXT1: SOSG RPCNT
JRST RPFND
RPNXT: PUSHJ P,FINDN
JRST ONREP ;CONTINUE LOOKING AT LINES
ENDREP: TRZN FL,LINSN ;WERE THERE ANY?
NERROR NLN
RPFND: SKIPN FNDFLG ;FIND ANY?
RERROR SRF ;NOPE
JRST COMND ;GO ON
RPPAG: AOS CPG ;JUST ADVANCE PAGE COUNTER
JRST RPNXT
SUBTTL XPAND COMMAND
XPAND: SETZM LOLN ;AS USUAL, A GOOD THING
TRNE FL,READOF ;CHECK R/O
NERROR ILC
SETZM SSW ;CLEAR SWITCH
PUSHJ P,GET2S ;THE RANGE
CAIE C,"," ;SWITCH
JRST XPAND0
PUSHJ P,SCAN
MOVS T1,ACCUM
CAIE T1,(<SIXBIT /S />)
NERROR ILC
SETOM SSW ;SET TO SUPPRESS TYPEOUT
PUSHJ P,SCAN
XPAND0: TRNN FL,TERMF
NERROR ILC
TRZ FL,LINSN
MOVE T1,LOPG
MOVEM T1,DPG
MOVE SINDEX,LOLN
PUSHJ P,FIND
XPND1: PUSHJ P,ONMOV ;STILL IN RANGE?
JRST EXPEND
TRO FL,LINSN
CAMN T1,PGMK ;IGNORE THESE
JRST PAGE
SKIPE SSW ;SUPPRESS?
TRO FL2,SUPN ;YES:
MOVEM T1,CLN
MOVE T1,CPG
MOVEM T1,CPGL ;SET LINE AND PAGE
PUSHJ P,SETALT ;SET THINGS UP
MOVSI T2,1 ;A LARGE COUNT
PUSHJ P,ALTSP ;SPACES
TRZ FL2,SUPN ;RESET SWITCH
MOVEI T2,0
PUSHJ P,[PUSHJ P,ALTIN
PUSHJ P,ALTN1
JRST LEVINS
AOS (P)
POPJ P, ]
JRST LEVINS
PUSHJ P,INSED ;PUT IN CHANGED LINE
EXPND2: PUSHJ P,FINDN
PUSHJ P,FILLB ;IN CASE OF OVERFLOW
MOVE T1,(PNTR) ;GET BACK NEXT LINE
JRST XPND1
PAGE: AOS T2,CPG
MOVEM T2,CPGL
PUSHJ P,PGPRN ;SEE ALTER COMMAND
MOVE T1,[<ASCII /00000/>!1]
MOVEM T1,CLN
JRST EXPND2
EXPEND: TRNN FL,LINSN
NERROR NLN
JRST COMND
SUBTTL JUSTIFY COMMAND
IFN JUSTSW,<
JUST: SETZM LOLN ;AS USUAL
MOVEI JF,0 ;CLEAR FLAGS
TRNE FL,READOF ;BETTER NOT BE READ ONLY
NERROR ILC ;SO TELL HIM
PUSHJ P,GNCH ;GET A CHARACTER
MOVEM C,SAVC ;IN CASE WE NEED IT
ANDI C,137 ;FORCE UPPER
CAIN C,"R"
TRO JF,JRFLG ;R FOR RIGHT
CAIN C,"L"
TRO JF,JLFLG ;L FOR LEFT
CAIN C,"C"
TRO JF,JCFLG ;C FOR CENTER
CAIN C,"U" ;U FOR JUSTIFY
TRO JF,JFFLG ;WHICH IS THE ONLY THING WHICH FILLS
CAIN C,"W" ;W FOR WORDS
TRO JF,JWFLG!JFFLG
TRNN JF,JRFLG!JLFLG!JCFLG!JFFLG!JWFLG
JRST JOIN ;MUST BE LINE NUMBER FOR JOIN
SETZM SAVC ;DON'T NEED IT
MOVE T1,RMAR ;CHECK THAT THIS GUY IS LARGEST
CAMLE T1,LMAR
CAMG T1,PMAR
NERROR MAR
PUSHJ P,GET2S ;GET RANGE
TRNN FL,TERMF ;THIS HAD BETTER BE A TERMINATOR
NERROR ILC ;HE REALLY BLEW IT
MOVE T1,LOPG ;GET SET TO FIND LINE
MOVEM T1,DPG
MOVE SINDEX,LOLN
MOVEM SINDEX,LIBUF ;ALSO SET NEW FIRST LINE TO SAME
PUSHJ P,FIND ;FIND IT
PUSHJ P,INITOL ;SET IT UP
MOVEM T1,LIBUF ;SET NEW LINE NUMBER SAME AS OLD
PUSHJ P,INITNL ;AND SET UP THE NEW ONE
SETZM TPNT ;TELL JGET THERE IS NOTHING IN LIBUF2
MOVE T1,LMAR ;SET LEFT MARGIN
TRNE JF,JFFLG ;IF FILLING
MOVE T1,PMAR ;MAKE THIS START OF PARAGRAPH
SOS T1
MOVEM T1,INDNT ;FOR INDENTATION
MOVEM T1,LINL ;AND LINE LENGTH
;THIS IS THE PART THAT GETS A CHARACTER FROM THE OLD LINE
JGET: SKIPN TPNT ;IS THERE ANY UNPROCESSED TAIL?
JRST JGET1 ;NO, GET A CHARACTER
MOVE T1,ELIN ;ARE WE AT END OF LINE?
CAMN T1,TPNT
JRST JGET2 ;YES, START GETTING FROM OLD LINE
ILDB T1,TPNT ;NO, GET A CHARACTER
JRST JPUT ;AND PUT.
JGET2: SETZM TPNT ;END OF TAIL
JGET1: ILDB T1,PNTR ;LOAD A CHARACTER
AOS OCNT1 ;STEP CHARACTER COUNT
CAIE T1,15 ;IS THIS A CR?
JRST JGET3 ;NO,TEST FOR END OF LINE
TRNN JF,JFFLG ;ARE WE FILLING?
JRST JGET4 ;NO, WE'RE THROUGH
MOVEI T1," " ;YES, MAKE IT A BLANK
JRST JPUT ;AND GO PUT
JGET3: CAIE T1,12 ;END OF LINE?
JRST JPUT ;NOT YET, SO GO PUT
JGET4: ;END OF LINE
HRRZ T1,PNTR ;CURRENT WORD IN BUFFER FOR DELETION
SUB T1,OPTR ;- START OF OLD LINE
AOS T1 ;+1 = WORD COUNT OF OLD LINE
MOVEM T1,OCNT ;FOR INSED
TRNN JF,JFFLG ;IF WE ARE NOT FILLING
JRST JGETE ;DO WHAT WE HAVE TO DO
SETZM NCNT ;OTHERWISE WE DELETE OLD LINE
MOVE PNTR,OPTR ;WHICH STARTS HERE
PUSHJ P,INSED ;USING INSED
PUSHJ P,FINDN1 ;MAKE SURE WE`RE AT START OF NEXT ONE
PUSHJ P,INITOL ;DO SETUP ON IT AND CHECK RANGE
JGETF: ILDB T1,PNTR ;GET FIRST CHARACTER
AOS OCNT1 ;STEP CHARACTER COUNT
CAIE T1,11 ;IS IT A TAB
CAIN T1,15 ;OR CR?
JRST PARA ;YES, START A NEW PARAGRAPH
TRNE JF,JWFLG ;IF WE ARE DOING A "JW"
CAIE T1," " ;AND A LINE STARTS WITH A SPACE
JRST JPUT
JRST JGETF ;THEN IGNORE IT
JGETE: MOVE T1,LINL ;LINE LENGTH
MOVEM T1,WRDL ;TO WRDL BECAUSE CR AS BLANK WAS DELETED
MOVEM ALTP,LWRD ;ALSO STORE POINTER TO END OF LINE
CAMLE T1,MAXL ;IF LINE WAS TOO LONG,
RERROR LTL ;TELL HIM SO
PUSHJ P,JSUB ;CLEAN UP NEW LINE AND PUT IT OUT
PUSHJ P,INITOL ;SET UP NEXT LINE
MOVEM T1,LIBUF ;SET NEW LINE NUMBER SAME AS OLD
SETZM TPNT ;NOTHING IN LIBUF2
JRST JGET2 ;START MUNCHING
;THIS IS THE PART THAT PUTS A CHARACTER INTO THE NEW LINE
JPUT: CAIE T1," " ;IS THIS A BLANK?
JRST JPUTN ;NO, CHECK SOME OTHER STUFF
TRNE JF,JPER ;IF WE HAVE SEEN A PERIOD OR SOMETHING
TRNN JF,JBLF ;AND THIS IS NOT THE FIRST BLANK
SKIPA
JRST JPUTN1 ;PERMIT IT ANYWAY BUT DON'T TELL ANYONE
TROE JF,JBLF ;WAS THERE ONE BEFORE IT?
JRST JGET ;YES; WE DON`T WANT IT
TRNN JF,JWFLG ;IF HE WANTS BLANKS THEN CHECK
TRNN JF,JFFLG ;ARE WE FILLING?
TRZ JF,JBLF ;NO, PERMIT AN EXTRA BLANK
AOS WCNT ;STEP WORDCOUNT
MOVE T2,LINL ;GET LENGTH SO FAR
MOVEM T2,WRDL ;AND SAVE IT FOR JSUB
MOVEM ALTP,LWRD ;AND STORE POINTER TO END OF WORD
JRST JPUT1 ;THEN PUT BLANKIN BUFFER
JPUTN: TRZ JF,JBLF!JPER ;NOT A BLANK
CAIN T1,"." ;IS IT A PERIOD
TRO JF,JPER
CAIN T1,":" ;OR COLON
TRO JF,JPER
CAIN T1,"?" ;OR QUESTION MARK
TRO JF,JPER
CAIN T1,"!" ;OR EXCLAMATION?
TRO JF,JPER ;IF SO PERMIT EXTRA BLANKS
JPUTN1: MOVE T2,LINL ;LENGTH SO FAR
JPUT1: IDPB T1,ALTP ;DEPOSIT CHARACTER
ADD T2,@WTBL ;WIDTH OF CHARACTER
CAIN T1,10 ;ADJUST BACK-SPACES
SUBI T1,2
CAIE T1,11 ;WAS THAT A TAB?
JRST JPUT2 ;NO
TRZE T2,7 ;YES. IF LAST 3 BITS ARE NONZERO
ADDI T2,10 ;WE WERN'T AT TAB POSITION
SETZM WCNT ;RESET WORDCOUNT
SETZM LWRD ;LAST WORD LOCATION
MOVEM ALTP,BLIN ;AND LOGICAL BEGINNING OF LINE FOR JSUB
TRNE JF,JFFLG ;IF FILLING
TRO JF,JBLF ;DELETE A FOLLOWING BLANK
JPUT2: MOVEM T2,LINL ;STORE NEW LENGTH
CAMLE T2,MAXL ;ARE WE OVER THE END?
JRST JPUTEL ;YES, END LINE WE ARE NOW ON
CAME ALTP,[POINT 7,LIBUF2+MXWPL,34] ;NO, HAVE WE FILLED BUFFER?
JRST JGET ;NOT YET, GET ANOTHER
JPUTEL: SKIPE LWRD ;ANY WORDS YET?
JRST JPUTE ;YES, PUT OUT LINE
RERROR LTL ;NO, TELL HIM LINE TOO LONG
MOVE T2,MAXL ;SAY LINE IS LONG ENOUGH
MOVEM T2,WRDL
JPUTE: TRNE JF,JFFLG ;UNLESS WE'RE NOT FILLING (IN WHICH CASE THIS IS A MISTAKE)
PUSHJ P,JSUB ;MOVE OUT A NEW LINE, AFTER JUSTIFYING IT
JRST JGET ;THEN GET ANOTHER CHARACTER
;THIS PUTS OUT A NEW LINE
NLOUT: MOVEI T1,15 ;ADD A CR
IDPB T1,ALTP
MOVEI T1,12 ;AND A LF
IDPB T1,ALTP
HRRZ T1,ALTP ;LAST WORD OF LINE
SUBI T1,LIBUF ;-FIRST
AOS T1 ;+1=WORDCOUNT
MOVEM T1,NCNT ;FOR INSERTION INTO BUFFER
TRNE JF,JFFLG ;IF FILLING
SETZM OCNT ;INSERT BEFORE
MOVE PNTR,OPTR ;ELSE REPLACE, THE OLD LINE
PUSHJ P,INSED ;DONE BY INSED
PUSHJ P,FINDN ;FIND OLD LINE
PUSHJ P,FILLB ;AND KEEP FROM LOSING IT
TRNN JF,JFFLG ;IF NOT FILLING
JRST INITNL ;SET UP NEW LINE ON THE WAY BACK
MOVE T2,INCR ;INCR FOR LINE NUMBERS
MOVE T1,LIBUF ;OLD LINE NUMBER
PUSHJ P,ASCIAD ;ADD TO MAKE NEW ONE
MOVEM T1,LIBUF ;AND STORE IT AWAY
CAMG T1,MAXLN ;TOO HIGH?
JRST NLO2 ;NO, EXIT
AOS T1,CPG ;YES, WILL SOON BE ON NEXT PAGE
MOVEM T1,CPGL ;AND LOGICAL PAGE
AOS BGPG ;ADD ONE MORE PAGE
AOS INPG
AOS HIPG
MOVE T1,PGMK ;INSERT PAGEMARK
MOVEM T1,LIBUF ;IN LINE BUFFER
MOVE T1,PGMKW2 ;AND TEXT THEREOF
MOVEM T1,LIBUF+1
SETZM OCNT ;INSERT
MOVEI T1,2 ;2 WORDS
MOVEM T1,NCNT
PUSHJ P,INSED ;INTO TEXT FILE
MOVE T2,INCR ;INCR AGAIN
MOVEM T2,LIBUF ;TO MAKE FIRST LINE NUMBER
PUSHJ P,FINDN ;MOVE PAST IT
PUSHJ P,FILLB ;FILL BUFFER TO KEEP FROM LOSING IT
OUTSTR [ASCIZ /%Page mark inserted
/]
NLO2: MOVE T1,OCNT1 ;CHARACTERS PROCESSED SO FAR
MOVEM PNTR,OPTR ;REMEMBER WHERE WE ARE
AOS PNTR ;SKIP LINE NUMBER
HRLI PNTR,(<POINT 7,0>) ;MAKE BYTE POINTER
NLO1: IBP PNTR ;TO MOVE PNTR BACK
SOJGE T1,NLO1 ;TO WHERE WE FOUND IT
JRST INITNL ;THEN SET UP NEW LINE ON WAY BACK
;THIS SETS UP A NEW OLD LINE FOR GET
INITOL: PUSHJ P,FINDN1 ;MAKE SURE WE ARE AT START OF LINE
INITO1: HRRZM PNTR,OPTR ;SAVE POINTER TO START OF LINE
PUSHJ P,ONMOV ;CHECK RANGE
JRST JSTEND ;FINISHED
CAMN T1,PGMK ;IS IT A PAGEMARK?
JRST INITOP ;YES
MOVEM T1,CLN ;NO, SET CURRENT LINE
MOVE T2,CPG ;AND PAGE
MOVEM T2,CPGL
SETZM OCNT1 ;NO CHARACTERS YET
SETZM TCHR ;NOT KNOWN TO BE START OF PARAGRAPH
AOS PNTR ;SKIP LINE NUMBER
HRLI PNTR,(<POINT 7,0>) ;MAKE BYTE POINTER
IBP PNTR ;SKIP INITIAL TAB
POPJ P, ;EXIT
INITOP: ;FOUND A PAGEMARK
TRNE JF,JFFLG ;ARE WE FILLING?
JRST INITOD ;YES, DELETE IT
AOS T2,CPG ;NO, WE ARE ON NEW PAGE
MOVEM T2,CPGL
PUSHJ P,FINDN ;FIND NEXT LINE
PUSHJ P,FILLB ;HANG ON TO IT
JRST INITO1 ;AND SEE WHAT'S THERE
INITOD: SETZM NCNT ;DELETE PAGEMARK
MOVEI T1,2 ;2 WORDS LONG
MOVEM T1,OCNT
PUSHJ P,INSED ;USE INSED AS USUAL
SOS BGPG ;NOW HAVE ONE LESS PAGE
SOS INPG
SOS HIPG
JRST INITOL ;LOOK AT NEXT LINE
INITNL: SETZM LIBUF+1 ;CODE TO ZERO THE LINE BUFFER
MOVE T1,[XWD LIBUF+1,LIBUF+2]
BLT T1,LIBUF+MXWPL+1
MOVE ALTP,[POINT 7,LIBUF2] ;POINT ALTP AT START OF LIBUF2
MOVEI T1,11 ;TAB TO START LINE
IDPB T1,ALTP ;SO INSERT IT
MOVEM ALTP,BLIN ;AND SAVE LOGICAL BEGINNING OF LINE
TRO JF,JBLF ; KEEP FROM INSERTING LEADING BLANKS
TRZ JF,JPER
MOVE T1,LMAR ;SET LEFT MARGIN
SOS T1 ;MARGIN -1 = EXTRA BLANKS
MOVEM T1,LINL ;FOR EXTRA LINE LENGTH
MOVEM T1,INDNT ;AND INDENTATION
SETZB T1,WCNT ;AND THERE ARE NO WORDS YET
SETZM WRDL ;NOR CHARACTERS, FOR THAT MATTER
EXCH T1,LWRD ;RESET POINTER TO LAST WORD
MOVEM T1,TPNT ;BUT SAVE IT TO GET TAIL
POPJ P, ;RETURN
;THIS STARTS A NEW PARAGRAPH
PARA: MOVEM T1,TCHR ;STORE TERMINATING CHARACTER
SKIPE LWRD ;ANY WORDS YET?
PUSHJ P,JSUB ;YES, GET RID OF OLD LINE
MOVE T1,TCHR ;GET TERMINATOR BACK
SETZM TCHR ;DON'T CONFUSE PEOPLE
SETZM TPNT ;TELL JGET NOTHING REMAINS IN LIBUF2
SETZM INDNT ;IF TAB, NO SPECIAL INDENTATION
SETZM LINL
CAIN T1,11 ;IS IT A TAB?
JRST JPUT ;YES, PUT IT IN NEW LINE
PUSHJ P,JSUB ;MUST HAVE BEEN BLANK LINE
MOVE T1,PMAR ;SET PARAGRAPH MARGIN
SOS T1
MOVEM T1,INDNT
MOVEM T1,LINL
JRST JGET ;SO GET NEW CHARACTER
;THIS FINISHES EVERYTHING UP
JSTEND: SETOM TCHR ;FAKE END OF PARAGRAPH
SKIPE LWRD ;ANYTHING LEFT?
PUSHJ P,JSUB ;YES, GET RID OF IT
MOVE PNTR,OPTR ;GET BACK OLD POINTER
MOVE T1,(PNTR) ;GET LINE NUMBER
MOVEM T1,LIBUF ;SAVE NUMBER OF NEXT LINE
PUSHJ P,FINDB ;GET LINE LAST FILLED
MOVEM T1,CLN ;SET IT AS CURRENT LINE
EXCH T1,LIBUF
SKIPE T1 ;END OF FILE?
CAMN T1,PGMK ;PAGE MARK NEXT?
JRST COMND ;DON'T WORRY ABOUT ORDER
CAMG T1,LIBUF ;ORDER TROUBLE?
NERROR ORDER ;YES
JRST COMND ;NO, WE'RE THROUGH.
;AT LAST! THE JUSTIFICATION OF ALL THIS STUFF!
JSUB: MOVEM ALTP,ELIN ;SAVE END OF LINE FOR GET
MOVE ALTP,[POINT 7,LIBUF+1] ;WHERE TO DEPOSIT
MOVE T4,[POINT 7,LIBUF2] ;WHERE TO LOAD
MOVNS JFLOP ;PUT BLANKS IN OTHER SIDE THIS TIME
JSUB1: ILDB T1,T4 ;GET A CHARACTER
IDPB T1,ALTP ;AND MOVE IT
CAME T4,BLIN ;WAS THAT THE LAST TAB?
JRST JSUB1 ;NO, MOVE ANOTHER
SKIPN T5,LWRD ;IF NO WORDS THERE
MOVE T5,ELIN ;THIS IS WHERE TO STOP
SKIPN WRDL ;IF NOTHING IS THERE AT ALL
JRST NLOUT ;PUT OUT BLANK LINE
;NOW WE COMPUTE NUMBER OF BLANKS TO INSERT, IF ANY
SETZM T2
SETZM BPW
SETZM REM
TRNE JF,JLFLG ;IF LEFT JUSTIFYING,
JRST JSUBM1 ;WE DON'T WANT ANY
MOVEI T1," "
MOVE T2,MAXL ;DESIRED LENGTH
SUB T2,WRDL ;-LENGTH WE HAVE = WHAT WE WANT
JUMPE T2,JSUBM1 ;IF ZERO, GO MOVE REST OF LINE
IDIV T2,@WTBL ;/WIDTH OF BLANK = BLANKS WE NEED
TRNE JF,JCFLG ;IF CENTERING
ASH T2,-1 ;WE ONLY WANT HALF AS MANY
TRNE JF,JRFLG!JCFLG ;IF NOT JUSTIFYING BOTH MARGINS
JRST JSUBM1 ;GO PUT IN SOME BLANKS
SOSLE WCNT ;IF LESS THAN 2 WORDS
SKIPE TCHR ;OR END OF PARAGRAPH
JRST JSUBM ;DON'T BOTHER
IDIV T2,WCNT ;BLANKS/WORDS
MOVEM T2,BPW ;= BLANKS PER WORD
MOVEM T3,REM ;AND REMAINDER
SKIPL JFLOP
JRST JSUBM
AOS BPW ;EVERY OTHER LINE
SUB T3,WCNT ;WE ADD EXTRA BLANKS
MOVNM T3,REM ;ON THE OTHER SIDE
JSUBM: SETZM T2
;MOVE LINE, INSERTING BLANKS
JSUBM1: ADD T2,INDNT ;DO INDENTATION
JSUBM3: SOJL T2,JSUBM2 ;QUIT IF NONE
IDPB T1,ALTP ;ELSE DEPOSIT
SOJGE T2,.-1 ;AND TRY AGAIN
JSUBM2: CAMN T4,T5 ;WAS IT THE LAST?
JRST NLOUT ;YES, PUT OUT NEW LINE
ILDB T1,T4 ;GET ANOTHER CHARACTER
IDPB T1,ALTP ;DEPOSIT IT
TRNE JF,JWFLG ;LOOP IF NO BLANK FILL
JRST JSUBM2
SKIPN TCHR ;AT END OF PARAGRAPH WE DO NOT LOOK FOR BANKS
TRNN JF,JFFLG ;ARE WE LOOKING FOR BLANKS?
JRST JSUBM2 ;NO, MOVE ANOTHER
JSUBB: CAIE T1," " ;YES, IS IT A BLANK?
JRST JSUBBN ;NO
TROE JF,JBLF ;YES, DID WE JUST SEE ONE?
JRST JSUBM2 ;YES, MOVE ANOTHER
MOVE T2,BPW ;NO, GET BLANKS PER WORD
SOSL REM ;IF REMAINDER STILL .GT. 0
ADD T2,JFLOP ;ADD ANOTHER ON ALTERNATE LINES
JRST JSUBM3 ;AND PUT THEM IN
JSUBBN: TRZ JF,JBLF ;NOT A BLANK
JRST JSUBM2 ;GET ANOTHER
> ;;; END OF INF JUSTSW
SUBTTL JOIN COMMAND
IFE JUSTSW,<
JUST: SETZM LOLN ;AS USUAL
TRNE FL,READOF
NERROR ILC
>
JOIN: PUSHJ P,GET1S ;GET LINE NUMBER
TRNN FL,TERMF
NERROR ILC
MOVE T1,HIPG
MOVEM T1,DPG
MOVE SINDEX,HILN ;FIND THE CORRECT LINE
PUSHJ P,FIND
MOVE T2,CPG
MOVE T1,(PNTR)
CAMN T2,HIPG
CAME T1,HILN
NERROR NLN
MOVEM T2,CPGL
MOVEM T1,CLN
SETZM LIBUF ;TO ELIMINATE GARBAGE AT END OF LINE
MOVE T1,[XWD LIBUF,LIBUF+1]
BLT T1,LIBUF+MXWPL+1
MOVE T2,PNTR ;GET THE POINTER TO THE LINE
MOVE T3,(T2) ;PICK UP THE FIRST WORD
MOVEI T4,LIBUF ;THE PLACE TO PUT IT
JRST JSALT3 ;TRANSFER
JSALT2: SKIPE T3,(T2)
TRNE T3,1 ;IS IT THE END OF THE LINE
JRST JSALT1
JSALT3: MOVEM T3,(T4) ;PUT IT AWAY
ADDI T4,1
AOJA T2,JSALT2
JSALT1: MOVEI T1,(T4) ;MOVEI T1,-LIBUF(T4)
SUBI T1,LIBUF
MOVEM T1,OCNT
IMULI T1,5 ;GET COUNT OF CHRS
SUBI T1,6 ;WE WILL HAVE TO FIND THE TRUE END
SUBI T4,2
HRLI T4,(<POINT 7,0,27>) ;SET UP POINTER
FEND1: ILDB T2,T4
CAIE T2,15
AOJA T1,FEND1
PUSH P,T1
PUSHJ P,FINDN ;GET THE LINE TO JOIN IT TO
CAME T1,PGMK
SKIPN T1
NERROR NNN ;NO LINE THERE TO CONNECT TO
POP P,T2 ;COUNT
MOVEI T1,1(PNTR)
HRLI T1,(<POINT 7,0,6>) ;SET TO POINT THERE
ADD T4,[XWD 70000,0]
TRN1: ILDB T3,T1
IDPB T3,T4
ADDI T2,1
CAIL T2,MXWPL*5+6
NERROR LTL
CAIE T3,12
JRST TRN1
SUBI T1,-1(PNTR)
PUSH P,OCNT
HRRZM T1,OCNT ;SIZE OF OLD SECOND LINE
SETZM NCNT
PUSHJ P,INSED
PUSHJ P,FINDB ;BACK UP
POP P,OCNT ;GET ITS SIZE
SUBI T4,LIBUF-1
HRRZM T4,NCNT
PUSHJ P,INSED
JRST COMND
SUBTTL INDIRECT COMMAND
;INPUT ROUTINE FOR COMMAND FILE
RDCHAR: SOSG INDBUF+2 ;CHECK EMPTY BUFFER
JRST DOINP ;READ FROM FILE
RDCHR1: ILDB C,INDBUF+1 ;GET A CHAR
JUMPE C,RDCHAR ;SKIP NULLS
MOVE CS,@INDBUF+1 ;FETCH WORD
TRNN CS,1 ;SEQ BIT
POPJ P, ;NO - RETURN
MOVNI C,5 ;SKIP 5 MORE CHARS (TAB INCLUDED)
ADDM C,INDBUF+2
AOS INDBUF+1 ;ADJUST BYTE POINTER
CAME CS,PGMK ;PAGE MARK
JRST RDCHAR ;NO -GET NEXT CHAR
MOVNI C,4 ;YES- SKIP SOME MORE CHARS
ADDM C,INDBUF+2
MOVSI C,(<POINT 7,0,35>)
HLLM C,INDBUF+1 ;ADJUST BYTE POINTER AGAIN
JRST RDCHAR
DOINP: IN IND,0
JRST RDCHR1 ;AOK
MOVE T1,SVCCIN ;RETSTORE INPUT ROUTINE
MOVEM T1,CHIN
TRZ FL2,COMFLF ;ERROR - CLR FLAG
GETSTS IND,C
RELEAS IND, ;GET STATUS AND CLOSE CHL
TRNN C,740000
NERROR CMEND ;EOF
NERROR CMERR ;LOSE BIG
;HANDLE @ COMMAND - READ COMMANDS FROM FILE
COMFIL: TRNE FL2,COMFLF ;TRYING TO NEST?
NERROR ILC
PUSHJ P,SCAN ;READ FILE NAME
PUSHJ P,SETNM1 ;FETCH FILE SPEC
NERROR ILC ;ERROR RETURN
MOVE T1,[TMPBLK,,INDBLK]
BLT T1,INDBKE
SKIPN T1,INDDEV ;GET DEVICE IF THERE
MOVSI T1,'DSK' ;ELSE SUPPLY DEFAULT
MOVEM T1,INDDVI+1
OPEN IND,INDDVI ;OPEN FILE ETC..
NERROR DNA
XLOOK IND,INDBLK
NERROR FNF
MOVEI T1,COMBUF ;SETUP BUFFER
MOVEM T1,.JBFF##
INBUF IND,1 ;***
MOVE T1,[ASCII /00000/] ;SET UP CMD COUNT
MOVEM T1,COMCNT
TRO FL2,COMFLF
MOVEI T1,RDCHAR ;SET UP INPUT ROUTINE
EXCH T1,CHIN ;AND SAVE CURRENT
MOVEM T1,SVCCIN
JRST COMND
SUBTTL LITERALS
XLIST
LIT ;CLEAR ALL LITERALS
LIST
SUBTTL IMPURE AREA
;IMPURE SECTION IS DIVIDED INTO TWO AREAS
;1) DATA WHICH IS SEMI CONSTANT
;2) DATA WHICH IS INITIALLY ZEROED
DATAB:
IFN RENTSW,< RELOC 0 ;SWITCH TO LOW SEG
DATABL: RELOC
PHASE DATABL>
INDEVI: EXP 14
SIXBIT /DSK/
XWD 0,IBUF
OUDEVI: EXP 14
SIXBIT /DSK/
XWD OBUF,0
ALDEVI: EXP 14
SIXBIT /DSK/
XWD 0,ALTBF
TTDEVI: EXP 1B0+1
SIXBIT /TTY/
XWD 0,TTIBH
INDDVI: EXP 1
SIXBIT /DSK/
XWD 0,INDBUF
OPTDVI: EXP 1B0+1
SIXBIT /DSK/
XWD 0,OPTBHD
OPTFIL: SIXBIT /SWITCH/
SIXBIT /INI/
EXP 0,0
IFN EXTEND,<
LSBUFN: LSNUM
LSPTR:
I==0
REPEAT LSNUM,< POINT 7,LSBUF+<SRBLG/5+2>*I
I==I+1
>
LSPTT:
I==0
REPEAT LSNUM,< EXP LSPNT+SRNUM*I
I==I+1
>
>
PGMK: <ASCII / />!1
PGMKW2: BYTE (7)15,14,0,0,0
SQBUF: BLOCK 1
ASCII / /
IFN LSTSW,<
PGHS: ASCII / /
ASCII / /
ASCIZ / PAGE /
PGHD: BLOCK 10
LPDEVI: EXP 1
SIXBIT /LPT/
XWD LOBUF,0
>
ERRHD: EXP 0 ;UUOHS COME HERE
JRST ERRHD0
ASCZ1: ASCII /INC1=/
PRNTO1: EXP 0
ASCIZ /
/
ASCIZ2: ASCII /Inc2=/
PRNTO2: EXP 0
ASCIZ /
/
;STUFF FOR JUSTIFICATION
PMAR: 1 ;PARAGRAPH INDENTATION
LMAR: 1 ;NORMAL INDENTATION (LEFT MARGIN)
RMAR: ;RIGHT MARGIN
MAXL: EXP ^D69 ;OTHERWISE KNOWN AS MAX LINE LENGTH
MAXLN: <ASCII /99999/>!1 ;MAXIMUM LINE NUMBER ON A PAGE
WTBL: .+1 ;FOR NOW, ALL CHARACTERS HAVE WIDTH 1
1
JFLOP: 1 ;FLIPFLOP FOR INSERTING BLANKS ON L OR R
PAGESZ: EXP PGSZ
PLINES: 20 ;DEFAULT VALUE FOR P CMD
ESC: 33 ;DEFAULT ESCAPE CHAR
COMESS: ASCII /COMMAND # /
COMCNT: EXP 0
BYTE (7) 15,12
LINOUT: EXP 0
ASCIZ ./.
IFN CCLSW,<
IFN TEMPC,<
T.HEAD: SIXBIT /EDS />
T.IOWD: XWD 0,CMDBUF-1
EXP 0
RPGR: SIXBIT /SYS/
SIXBIT /COMPIL/
EXP 0,0,0,0
>
;CONTROL BLOCK FOR CNTRL C TRAPPING
CNCBLK: 4,,CNCINT
0,,1B34
0
0
CNCLOK: -1 ;INTERLOCK FOR RE-ENTRANT HANDLING
IFN RENTSW,< DEPHASE >
DATAE==.-1
;MACRO TO GENERATE FILE-SPEC BLOCKS
DEV==0 ;DEVICE NAME INDEX (MUST BE A DISK)
NAM==1 ;FILE NAME INDEX
EXT==2 ;FILE EXTENSION (LH)
PRT==2 ;FILE PROTECTION (RH)
COD==3 ;ENCRYPTION PSW
PTH==4 ;PATH AND PPN
DEFINE FILDES (F) <
IRP F,<
F'BLK==.
F'DEV: BLOCK 1
F'NAM: BLOCK 1
F'EXT: BLOCK 1
F'PRT==.-1
F'COD: BLOCK 1
F'PTH: BLOCK SFDLVL+1
F'BKE==.-1>>
;REST IS RANDOM VARIABLES AND BUFFERS
IFN RENTSW,< RELOC DATABL+<DATAE-DATAB>+1 >
ZEROB==.
BAKF: BLOCK 1 ;0 := NOBACKUP , -1 := BAK , +1 := OLD
CREATF: BLOCK 1
SVWD: BLOCK 1
SVWD2: BLOCK 1
SVWD3: BLOCK 1
TMPT1: BLOCK 1
DELETF: BLOCK 1 ;NON-ZERO FOR DELETE INPUT
BASICF: BLOCK 1
UNSEQF: BLOCK 1
RPGSW: BLOCK 1
PZBEG==.
IFN CRYPSW,<
S.CRYP: BLOCK 10
CODBUF: BLOCK 5
>
MYPPN: BLOCK 1
FILDES <ORG,NEW,TMP,ICR,OCR,IND,ALT>
PZEND==.-1
FILDES <RUN>
XBLOCK: BLOCK 4 ;FOR FILE OPS
PTHADR: BLOCK <SFDLVL+4> ;FOR PATH UUO
BUFHD: BLOCK 1 ;POINTER TO START OF EDIT BUFFER
BUFP: BLOCK 1 ;POINTER TO CURRENT LOC IN EDIT BUFFER
SSW: BLOCK 1
RSW: BLOCK 1
EDNAM: BLOCK 1
EDBUF: BLOCK 1
TMPCF: BLOCK 1
CORTOP: BLOCK 1
FILPT: BLOCK 1
MAXWC: BLOCK 1 ;MAX FULL POINT IN EDIT BUFFER
HLFWC: BLOCK 1 ;HALF FULL POINT IN EDIT BUFFER
CLN: BLOCK 1 ;CURRENT LINE
INCR: BLOCK 1
CURINS: BLOCK 1
CPG: BLOCK 1 ;CURRENT PAGE
CPGL: BLOCK 1 ;LOGICAL CURRENT PAGE "/."
IPG: BLOCK 1 ;INSERT PAGE
INPG: BLOCK 1 ;CURRENT INPUT PAGE SEEN
OPG: BLOCK 1 ;COUNT OF PAGES OUTPUT
WC: BLOCK 1 ;WORD COUNT IN EDIT BUFFER
OLDLIN: BLOCK 1
SSAVEN: BLOCK 1
SAVEN: BLOCK 1
SISAVN: BLOCK 1
ISAVEN: BLOCK 1
ALTSN: BLOCK 1 ;ALTMODE SEEN FLAG (I&R)
ALTINC: BLOCK 1 ;ALTER MODE I CMD INCR
ALTFLG: BLOCK 1
CASEBT: BLOCK 1
BGPG: BLOCK 1
ACCUM: BLOCK 1
SVT1E: BLOCK 1
SVERN: BLOCK 1
SAVCHR: BLOCK 1
TECINC: BLOCK 1
TECFST: BLOCK 1
TEMINC: BLOCK 1
REINC: BLOCK 1
INCST: BLOCK 1
REFST: BLOCK 1
ALTCNT: BLOCK 1
LOGPG: BLOCK 1
LSTCNT: BLOCK 1
SVCCNT: BLOCK 1
SAVC: BLOCK 1
IFN EXTEND,<
LSHIPG: BLOCK 1
LSHILN: BLOCK 1
LSCNT: BLOCK 1
LSPG: BLOCK 1
LSBUF: BLOCK <SRBLG/5+2>*LSNUM
LSPNT: BLOCK SRNUM*LSNUM
>
IFN LSTSW,< LOBUF: BLOCK 3 >
LIMBO: BLOCK 1 ;LIMBO CHAR AFTER BELL
CHIN: BLOCK 1 ;INPUT PNTR
SVCCIN: BLOCK 1 ;SAVED INPUT ROUTINE FOR @ CMDS
SVPCIN: BLOCK 1 ;SAVED INPUT ROUTINE FOR PARSE
TTOBUF: BLOCK ^D80/5+1
TTOCNT: BLOCK 1 ;OUTPUT CNTR
TTOPNT: BLOCK 1 ;OUTPUT PNTR
TTIBH: BLOCK 3 ;BUFFER RING HEADER
TTIBUF: BLOCK 23 ;TTY INPUT BUFFER
OBUF: BLOCK 4 ;DISK OUTPUT
IBUF: BLOCK 4 ;DSK INPUT
AUXFIL: BLOCK 1
PDL: BLOCK PDLSIZ+1 ;PUSHDOWN LIST
P.TEXT: BLOCK 1
CMDBUF: ;COMMAND BUFFER
LIBUF: BLOCK MXWPL+2 ;LINE INPUT BUFFER
CRSX: BLOCK 1 ;PLACE FOR CR'S
LIBUF2: BLOCK MXWPL+2
IFN LSTSW,< LPTBUF: BLOCK 203>
SVPT: BLOCK 1
CODEBF: BLOCK 4*SRNUM+2
BUFSAV: BLOCK 1
STRNAM: BLOCK 5
ARBBUF: BLOCK MXWPL*2+1
ARBCNT: BLOCK 1
SRHIPG: BLOCK 1
SRHILN: BLOCK 1
SRCNT: BLOCK 1
SRBUF: BLOCK SRBLG/5+2
SRPG: BLOCK 1
SRPNT: BLOCK SRNUM
BOTLIN: BLOCK 1
PGDELS: BLOCK 1
STARTD: BLOCK 1 ;WHERE TO START TO DELETE ON TRANSFER
ENDD: BLOCK 1 ;WHERE TO END DELETING ON TRANSFER
TRANST: BLOCK 1
PGINSD: BLOCK 1
DESTLN: BLOCK 1
DESTPG: BLOCK 1
ALTBF: BLOCK 3
FINCR: BLOCK 1
SINCR: BLOCK 1
SVLNUM: BLOCK 1
LSTPG: BLOCK 1
SVJRL: BLOCK 1
SVJRL2: BLOCK 1
COPDL: BLOCK 1
HIGH1: BLOCK 1
NLIN1: BLOCK 1 ;# OF LINES ON FIRST PAGE OF C/T
NLIN2: BLOCK 1 ;# OF LINES ON LAST PAGE OF C/T
START2: BLOCK 1 ;STARTING LINE # FOR LAST PG OF C/T
LSTLN: BLOCK 1 ;LAST LINE # SEEN DURING C/T
PARCNT: BLOCK 1
RPPG: BLOCK 1
RPCNT: BLOCK 1
FNDFLG: BLOCK 1
R1BUF: BLOCK SRBLG/5+2
R2BUF: BLOCK SRBLG/5+2
RPHILN: BLOCK 1
RPHIPG: BLOCK 1
R1PNT: BLOCK SRNUM
R2PNT: BLOCK SRNUM
CCNT: BLOCK 1
RSTRCT: BLOCK 1
IFN JUSTSW,<
OCNT1: BLOCK 1
OPTR: BLOCK 1
LINL: BLOCK 1
LWRD: BLOCK 1
WRDL: BLOCK 1
TPNT: BLOCK 1
ELIN: BLOCK 1
TCHR: BLOCK 1
WCNT: BLOCK 1
BPW: BLOCK 1
REM: BLOCK 1
BLIN: BLOCK 1
INDNT: BLOCK 1
>
SVOCIN: BLOCK 1
OPTION: BLOCK 1
OPTBHD: BLOCK 3
OPTBUF: BLOCK 203
COMBUF: BLOCK 203
INDBUF: BLOCK 3
SVALTP: BLOCK 1
DPG: BLOCK 1
SVINC: BLOCK 1
SVCNT: BLOCK 1
OCNT: BLOCK 1 ;OLD WC FOR INSED
NCNT: BLOCK 1 ;NEW WC FOR INSED
SRCALP: BLOCK 1
VAR ;IF ANY (I HOPE THIS WORKS)
ZEROE==.-1
HILN: BLOCK 1 ;RESULTS OF RANGE PARSE
HIPG: BLOCK 1 ; <LOLN>/<LOPG>:<HILN>/<HIPG>
LOLN: BLOCK 1
LOPG: BLOCK 1
IMPEND:
IFN RENTSW,< RELOC >
END STPT