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