Trailing-Edge
-
PDP-10 Archives
-
decus_20tap2_198111
-
decus/20-0058/edits.mac
There are 2 other files named edits.mac in the archive. Click here to see a list.
00100 TITLE EDITS V13(20) A MODIFIED VERSION OF THE STOPGAP EDITOR
00200 SUBTTL COMMENTS AND MODIFICATION HISTORY
00300 ; W.WEIHER/RG/JBS/AVR/RB/11-OCT-71
00400
00500 ;TEMPORARY EDITOR FOR THE DISK--WORKS BY RECOPYING
00600
00700 ;THIS MEMBER OF THE STOPGAP CLAN WAS ADAPTED FROM THE VERSION
00800 ;RUNNING AT SANDERS ASSOCIATES IN NASHUA, NEW HAMPSHIRE AND
00900 ;TURNED OVER TO DEC AS PART OF AN AGREEMENT. THE MODIFICATIONS
01000 ;MADE BY GORIN AND SAUTER WERE DONE AT SANDERS. MANY OF THE MODS
01100 ;MADE BY RYDER AT DEC BENEFITTED FROM CONVERSATIONS WITH BOTH
01200 ;GORIN AND SAUTER.
01300
01400 ;THIS VERSION (13,,21 JANUARY 26,1973) HAS BEEN RUNNING ON
01500 ;DEC'S SYSTEM #40 IN HEAVY PRODUCTION FOR OVER A YEAR.
01600
01700 ;THERE ARE SOME MINOR BUGS (KNOW TO CRAIG FLETCHER BUT NOT ME),
01800 ;BUT IT IS SUITABLE FOR IMMEDIATE, HEAVY USE.
01900 ;FOR DIFFERENCES BETWEEN THIS AND THE MALUG SOS, CONTACT TED HESS.
02000
02100 LOC 137
02200 VERSION 13,,21 ;COMMENTS AND THIS LINE CHANGED THIS EDIT
02300
02400
02500 ;MODIFIED SEPT, 1969 BY R.GORIN
02600 ;REWRITTEN TO MACRO, FOR REENTRANCY
02700 ;LEVEL D FEATURES ADDED EARLY 1971 J. SAUTER
02800 ;MOD BY A RYDER MARCH 71 TO:
02900 ; SET OUTPUT PROTECTION SAME AS INPUT,
03000 ; FOLLOW VERSION NUMBER CONVENTIONS,
03100 ; HANDLE OCTAL (& DEC.) PPN'S,
03200 ; PURGE RALPH'S TIME BOMB COMPLETELY,
03300 ; GENERATE *.BAK FILES (UNLIKE TECO'S, THESE CAN BE EDITED),
03400 ; HANDLE "N<CAR RET>" AS IF "NINC,/." WHERE INC IS CURRENT INCREMENT,
03500 ; DEFAULT TO CREATE IF INPUT FILE NOT FOUND
03600 ; SET "." TO MARKED LINE AFTER A MARK OPERATION
03700 ; SET "." TO FORMER FIRST LINE AFTER A D/N OPERATION
03800 ; RECOGNIZE "/*" AS THE LAST PAGE (MAY STILL HAVE BUGS)
03900 ; ACCEPT ",M" AS THE THIRD OR FOURTH ARGUMENT FOR N
04000 ; IT FORCES NEW NUMBERS TO BE MONOTONIC OVER PAGE MARKS
04100 ; A SINGLE DEFAULT INCREMENT FOR EVERYTHING (N,I,C & INPUT)
04200 ; CLEAN-UP OF STANDARD PAGE-MARK AND ALTMODE
04300 ; COUNT OF SUBSTITUTIONS MADE....OUTPUT ON "=SUBS"
04400 ; COUNT OF COMMANDS SINCE A WRAP-AROUND OR CHECKPOINT..."=COMNDS"
04500 ; EXPANDED HANDLING OF INADEQUATE DISK SPACE
04600
04700 ;MOIFDIED BY R BRAIN OCTOBER 71:
04800 ; TYPE Y'ES' OR N'O'
04900 ; DEFAULT TO 'DSK' IF 'LPT' NOT AVAILABLE TO 'L' COMMAND
05000 ; _INC COMMAND TO SET THE INCREMENT
05100 ; ,INT ON 'R' OR 'I' COMMANDS SETS ONLY A TEMP. INC
05200 ; KILL ECHO OF DELETED TEXT IN 'A' MODE ON D,R,OR K IF _EXPERT
05300 ; 'E'(EXPERT), 'N'(NOVICE), 'X'(EXPAND), AND <TAB>(999<SPACE>) ADDED TO A MODE
05400 ; '^' FOR TOP OF PAGE
05500 ; '.' COMMAND MOVES POINTER
05600 ; VERSION NUMBER GETS INCREMENTED UPON EXITING (_VERSION & =VERSION)
00100 SUBTTL CONTENTS OF THIS FILE (WHERE THE ROUTINES ARE)
00200
00300
00400 ;PAGE 1 COMMENTS AND MODIFICATION HISTORY
00500 ;PAGE 2 CONTENTS OF THIS FILE (WHERE THE ROUTINES ARE)
00600 ;PAGE 3 DEFINITIONS
00700 ;PAGE 7 RPG LOADER
00800 ;PAGE 8 DEBUGGING ROUTINES
00900 ;PAGE 9 CHARACTER TABLES
01000 ;PAGE 10 SCANNER
01100 ;PAGE 11 PLACE FINDING ROUTINES
01200 ;PAGE 12 BUFFER HANDLING ROUTINES
01300 ;PAGE 14 RANGE SPECIFIER READERS
01400 ;PAGE 18 INITIALIZE
01500 ;PAGE 19 ERROR ROUTINES
01600 ;PAGE 20 COMMAND DECODER
01700 ;PAGE 21 PRINT COMMAND
01800 ;PAGE 22 END ROUTINE
01900 ;PAGE 23 SOME GENERAL PURPOSE STUFF
02000 ;PAGE 24 INSERT ROUTINE
02100 ;PAGE 25 DELETE ROUTINE
02200 ;PAGE 26 INSERT PAGE MARK
02300 ;PAGE 27 RENUMBER
02400 ;PAGE 28 ALTER COMMAND
02500 ;PAGE 29 THE _ COMMAND
02600 ;PAGE 30 = COMMAND
02700 ;PAGE 31 LIST COMMAND
02800 ;PAGE 32 REPLACE COMMAND
02900 ;PAGE 33 COMMON SEARCH ROUTINES FOR F AND S
03000 ;PAGE 34 FIND COMMAND (SEARCHES)
03100 ;PAGE 35 ALTMODE AND LINE FEED COMMANDS
03200 ;PAGE 36 COPY AND TRANSFER COMMANDS
03300 ;PAGE 37 SUBSTITUTE COMMAND (REPLACES THINGS)
03400 ;PAGE 38 XPAND COMMAND
03500 ;PAGE 39 JOIN COMMAND
03600 ;PAGE 40 THE AREA FOR LITERALS AND INIT OF LOWSEG
03700 ;PAGE 41 IMPURE AREA
00100 SUBTTL DEFINITIONS
00200
00300 TWOSEGMENTS
00400 MLON
00500 SALL
00600
00700 ;DEVICES USED
00800
00900 ALTLPT==1 ;ALTERNATE PLACE FOR SELECTED TELETYPE OUTPUT
01000 IN==2
01100 OUT==3
01200 LPT==4
01300 ALTDV==5 ;THE OTHER INPUT DEVICE (COPY AND TRANSFER)
01400 TTY==6 ;AND 7 AND 8 AND 9 AS WE NEST INDIRECT COMMANDS
01500
01600 ;ACS USED
01700
01800 FL=0 ;FLAG REGISTER
01900 T1=1 ;TEMP REGISTERS
02000 T2=2
02100 T3=3
02200 T4=4
02300 T5=5
02400 FL2=11
02500 ALTP=12
02600 CS=13 ;CHARACTER TABLE BITS
02700 SINDEX=14 ;LINE TO FIND, USED ALSO BY THE VARIOUS ROUTINES
02800 PNTR=15 ;POINTS AT CURRENT PLACE IN BUFFER
02900 C=16 ;CHARACTER RETURNED HERE BY GNCH
03000 P=17 ;PUSHDOWN LIST
03100
03200 ;DEFINE CERTAIN THINGS OF INTEREST.
03300
03400 MINDSK==5 ;SEE DSKTST MIN DSK TO TRY OUTPUT
03500 ALTMOD==200 ;STANDARD INTERNAL REPRESENTATION FOR ALTMODE HEREIN
03600 PPBASE=10 ;PPN RADIX, ^D10 FOR DECIMAL PPN'S LIKE SANDERS
03700 SRBLG==^D200 ;NUMBER OF CHRS ALLOWED IN SEARCH STRING
03800 SRNUM==12 ;NUMBER OF SEARCH STRINGS ALLOWED
03900 MXWPL==^D30 ;MAX NUMBER OF WORDS PER LINE
04000 %LPP==^D57
00100 ;FLAGS IN FL (RIGHT HALF)
00200
00300 BOF==1 ;NOW ON FIRST RECORD OF FILE
00400 EOF==2 ;HAVE READ END OF FILE BUT NOT NECESSARILY IN BUFFER
00500 EOF2==4 ;LAST WORD OF FILE IS IN CURRENT BUFFER
00600 ADDL==10 ;USED IN COMMAND SCANNING--LINE NUMBER + INC
00700 SUBL==20 ;LINE NUMBER - INC
00800 IDF==40 ;SCAN HAS SEEN AN IDENTIFIER
00900 NUMF==100 ;SCAN HAS SEEN A NUMBER
01000 TERMF==200 ;SCAN SAW A TERMINATOR (LF OR ALTMODE)
01100 LINSN==400 ;THE COMMAND INPUT ROUTINES SAW A LINE NUMBER
01200 PGSN==1000 ;THEY SAW A PAGE NUMBER
01300 NEWFL==2000 ;NEW FILE NAME SEEN BY END CODE
01400 ORDF==4000 ;LINES OUT OF ORDER (USED BY NUMBER)
01500 BGSN==10000 ;BIGGEST PAGE HAS BEEN SEEN
01600 M37F==20000 ;THIS IS A MODEL 37
01700 CNTF==40000 ;COMMAND USING !
01800 DPYF==100000 ;THIS IS A III DISPLAY
01900 READOF==200000 ;THIS FILE IS BEING USED IN READ ONLY MODE
02000 EXTOG==400000 ;ON FOR SHORT ERROR MESSAGES
02100
02200 ;FLAGS (LEFT HALF)
02300
02400 NEGF==1 ;SEARCH HAS SEEN A
02500 DEMCHR==2 ;SEARCH MUST SEE ANOTHER CHARACTER
02600 ASSMF==4 ;SEARCH HAS ASSUMED SEARCH CONTINUATION
02700 ALTSRF==10 ;HE WANTS TO DO A SEARCH AND EDIT
02800 NUMSRF==20 ;HE ONLY WANTS NUMBERS OF LINES FOUND
02900 ARBITG==40 ;WE ARE DOING CURRENTLY, DO NOT ALLOW ANOTHER
03000 EXCTSR==100 ;WANTS TO SEARCH EXACTLY (NOT IGNORE CASE)
03100 COPFIL==200 ;WE ARE COPYING FROM ANOTHER FILE
03200 ISCOP==400 ;WE ARE DOING A COPY
03300 NOPRN==1000 ;DO NOT PRINT WHILE DOING SUBSTITUTE
03400 DECID==2000 ;ALLOW USER TO DECIDE IF LINE IS OK
03500 ;ALSO IN F COMMAND AS X SWITCH INDICATOR
03600 EXCTS1==4000 ;ANOTHER EXACT SEARCH FLAG FOR SUBS
03700 QMODF==10000 ;DO NOT TREAT ? AS A SPECIAL CASE ON INPUT
03800 GCOM==20000 ;DOING A G COMMAND INSTEAD OF E
03900 SRCOP==40000 ;DOING A SEARCH OF SECOND FILE
04000 TRANFL==100000 ;THIS IS A TRANSFER COMMAND WHICH HAS DELETED LINES
04100 TECOF==200000 ;THIS IS A TECO FILE
04200 FSTOPF==400000 ;THIS IS THE FIRST READ OP ON THIS FILE
04300
00100 ;FLAGS IN FL2 (RIGHT)
00200
00300 STARF==1 ;WE HAVE SEEN A * FOR THE LAST LINE
00400 RUBF==2 ;WE ARE DOING RUBOUT IN INTRA-LINE EDIT
00500 ALTDUP==4 ;DUPLEX CHARACTERS IN ALTER MODE
00600 RUBF2==10 ;DOING DELETE TYPE RUBOUT IN ALTER MODE
00700 ALTIOF==20 ;USING ALTERNAT I/O DEVICE (NOT DSK)
00800 FORCEF==40 ;FORCE OUT WHILE USING ALTIO. CANT WRAP
00900 RALPHF==100 ;WHEN SHORT OF DISK, SLEEP INSTEAD OF TTWAIT
01000 ;WHEN FINISHING ALTERING A LINE, DON'T PRINT.
01100 DSKCK==200 ;CHECK DISK FOR ROOM BEFORE EACH WRITE
01200 DSKSMF==400 ;TYPE JUST A SHORT MESSAGE WHILE WAITING
01300 RSW==1000 ;READ ONLY FILE.
01400 SSW==2000 ;SEARCH ONLY FILE (LIKE /S IN COPY)
01500 RPGSW==4000 ;ON FOR THIS IS IN RPG MODE. READ DISK COMMANDS
01600 CRTINF==10000 ;ON FOR IN RPG, CREATING.
01700 QENDF==20000 ;ON FOR Q COMMAND. PHONEY EXIT & RESTART
01800 BENDF==40000 ;ON FOR B COMMAND; EXIT & STRIP SEQ. NUMBERS
01900 ALTFLG==100000 ;ON SOMETIMES IN ALTER COMMAND
02000 ;ALSO IN X IT MEANS THAT HE WANTS AN AUTO STRING
02100 BAKFLG==200000 ;ON TO LEAVE A *.BAK FILE BEHIND
02200
02300 ;FLAGS IN FL2 (LEFT)
02400
02500 .FVALU==400000
02600
02700 FLAG (UPUPUP) ;FOR MONOTONIC RENUMBERING
02800 ;NO FLAG (DEBFLG) ;ON IF DEBUGGING, CODE NOT GEN. IF NOT DEF
02900 FLAG (SINGDL) ;FOR KILLING ECHO ON 'D' IN A MODE IF _EXPERT
03000 FLAG (MOVIT) ;MOVE THE POINTER FLAG
03100 FLAG (UPAROW) ;UP ARROW SET
03200 FLAG (DEVSYS) ;SYS IS THE DEVICE
03300 FLAG (ALTOF) ;OUTPUT FILE ON ALT DEV
03400 FLAG (MONTR) ;MONITOR @ COMMAND
03500 FLAG (NOINCV) ;VERSION SET, DON'T INCREMENT IT
03600
03700 EXTERNAL .JBFF,.JBSA,.JBAPR,.JBREL
03800
03900 OPDEF ERROR [1B8] ;ERROR UUOS FATAL ERROR
04000 OPDEF NERROR [2B8] ;NON-FATAL ERROR
04100 OPDEF RERROR [3B8] ;PRINT MESSAGE AND RETURN
04200
00100 ;ERROR NUMBERS
00200
00300 ICN==1 ;INTERNAL EDITOR CONFUSION
00400 DIE==2 ;DEVICE INPUT ERROR
00500 DDE==3 ;DEVICE OUTPUT ERROR
00600 ILC==4 ;ILLEGAL COMMAND
00700 ILUUO==5 ;PROTECTION. SOMEONE EXECUTED AN ILLEGAL UUO
00800 LTL==6 ;LINE IS TOO LONG
00900 NLN==7 ;NULL COMAND RANGE
01000 NSP==10 ;NO SUCH PAGE (KLEAR)
01100 ORDER==11 ;LINES OUT OF ORDER
01200 UNA==12 ;LPT NOT AVAILABLE FOR L COMMAND
01300 ILR==13 ;ILLEGAL REPLACEMENT WITH INSERT
01400 WAR==14 ;WRAP AROUND IN RENUMBERING
01500 TMS==15 ;TOO MANY SEARCH STRINGS GIVEN
01600 STL==16 ;TOO MANY TOTAL STRING CHRS
01700 ISS==17 ;ILLEGAL SEARCH STRING
01800 ILFMT==20 ;ILLEGAL LINE FORMAT DETECTED
01900 NSG==21 ;NO STRING GIVEN
02000 FNF==22 ;FILE NOT FOUND (COPY)
02100 DNA==23 ;DISK NOT AVAILABLE (COPY)
02200 NEC==24 ;NOT ENOUGH CORE (COPY)
02300 IRS==25 ;ILLEGAL REPLACEMENT STRING
02400 STC==26 ;SEARCH STRING TOO COMPLEX (GOT PDLOV)
02500 ITD==27 ;ILLEGAL TRANSFER DESTINATION (NO LONGER THERE)
02600 NNN==30 ;NO NEXT LINE (FROM JOIN TYPE COMMANDS)
02700 FORM== 31 ;IMPROPER FORMAT (_VERSION)
02800
02900 LOC 41
03000 JSR ERRHD ;THE UUO TRAP
03100 LOC 124
03200 EXP REENTR ;THE REENTRY POINT
03300 RELOC 0
00100 SUBTTL RPG LOADER
00200
00300 RELOC 400000
00400
00500 EXP STPT ;POINTER TO STARTING ADDRESS
00600 ASCRLF: BYTE (7)15,12,0,0,0 ;ASCII CARRIAGE RETURN-LINE FEED
00700 PDLPNT: IOWD 40,PDL ;STACK POINTER INITAL VALUE
00800
00900 DEFINE FLAG(A)<A==.FVALU
01000 IFE .FVALU,<PRINTX ERROR...TOO MANY FLAGS>
01100 .FVALU==.FVALU_<-1>>
01200
01300 DEFINE SPOTIT(A)<TTCALL 3,[ASCIZ/A' =/]
01400 MOVE T1,A
01500 PUSHJ P,SHOWIT>
01600
01700 DEFINE GRONK(A)<TTCALL 3,STAR3
01800 TTCALL 3,[ASCIZ/A/]
01900 TTCALL 3,STAR3
02000 TTCALL 3,A
02100 TTCALL 3,STAR3
02200 TTCALL 3,ASCRLF>
02300
02400 DEFINE DEBUG(A)<IFDEF DEBFLG<TLNN FL2,DEBFLG
02500 JRST .+4
02600 TTCALL 3,[ASCIZ/DEBUG.../]
02700 TTCALL 3,[ASCIZ \A\]
02800 PUSHJ P,DEBUGR>>
02900
03000 DEFINE ERMS(A)<IRP A<[ASCIZ/
03100 *A*
03200 /]>>
03300
03400 DEFINE FILDEV<(T5)>
03500 DEFINE FILNAM<1(T5)>
03600 DEFINE FILEXT<2(T5)>
03700 DEFINE FILPRO<3(T5)>
03800 DEFINE FILPPN<4(T5)>
03900
04000 DEFINE ONRUB<
04100 TRZE FL2,RUBF2
04200 TTCALL 3,[ASCII /\\/]
04300 TRON FL2,RUBF
04400 TTCALL 1,["\"]>
04500
04600 DEFINE ONOFF(A1,A2,A3,A4,A5)<;ON,OFF,SWITCH,HALF,REGISTER
04700 CAMN T1,[SIXBIT/A1/] ;TURN IT ON?
04800 JRST [T'A4'OA A5,A3 ;TURN ON
04900 T'A4'Z A5,A3 ;TURN OFF
05000 JRST COMND ;RETURN]
05100 CAMN T1,[SIXBIT/A2/] ;TURN IT OFF?
05200 JRST 1+[T'A4'OA A5,A3 ;TURN ON
05300 T'A4'Z A5,A3 ;TURN OFF
05400 JRST COMND ;RETURN]>
05500
05600 DEFINE CHRS(FLAGS,PALT,INALT,RH)<BYTE (4)FLAGS(7)PALT,INALT(18)RH>
05700
05800 DEFINE CMNDEF(CHAR,ADDR)<<CHAR>B12+ADDR>
05900
06000 DEFINE BLOCKS(A)<
06100 IRP A<A: BLOCK 1>>
06200
06300 DEFINE VERSION(A,B,C,D)< ;VERSION,LETTER,EDIT,NUMBER
06400 XLIST
06500 IFNB <B>,<BYTE (3)D(9)A(6)'B'-40(18)C>
06600 IFB <B>,<BYTE (3)D(9)A(6)0(18)C>
06700 LIST>
00100 SUBTTL DEBUGGING ROUTINES
00200
00300 IFDEF DEBFLG<
00400
00500 TELLAD: TTCALL 3,[ASCIZ/
00600 ADDRESS=/]
00700 MOVEM T2,TEMP2
00800 MOVEM T3,TEMP3
00900 PUSHJ P,SHOWIT
01000 MOVE T2,TEMP2
01100 MOVE T3,TEMP3
01200 POPJ P,
01300
01400 TRZ FL2,CRTINF
01500 SHOWIT: MOVEI T3,OCHR ;ROUTINE FOR OCTAL PRINTER TO OUTPUT TO
01600 PUSHJ P,OPRNT ;PRINT OCTAL
01700 PUSHJ P,TTYOUT ;FORCE OUTPUT
01800 TTCALL 3,ASCRLF
01900 POPJ P,
02000
02100 DEBUGR: MOVEM T1,TEMP1
02200 HRRZ T1,(P) ;WHERE FROM
02300 PUSHJ P,TELLAD
02400 MOVEM T2,TEMP2
02500 MOVEM T3,TEMP3
02600 SPOTIT (CPG)
02700 SPOTIT (CPGL)
02800 SPOTIT (CLN)
02900 SPOTIT (FL)
03000 SPOTIT (FL2)
03100 SPOTIT (TEMP1)
03200 MOVE T1,TEMP1
03300 MOVE T2,TEMP2
03400 MOVE T3,TEMP3
03500 POPJ P,
03600 >
03700 STAR3: ASCIZ /***/
00100 SUBTTL CHARACTER TABLES
00200 ;A CHARACTER TABLE FOR USE ON TYPE IN AND TYPE OUT
00300
00400 ;FLAGS USED IN CHARACTER TABLE
00500
00600 OPF==10 ;THIS IS A SPECIAL CHARACTER
00700 SNUMF==4 ;THIS IS PART OF A NUMBER
00800 LETF==2 ;THIS IS A LETTER
00900 TERM==1 ;THIS IS A TERMINATOR
01000 M37==400000 ;THIS CHR IS PRINTED AS ITSELF ON MODEL 37
01100 NSEPF==200000 ;THIS IS NOT A SEPERATOR (USED ON $,%,AND.)
01200 LETFX==100000
01300 SNUMFX==200000
01400 TERMX==40000
01500
01600 CTBL: 0
01700 CHRS OPF,"!",1,1
01800 CHRS OPF,42,"",""
01900 CHRS OPF,"#",3,3
02000 CHRS OPF,"$",4,4
02100 CHRS OPF,"%",5,5
02200 CHRS OPF,"&",6,6
02300 CHRS OPF,"'",7,7
02400 CHRS OPF,"(",10,10
02500 0
02600 CHRS OPF!TERM,0,12,12
02700 CHRS OPF,0,13,13
02800 CHRS OPF,0,14,14
02900 0
03000 CHRS OPF,")",16,16
03100 CHRS OPF,"*",17,17
03200 CHRS OPF,"+",20,20
03300 CHRS OPF,<",">,21,21
03400 CHRS OPF,"-",22,22
03500 CHRS OPF,".",23,23
03600 CHRS OPF,"/",24,24
03700 CHRS OPF,"0",25,25
03800 CHRS OPF,"1",26,26
03900 CHRS OPF,"2",27,27
04000 CHRS OPF,"9",30,30
04100 CHRS OPF,"6",31,31
04200 CHRS OPF,"4",32,32
04300 CHRS OPF,"=",33,33
04400 CHRS OPF,"<",34,34
04500 CHRS OPF,">",35,35
04600 CHRS OPF,"7",36,36
04700 CHRS OPF,"8",37,37
04800 0
04900 CHRS OPF,0,1,"!"
05000 CHRS OPF,0,2,42
05100 CHRS OPF,0,3,"#"
05200 CHRS OPF,0,4,"$"+NSEPF
05300 CHRS OPF,0,5,"%"+NSEPF
05400 CHRS OPF,0,6,"&"
05500 CHRS OPF,"'","'","'"
05600 CHRS OPF,0,10,"("
05700 CHRS OPF,0,16,")"
05800 CHRS OPF,0,17,"*"
05900 CHRS OPF,0,20,"+"
06000 CHRS OPF,0,21,<",">
06100 CHRS OPF,0,22,"-"
06200 CHRS OPF,0,23,"."+NSEPF
06300 CHRS OPF,0,24,"/"
06400 CHRS SNUMF,0,25,20
06500 CHRS SNUMF,0,26,21
06600 CHRS SNUMF,0,27,22
06700 CHRS SNUMF,0,176,23
06800 CHRS SNUMF,0,32,24
06900 CHRS SNUMF,0,"5",25
07000 CHRS SNUMF,0,31,26
07100 CHRS SNUMF,0,36,27
07200 CHRS SNUMF,0,37,30
07300 CHRS SNUMF,0,30,31
07400 CHRS OPF,0,174,":"
07500 CHRS OPF,0,<";">,<";">
07600 CHRS OPF,0,34,"<"
07700 CHRS OPF,0,33,"="
07800 CHRS OPF,0,35,">"
07900 CHRS OPF,0,37,"?"
08000 CHRS OPF,0,140,"@"
08100 XXZ=101
08200 REPEAT ^D26,<CHRS LETF,0,XXZ+40,XXZ-40
08300 XXZ=XXZ+1>
08400 CHRS OPF,0,173,"["
08500 CHRS OPF,0,"\","\"
08600 CHRS OPF,0,175,"]"
08700 CHRS OPF,0,"^","^"
08800 CHRS OPF,0,"_","_"
08900 CHRS OPF,100,140,140
09000 XXZ=141
09100 REPEAT ^D26,<CHRS LETF,XXZ-40,XXZ,XXZ-100
09200 XXZ=XXZ+1>
09300 CHRS OPF,"[",173,173+M37
09400 CHRS OPF,":",174,174+M37
09500 CHRS OPF,<"]">,175,175+M37
09600 CHRS OPF,"3",176,176
09700 CHRS OPF,"\",177,177
09800 CHRS OPF!TERM,0,0,ALTMOD
09900 SALL
00100 SUBTTL SCANNER
00200
00300 GNCHX: SKIPE TEMPP ;ARE WE READING IN-CORE TEMP DATA?
00400 JRST [ILDB C,TEMPP ;YES, GET NEXT CHARACTER
00500 JUMPE C,[SETZM TEMPP
00600 JRST GNCHIN]
00700 POPJ P,0]
00800 SOSLE TIBUF+2 ;CHECK FOR BUFFER EMPTY
00900 JRST GNCHOK ;OK. GET CHARACTER
01000 INPUT TTY,0
01100 STATO TTY,760000
01200 JRST GNCHOK
01300 RELEAS TTY,0
01400 GNCHIN: INIT TTY,1
01500 SIXBIT /TTY/
01600 TIBUF
01700 EXIT
01800 SKPINC ;KILL
01900 JFCL ; ^O
02000 TRZ FL2,RPGSW
02100 TRNN FL2,CRTINF ;DON'T STAR HIM IF AUTO INSERTING
02200 OUTCHR ["*"]
02300 MOVE C,TTYBUF ;ORIGINAL .JBFF STORED HERE
02400 EXCH C,.JBFF ;PRESENT .JBFF IN C,OLD .JBFF IN .JBFF
02500 INBUF TTY,2
02600 MOVEM C,.JBFF ;RESTORE .JBFF--NEW BUFFERS
02700 ;WITHOUT GROWING LARGER
02800 JRST GNCHX
02900 GNCHOK: ILDB C,TIBUF+1 ;GET A CHR
03000 POPJ P,
03100
03200 GNCH: PUSHJ P,GNCHX
03300 CAIN C,33 ;TEST OLD ALTMODE
03400 JRST .+3
03500 CAIE C,176
03600 CAIN C,175 ;CONVERT ALTMODE TO ALTMOD TO DISTINGUISH FROM
03700 MOVEI C,ALTMOD ;LEFT CURLY BRACKET
03800 TLNE FL,QMODF ;SHOULD WE TREAT ' SPECIALLY
03900 JRST GNCHB ;NO
04000 CAIN C,"'" ;SHOULD WE USE ALTERNATE CHR SET?
04100 JRST GNCHA ;YES
04200 GNCHB: JUMPE C,GNCH ;IGNORE NULLS
04300 MOVE CS,CTBL(C) ;GET CHARACTER TABLE BITS
04400 TLNE CS,LETFX ;CHECK TO SEE IF A LETTER
04500 TDC C,CASEBT ;USE UPPER/LOWER INFO
04600 POPJ P, ;NO, JUST RETURN
04700 GNCHA: PUSHJ P,GNCHX ;ALTERNATE CHR SET GET ANOTHER
04800 SKIPE CTBL(C) ;NO CHANGE FOR NULL,SPACE, TAB, CRET
04900 MOVS C,CTBL(C) ;GET THE ALTERNATE CHR FROM CHR TABLE
05000 ANDI C,177 ;ONLY THE CHR BITS
05100 JRST GNCHB ;GO CHECK THINGS
05200
05300 SCAN: TRZ FL,TERMF+NUMF+IDF ;RESET FLAGS
05400 SKIPE CS,SAVCHR ;CHECK TO SEE IF WE LEFT ONE LAST TIME
05500 JRST SL1 ;YES, IT MUST BE A DELIMITER
05600 SL10: PUSHJ P,GNCH ;GET A CHR
05700 JUMPE CS,SL10 ;CHECK FOR TAB, SPACE, AND IGNORE
05800 JUMPL CS,SL1 ;SPECIAL CHARACTER?
05900 MOVE T3,[POINT 6,ACCUM] ;SET TO SAVE IDENT
06000 SETZM ACCUM
06100 TLNE CS,SNUMFX ;CHECK FOR NUMBER
06200 JRST SNUM1 ;AND GO RACING OFF TO NUMBER ROUTINE
06300 SL2P: TRO FL,IDF ;IT IS AN IDENT
06400 SL2: TLNE T3,770000 ;HAVE WE STORED ENOUGH?
06500 IDPB CS,T3 ;NO, STORE ANOTHER (RH OF CHR TABLE HAS SIXBIT)
06600 PUSHJ P,GNCH ;CONTINUE
06700 JUMPG CS,SL2 ;CHECK FOR ANOTHER NUMBER OR LETTER
06800 SOK1: MOVEM CS,SAVCHR ;SAVE THE CHARACTER (MUST BE A SPECIAL CHR)
06900 MOVEI C,0 ;ZERO IN C FOR NUMBERS AND IDNETS
07000 POPJ P,
07100
07200 SL1: HRRZ C,CS ;FOR SPECIAL CHARACTERS, RETURN RH OF CTABLE
07300 TLNE CS,TERMX ;CHECK FOR TERMINATOR
07400 TRO FL,TERMF ;AND SET FLAG
07500 ANDI C,377 ;GET RID OF EXTRA BITS
07600 SETZM SAVCHR ;ZERO SAVCHR FOR LATER
07700 CAIE C,"." ;CHECK FOR .
07800 POPJ P, ;NO RETURN
07900 MOVE T1,CLN ;SET UP FOR CURRENT LINE AND PAGE
08000 MOVE T2,CPGL
08100 TRO FL,NUMF ;CALL IT A NUMBER
08200 POPJ P,
08300
08400 SNUM1: SETZB T1,T2 ;SET NUMBER ACCUMS TO 0
08500 SN1A: TLNE T3,770000 ;WILL STORE THE SIXBIT FOR FILE NAMES
08600 IDPB CS,T3 ;BUT ONLY IF LESS THAN 6
08700 LSH T1,7 ;ACCUMULATE ASCII IN T1
08800 IOR T1,C
08900 IMULI T2,^D10 ;DECIMAL IN T2
09000 ADDI T2,-"0"(C)
09100 PUSHJ P,GNCH ;GET NEXT AND CONTINUE
09200 JUMPLE CS,SOK2 ;CHECK FOR END OF NUMBER
09300 TLNN CS,SNUMFX ;CHECK FOR NUMBER
09400 JRST SL2P ;MUST BE AN IDENT
09500 JRST SN1A ;CONTINUE SCANNING NUMBER
09600 SOK2: TRO FL,NUMF ;IT WAS A NUMBER
09700 LSH T1,1 ;CONVERT TO LINE NUMBER
09800 IOR T1,[<ASCII /00000/>!1]
09900 JRST SOK1 ;SAVE DELIM AND RETURN
00100 SUBTTL PLACE FINDING ROUTINES
00200
00300 ;FIND-- PAGE TO FIND IS IN DPG. NUMBER TO FIND IS IN SINDEX.
00400 ;LOADS T1 WITH THE LINE NUMBER FOUND
00500 ;IF NO EXACT MATCH WILL FIND NEXT HIGHER NUMBER OR A PAGE MARK.
00600
00700 FIND: MOVE T1,DPG ;GET THE DESIRED PAGE
00800 CAMLE T1,CPG ;IS IT GREATER THAN THE PAGE WE ARE ON
00900 JRST FWDPG ;YES, SEARCH FORWARD FOR PAGE
01000 CAML T1,CPG ;IS IT THE SAME AS THE CURRENT PAGE?
01100 JRST FEQPG ;YES, JUST SEARCH FOR LINE NUMER
01200 SUBI PNTR,1 ;BACK UP A LITTLE (IN CASE POINTED AT PAGE MARK)
01300 FIND1: SKIPN T1,(PNTR) ;GET THE WORD, BUT WATCH FOR START OF BUFFER
01400 JRST FINDHD ;WILL HAVE TO FINISH COPY AND START OVER
01500 CAME T1,PGMK ;IS IT A PAGE MARK?
01600 SOJA PNTR,FIND1 ;CONTINUE SEARCHING
01700 SOS T1,CPG ;DECREASE THE PAGE WE ARE NOW ON
01800 CAME T1,DPG ;IS IT THE RIGHT ONE YET?
01900 SOJA PNTR,FIND1 ;NO, KEEP SEARCHING
02000 SUBI PNTR,1 ;BACK OVER PAGE MARK
02100 FIND2: SKIPN T1,(PNTR) ;PICK UP WORD AND CHECK FOR START OF BUFFER
02200 JRST FINDHD ;HAVE TO DO IT THE HARD WAY
02300 TRNN T1,1 ;IS IT A SEQUENCE NUMBER?
02400 SOJA PNTR,FIND2 ;NO, CONTINUE SEARCH
02500 CAMN T1,PGMK ;IS IT PERHAPS A PAGE MARK?
02600 AOJA PNTR,FNDFW1 ;YES, GO FORWARD A LINE AND RETURN IT
02700 CAMGE SINDEX,T1 ;IS THE LINE WE WANT GREATER OR EQUAL TO THIS ONE
02800 SOJA PNTR,FIND2 ;NO, KEEP UP THE GOOD WORK
02900 CAMN SINDEX,T1 ;EXACT MATCH?
03000 POPJ P, ;YES, RETURN
03100 JRST FNDFW1 ;GO FORWARD A LINE TO GET NEXT LARGER
03200 FEQPG: SKIPN T1,(PNTR) ;CHECK THE WORD WE ARE POINTING AT
03300 JRST FNDFOO ;MUST BE POINTING AT END OF BUFFER OR BUFFER EMPTY
03400 CAMN T1,PGMK ;IS IT A PAGE MARK?
03500 SOJA PNTR,FIND2 ;MUST BE ONE AT END OF PAGE, SEARCH BACKWARDS
03600 FEQPG1: CAMGE SINDEX,T1 ;COMPARE TO LINE WE WANT
03700 JRST FIND2 ;WANT A SMALLER ONE, SEARCH BACK
03800 JRST FNDFW1 ;SEARCH FORWARD
03900 FWDPG: SKIPN T1,(PNTR) ;SEARCH FORWARD FOR PAGE
04000 JRST FNXRCP ;END OF BUFFER, GET A NEW ONE
04100 CAME T1,PGMK ;FOUND A PAGE MARK?
04200 AOJA PNTR,FWDPG ;NO, CONTINUE
04300 AOS T1,CPG ;ADVANCE CURRENT PAGE COUNT
04400 CAME T1,DPG ;AND SEE IF WE ARE THER YET
04500 AOJA PNTR,FWDPG ;NUTS, LOOK SOME MORE
04600 ADDI PNTR,1 ;ADVANCE BEYOND PAGE MARK
04700 FNDFW1:
04800 FIND3: SKIPN T1,(PNTR) ;LOOK FOR LINE
04900 JRST FNXRC ;END OF RECORD, GET A NEW ONE
05000 TRNN T1,1
05100 AOJA PNTR,FIND3 ;NOT LINE NUMBER
05200 CAMN T1,PGMK ;PAGE MARK
05300 POPJ P, ;RETURN IT, IT IS BEST MATCH WE CAN FIND
05400 CAMLE SINDEX,T1 ;ARE WE THERE YET?
05500 AOJA PNTR,FIND3 ;NO, CONTINUE SEARCH
05600 POPJ P, ;YES, FINALLY
05700
05800 FNDFOO: CAMN PNTR,BUFP ;ARE WE POINTED TO START OF BUFFER
05900 JRST FDFOO1 ;YES, BUFFER MUST BE EMPTY
06000 SUBI PNTR,1 ;NO, MUST HAVE BEEN AT END OF BUFFER
06100 FDFOO2: SKIPN T1,(PNTR) ;GET WORD
06200 ERROR ICN ;MUST BE CONFUSED, THERE SHOULD BE A LINE NUMBER
06300 TRNN T1,1 ;SEARCH FOR LINE NUMBER
06400 SOJA PNTR,FDFOO2 ;KEEP LOOKING
06500 CAMN T1,PGMK ;IS IT A PAGE MARK
06600 AOJA PNTR,FNDFW1 ;YES, SEARCH FORWARD
06700 JRST FEQPG1 ;GO DO SOMETHING WITH IT
06800 FDFOO1: TRNE FL,EOF2 ;ARE WE AT END OF FILE?
06900 JRST FINDHD ;WILL HAVE TO TRY FROM START
07000 PUSHJ P,GETN ;GET THE NEXT BUFFER
07100 JRST FEQPG
07200 FNXRCP: TRNE FL,EOF2 ;AR WE AT END OF FILE
07300 JRST FNX1 ;YES, JUST RESET BGPG AND LOOK AGAIN
07400 PUSHJ P,GETN ;GET THE NEXT BUFFER
07500 JRST FWDPG ;AND CONTINUE SEARCH
07600 FNX1: MOVE T1,CPG ;SET BGPG TO CURRENT PAGE
07700 MOVEM T1,BGPG
07800 TRO FL,BGSN ;RECORD THAT LARGEST PAGE SEEN
07900 MOVEI T1,0 ;RETURN 0 FOR EOF
08000 POPJ P,
08100
08200 FNXRC: TRNE FL,EOF2 ;ARE WE AT END OF FILE
08300 JRST FNX1 ;YES, GIVE HIM BACK THE 0
08400 PUSHJ P,GETN ;NO, GET THE NEXT BUFFER
08500 JRST FIND3 ;AND CONTINUE LOOKING FOR LINE
08600
08700 FINDHD: TRNE FL,BOF ;ARE WE AT THE START OF THE FILE
08800 JRST FNDFST ;YES, CAN NOT GO BACK JUST GIVE FIRST LINE OF FILE
08900 TRNN FL,READOF ;DON'T BOTHER IN READ ONLY MODE
09000 PUSHJ P,OCOMPL ;COMPLETE THE COPY
09100 TLNE FL,COPFIL ;IS THIS A COPY
09200 JRST FINDH4 ;YES, DON'T RELEASE IN AND OUT
09300 TRNN FL2,ALTIOF
09400 JRST FINDH6
09500 TRO FL2,FORCEF
09600 TTCALL 3,[ASCIZ/YOU WILL BE FORCED TO EXIT,YOU CAN'T WRAP AROUND
09700 /]
09800 JRST ENDIT
09900
10000 FINDH6: RELEASE IN,0 ;RELEASE IO DEVICES
10100 RELEASE OUT,0
10200 MOVEI T1,14 ;MODE 14
10300 MOVE T2,ORGDEV ;DEV
10400 MOVEI T3,IBUF ;BUFFER
10500 OPEN IN,T1
10600 JRST NODSK ;WHERE DID THE DISK GO, IT WAS HARE BEFORE
10700 MOVSI T3,OBUF ;BUFFER
10800 OPEN OUT,T1
10900 JRST NODSK
11000 MOVE T1,BUFHD ;SET UP .JBFF TO ESTABLISH BUFFERS
11100 MOVEM T1,.JBFF
11200 INBUF IN,2
11300 OUTBUF OUT,2
11400 TRNE FL,READOF ;ARE WE IN READ ONLY MODE?
11500 JRST FINDH2 ;SET TO POINT TO ORIGINAL NAME AGAIN
11600 MOVE T1,EDNAM
11700 MOVEM T1,NAMO
11800 MOVEM T1,NAMI
11900 MOVSI T1,(SIXBIT/TMP/) ;AND EXTENSION
12000 MOVEM T1,NAMO+1
12100 MOVEM T1,NAMI+1
12200 SETZM NAMO+2
12300 SETZM NAMO+3
12400 SETZM NAMI+3
12500 LOOKUP IN,NAMI ;GET THAT FILE
12600 JRST EDFLIX ;BUT IT JUST PUT ONE THERE
12700 ENTER OUT,NAMO
12800 JRST EDFLIN ;SOME OTHER BASTARD MUST BE USING IT
12900 SETZM COMNDS ;ZAP THE COUNT ON WRAP-AROUND OF FILE
13000 FINDH3: SETZM WC ;WC STARTS OUT 0
13100 TRZ FL,EOF!EOF2 ;NOT AT EOF YET
13200 TRO FL,BOF ;BUT ARE AT START OF FILE
13300 TLO FL,FSTOPF ;SET FOR FIRST OP
13400 TLZ FL,TECOF ;BUT NOT TECO
13500 MOVEI T1,1 ;SET UP INPUT PAGE IN CASE OF
13600 MOVEM T1,INPG ;ORDER OR LTL ERRORS ON INPUT
13700 SETZM SVWD
13800 SETZM OLDLIN ;USED IN CHECKING INPUT ORDER OF LINES
13900 PUSHJ P,FILLBF ;FILL UP THE BUFFER
14000 MOVEI T1,1
14100 MOVEM T1,CPG ;START ON PAGE 1
14200 MOVE PNTR,BUFP ;SET PNTR TO START OF WORLD
14300 JRST FIND ;AND GO LOOKING
14400
14500 FNDFST: MOVE T1,@BUFP ;GET FIRST WORD
14600 FNDFS1: MOVE PNTR,BUFP ;SET TO START OF WORLD
14700 POPJ P, ;AND DISMISS
14800
14900 FINDH4: RELEASE ALTDV,0 ;LET GO OF ALTERNATE DEVICE
15000 MOVEI T1,14 ;MODE 14
15100 MOVE T2,ORGDEV ;DEVICE
15200 MOVEI T3,ALTBF ;BUFFER
15300 OPEN ALTDV,T1
15400 JRST NODSK
15500 MOVE T1,SVJRL2
15600 MOVEM T1,.JBFF
15700 INBUF ALTDV,2 ;ALL SET UP
15800 FINDH2: MOVE T1,ORGNAM ;SET TO ORIGINAL NAME
15900 MOVEM T1,NAMI
16000 MOVE T1,ORGEXT
16100 MOVEM T1,NAMI+1
16200 MOVE T1,ORGPPN ;ALSO SAME PPN
16300 MOVEM T1,NAMI+3
16400 TLNE FL,COPFIL
16500 JRST FINDH5
16600 LOOKUP IN,NAMI
16700 JRST NOFIL ;NO FILE THERE START OVER
16800 JRST FINDH3 ;GO ON
16900
17000 FINDH5: LOOKUP ALTDV,NAMI
17100 JRST NOFIL
17200 JRST FINDH3
17300
17400 ;FIND THE NEXT LINE, PAGE MARK, ETC.
17500
17600 FINDN1: SKIPN T1,(PNTR)
17700 JRST FINDN2
17800 TRNN T1,1
17900 FINDN: AOJA PNTR,FINDN1
18000 POPJ P, ;RETURN THE LINE
18100 FINDN2: TRNE FL,EOF2 ;IS IT EOF?
18200 POPJ P, ;YES, RETURN PRESENT T1 (0 FOR EOF)
18300 PUSHJ P,GETN ;GET NEXT BUFFER
18400 JRST FINDN1 ;GO LOOK SOME MORE
18500 FINDZ1: SKIPN T1,(PNTR) ;AS FINDN BUT STOPS AT END OF RECORD
18600 POPJ P,
18700 TRNN T1,1 ;LINE NUMBER?
18800 FINDZ: AOJA PNTR,FINDZ1
18900 POPJ P,
19000
19100 ;FIND THE PREVIOUS LINE
19200
19300 FINDB1: SKIPN T1,(PNTR) ;WATCH OUT FOR START OF BUFFER
19400 JRST FINDB2
19500 TRNN T1,1 ;LINE NUMBER?
19600 FINDB: SOJA PNTR,FINDB1 ;TRY AGAIN
19700 CAMN T1,PGMK ;TEST FOR PAGE MARK
19800 SOS CPG ;NOW ON PREVIOUS PAGE
19900 POPJ P, ;RETURN LINE NUMBER
20000 FINDB2: TRNE FL,BOF ;AT START OF FILE?
20100 JRST FNDFS1 ;YES, GO GET THE FIRST LINE OF FILE
20200 MOVE T1,1(PNTR) ;GET THE FIRST LINE ON THIS PAGE
20300 TRNN T1,1 ;MAKE SURE THERE IS ONE THERE
20400 ERROR ICN ;NO, WE ARE CONFUSED
20500 PUSH P,SINDEX ;SAVE (CALLER MAY NEED IT)
20600 MOVE SINDEX,T1
20700 PUSHJ P,FINDHD ;THIS WILL WORK AND WE WILL HAVE A LITTLE SPACE
20800 POP P,SINDEX ;GET THIS BACK
20900 SOJA PNTR,FINDB1 ;GO LOOK BACK AGAIN
00100 SUBTTL BUFFER HANDLING ROUTINES
00200
00300 OCOMPL: 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 JRST OCOMPL ;AND GO DUMP THIS ONE TOO
01100 GETWD: TRNE FL,EOF
01200 JRST RTEOF ;RETURN 0 IF EOF
01300 TLNE FL,COPFIL ;IN A COPY, WE GET FROM SOMEWHERE ELSE
01400 JRST COPGET
01500 SOSG IBUF+2 ;CHECK FOR MORE WORDS
01600 JRST GETDO ;NO, GET SOME BY INPUT
01700 GETWD1: ILDB T3,IBUF+1 ;PICK UP A WORD
01800 JUMPE T3,GETWD ;IGNORE 0 WORDS
01900 POPJ P, ;RETURN
02000
02100 GETDO: INPUT IN,0
02200 STATO IN,760000 ;CHECK FOR ERRORS AND EOF
02300 JRST GETWD1
02400 STATZ IN,740000 ;ERROR?
02500 ERROR DIE ;YES, INPUT ERROR
02600 TRO FL,EOF ;NO, MUST BE EOF
02700 RTEOF: MOVEI T3,0 ;RETURN 0
02800 POPJ P,
02900
03000 OUTWD: SOSG OBUF+2 ;CHECK WORDS LEFT
03100 PUSHJ P,OUTDO
03200 IDPB T3,OBUF+1 ;OUTPUT IT
03300 POPJ P, ;AND RETURN
03400
03500 OUTDO: TRNE FL2,DSKCK
03600 PUSHJ P,DSKTST ;DO WE GOT ENOUGH DSK
03700 OUTPUT OUT,0
03800 STATO OUT,760000 ;CHECK FOR ERRORS
03900 POPJ P,
04000 ERROR DDE ;YES, GIVE ERROR AND BOMB OUT
04100 DUMP: MOVE T2,BUFP ;DUMP BUFFER FROM BUFP TO (T1)
04200 CAMGE T2,T1 ;CHECK TO SEE IF WE ARE DUMPINF ANYTHING
04300 TRZ FL,BOF ;IF SO TURN OFF BOF
04400 TRNN FL,READOF ;RETURN IF READ ONLY MODE
04500 DUMP1: CAML T2,T1 ;MORE TO DO?
04600 POPJ P, ;NO, RETURN
04700 PUSH P,T1 ;SAVE FOR LATER
04800 MOVEI T1,1(T2) ;FIND END OF THIS LINE
04900 DUMP3: SKIPN T3,(T1) ;ANY OLD END WILL DO
05000 JRST DUMP2
05100 TRNN T3,1 ;SUCH AS A LINE NUMBER
05200 AOJA T1,DUMP3 ;NOT YET
05300 DUMP2: SUB T1,T2 ;GET LENGTH
05400 CAML T1,OBUF+2 ;WILL IT FIT?
05500 PUSHJ P,OUTDO ;NO, DUMP CURRENT BUFFER
05600 DUMP4: MOVE T3,(T2) ;PICK UP WORD
05700 PUSHJ P,OUTWD
05800 ADDI T2,1 ;ADVANCE POINTER
05900 SOJG T1,DUMP4 ;AND CHECK COUNT
06000 POP P,T1
06100 JRST DUMP1 ;GO CHECK FOR END
06200
06300 DSKTST: PUSH P,T1
06400 PUSH P,T2 ;SAVE SOME AC'S
06500 PUSHJ P,FREDSK ;FIND OUT HOW MUCH DISK THERE IS.
06600 CAIL T1,MINDSK
06700 JRST DSKRET ;MAYBE WE GOT ENOUGH
06800 CLRBFI ;ZONK ANY TYPE-AHEAD
06900 TTCALL 3,DSKMS2 ;TELL HIM WHAT HAPPENED
07000 PUSHJ P,TELD.1
07100 TRON FL2,DSKSMF ;BE BRIEF NEXT TIME
07200 DSKT.4: TTCALL 3,DSKMSG ;THE LONG STORY
07300 WAITLP: TTCALL 3,[ASCIZ/
07400
07500 WELL? ?/]
07600 INCHRW T1 ;HANG UP UNTIL HE TYPES A CHARACTER
07700 DSKANS: CLRBFI ;CLEAR OUT THE BUFFER
07800 OUTSTR ASCRLF
07900 ANDI T1,137 ;FORCE TO UPPER CASE
08000 CAIN T1,"X"
08100 JRST NOWAIT
08200 CAIN T1,"B"
08300 JRST DSKRES
08400 CAIN T1,"T" ;IF IT'S A T THEN RETURN
08500 JRST TTEST ;IT WAS A "T"
08600 CAIE T1,"S" ;SLEEP?
08700 JRST DSKT.4 ;HE EITHER CANNOT TYPE OR REMEMBER
08800 TRO FL2,RALPHF
08900 DORALF: SKPINC ;IS THERE A CHARACTER TO BE INPUT?
09000 JRST TRYDSK
09100 JRST DSKANS+1
09200 TRYDSK: MOVEI T1,1
09300 SLEEP T1, ;FOR 1 SECOND
09400 TTEST: PUSHJ P,FREDSK ;NOW TEST
09500 BTEST: CAIL T1,MINDSK
09600 JRST [TTCALL 3,[ASCIZ/
09700 DSK OK NOW.
09800 /]
09900 JRST DSKRET]
10000 TRNN FL2,RALPHF
10100 JRST WAITLP
10200 TTCALL 3,[BYTE (7) 15,0] ;LET HIM KNOW THAT WE LIVE
10300 JRST DORALF
10400
10500 NOWAIT: TRZ FL2,DSKCK
10600 DSKRET: POP P,T2
10700 POP P,T1
10800 POPJ P,
10900
11000 DSKRES: PUSHJ P,TELDSK
11100 JRST BTEST
11200
11300 FREDSK: MOVE T1,[XWD 3,STRNAM] ;TRY DSKCHR UUO
11400 DSKCHR T1,
11500 SKIPA T1,[EXP ^D100] ;DIDN'T WORK; RETURN 100
11600 MOVE T1,STRNAM+1 ;WORKED, PICK UP USER AMOUNT
11700 SKIPG T1 ;HAS HE STARTED TO OVERDRAW?
11800 JRST [MOVE T1,OVRDRW ;PICK UP O.D. QUOTA
11900 SUB T1,STRNAM+1 ;FIND WHAT'S LEFT
12000 JRST .+1]
12100 CAMLE T1,STRNAM+2 ;HOW ABOUT THE REST OF THE WORLD?
12200 MOVE T1,STRNAM+2 ;THE DISK IS FULL, GIVE HIM THE LESSER
12300 POPJ P,
12400
12500 DSKMSG: ASCIZ/
12600 YOU MUST TYPE:
12700 X TO DO THE OUTPUT REGARDLESS (NOW AND FOREVER),
12800 T TO TEST DISK & OUTPUT IF SPACE IS AVAILABLE,
12900 B TO TYPE RESOURCES & OUTPUT IF THERE IS SPACE, OR
13000 S TO SLEEP UNTIL EITHER SPACE APPEARS OR YOU TYPE SOMETHING.
13100 /
13200 DSKMS2: ASCIZ /
13300 [INADEQUATE DISK SPACE TO DO OUTPUT.]
13400 /
00100 GETN: MOVE T1,WC ;GET THE NEXT BUFFER. FIND CURRENT WORD COUNT
00200 CAMGE T1,HLFWC ;GREATER THAN HALF OF MAX POSSIBLE?
00300 JRST FILLBF ;NO, JUST REFILL BUFFER
00400 ASH T1,-1 ;YES, TAKE HALF OF IT
00500 ADD T1,BUFP ;CONVERT TO POINTER
00600 GETN1: SKIPN T2,(T1) ;LOOK FOR A WORD BOUNDARY
00700 JRST NOWFL ;WE ARE HERE?
00800 TRNN T2,1 ;SEQUENCE NUMBER?
00900 SOJA T1,GETN1
01000 NOWFL: PUSHJ P,DUMP ;DUMP IT
01100 MOVE T2,T1 ;COPY POINTER
01200 SUB T2,BUFP ;AND FIND OUT HOW MANY DUMPED
01300 SUB PNTR,T2 ;ADJUST POINTER
01400 EXCH T2,WC ;CALC NEW WORD COUNT
01500 SUBB T2,WC
01600 ADD T2,BUFP ;GET POINTER TO END OF BUFFER
01700 HRLS T1 ;SET UP BLT
01800 HRR T1,BUFP
01900 BLT T1,(T2)
02000 JRST FILLBF ;AND FINISH FILLIN BUFFER
02100
02200 FILLBF: MOVE T1,WC ;GET WORD COUNT
02300 ADD T1,BUFP ;AND CONVERT TO POINTER TO END OF BUFFER
02400 FILBF3: CAML T1,FILPT ;FULL ENOUGH?
02500 POPJ P, ;YES, RETURN
02600 TLNE FL,TECOF ;SPECIAL READING FOR TECO FILES
02700 JRST RDTECO
02800 HRLI T1,-MXWPL-2 ;GET A COUNT FOR MAX LINE SIZE
02900 SKIPN T3,SVWD ;SEE IF THERE IS A WORD LEFT FROM LAST TIME
03000 PUSHJ P,GETWD ;ELSE GET A NEW ONE
03100 JUMPE T3,SNEOF ;MUST BE EOF
03200 CAMN T3,PGMK ;IS THIS A PAGE MARK?
03300 JRST CKPGMK ;YES.
03400 TLZE FL,FSTOPF ;IF FIRST OP
03500 JRST CKTECO ;CHECK FOR TECO FILE
03600 NOTECO: MOVEM T3,SVWD2 ;SAVE FOR SEQUENCE CHECK
03700 JRST FILBF4 ;GO PUT IT AWAY
03800 FILBF1: PUSHJ P,GETWD ;ELSE GET A NEW ONE
03900 JUMPE T3,FILBF2 ;0 WORD MUST BE EOF
04000 TRNE T3,1 ;CHECK FOR SEQNUM
04100 JRST FILBF2 ;YES, FINISH PUTTING IT IN
04200 FILBF4: MOVEM T3,(T1) ;PUT IN THIS WORD
04300 AOS WC ;AND ADVANCE WORD COUNT
04400 AOBJN T1,FILBF1 ;ADVANCE POINTER AND CHECK COUNT
04500 JRST INLTL ;LINE IS TOO LONG
04600 FILBF2: MOVEM T3,SVWD ;SAVE THIS WORD
04700 MOVE T4,[POINT 7,-1(T1),34]
04800 CKLF1: MOVE T3,@T4 ;PICK UP WORD
04900 TRNE T3,1 ;IS IT THE LINE NUMBER?
05000 JRST CKLF2 ;YES.
05100 LDB T3,T4 ;GET CHAR OUT OF LINE
05200 JUMPE T3,[SUBI T4,1
05300 IBP T4
05400 IBP T4
05500 IBP T4
05600 IBP T4
05700 JRST CKLF1]
05800 SUBI T4,1
05900 IBP T4
06000 IBP T4
06100 IBP T4
06200 IBP T4
06300 MOVE T3,@T4
06400 TRNE T3,1
06500 CKLF2: IBP T4
06600 MOVEI T3,15 ;MAKE SURE LAST TWO CHARS ARE CR AND LF
06700 DPB T3,T4
06800 MOVEI T3,12
06900 IDPB T3,T4
07000 FILBF0: SETZM (T1) ;MAKE SURE OF A ZERO WORD
07100 HRRZS T1 ;ELIMINATE COUNT INFO
07200 MOVE T3,SVWD2 ;CHECK ON ORDER OF INPUT LINES
07300 CAMG T3,OLDLIN ;CHECK FOR CORRECT ORDER
07400 JRST OUTOFO ;LINES ARE OUT OF ORDER
07500 FILBF5: MOVEM T3,OLDLIN ;SAVE FOR LATER
07600 SKIPE SVWD ;CHECK TO SEE IF WAS EOF
07700 JRST FILBF3 ;AND TRY FOR MORE
07800 SNEOF: SETZM (T1) ;MAKE SURE OF ZERO WORD
07900 TRO FL,EOF2 ;SET EOF FLAG
08000 MOVE T1,INPG ;GET INPUT PAGE
08100 MOVEM T1,BGPG ;AND SET LARGEST PAGE
08200 TRO FL,BGSN
08300 SETZM SVWD ;ALSO ZERO EXTRA WORD
08400 POPJ P, ;AND RETURN
08500
08600 CKPGMK: SETZM OLDLIN ;NO OUT OF ORDER IF ON NEW PAGE
08700 AOS INPG ;INCREMENT PAGE NUMBER
08800 MOVEM T3,(T1) ;STORE PAGE MARK
08900 AOS WC
09000 PUSHJ P,GETWD ;GET FOLLOWING WORD
09100 MOVE T3,PGMKTX
09200 MOVEM T3,1(T1) ;STORE CORRECT DATA
09300 AOS WC
09400 SETZM 2(T1) ;MAKE SURE OF ZERO WORD AT END
09500 MOVEI T1,2(T1) ;ADD 2 TO T1, CLEAR LH
09600 SETZM SVWD ;FORCE A READ NEXT TIME
09700 JRST FILBF3
09800 INLTL: PUSHJ P,GETWD ;FIND THE END OF THE LINE ON INPUT
09900 JUMPE T3,INLTL2 ;THIS IS IT
10000 TRNN T3,1 ;OR MAYBE THIS
10100 JRST INLTL ;KEEP LOOKING
10200 INLTL2: MOVEM T3,SVWD ;SAVE IT
10300 PUSH P,T1 ;SAVE POINTER TO END OF IT
10400 SUBI T1,2 ;LAST PART THAT IS IN THE LINE
10500 MOVEI T2,<BYTE (21)0(7)15,12> ;A CRLF
10600 DPB T2,[POINT 15,(T1),35] ;MAKE SURE IT ENDS PROPERLY
10700 INLTL1: SKIPN T2,(T1) ;NOW LOOK FOR THE START OF IT
10800 ERROR ICN ;SOMETHING HAS GONE WRONG, THERE IS NO LINE
10900 TRNN T2,1 ;START?
11000 SOJA T1,INLTL1 ;NO, TRY AGAIN
11100 MOVE T2,INPG ;PRINT HIM THE CURRENT PAGE
11200 PUSHJ P,PGPRN
11300 PUSHJ P,OUTLIN ;PRINT THE LINE
11400 RERROR LTL ;AND THE ERROR MESSAGE
11500 POP P,T1 ;RESTORE POINTER TO END
11600 SOS WC ;GET WORD COUNT CORRECTED
11700 SOJA T1,FILBF0 ;AND CONTINUE FILL
11800
11900 OUTOFO: PUSH P,T1 ;SAVE THE POINTER
12000 PUSH P,T3 ;SAVE T3 ALSO
12100 SUBI T1,1 ;GET BACK INTO LINE
12200 OUTOF1: SKIPN T2,(T1) ;LOOK FOR START OF LINE
12300 ERROR ICN ;HORRIBLE CONFUSION
12400 TRNN T2,1 ;CHECK FOR SEQ NUM
12500 SOJA T1,OUTOF1 ;NOPE, TRY SOME MORE
12600 MOVE T2,INPG ;PRINT HIM THE PAGE
12700 PUSHJ P,PGPRN
12800 PUSHJ P,OUTLIN ;PRINT THE LINE
12900 RERROR ORDER ;GIVE HIM SOMETHING TO THINK ABOUT
13000 POP P,T3 ;RESTORE
13100 POP P,T1 ;GET SET TO GO ON
13200 JRST FILBF5 ;GO
13300 CKTECO: TRNE T3,1 ;CHECK FOR A LINE NUMBER
13400 JRST NOTECO ;NO ITS NOT A TECO FILE
13500 TLO FL,TECOF ;SET WARNING FLAG
13600 TLNE FL,COPFIL ;IS IT ANOTHER FILE?
13700 JRST CKTEC2 ;SPECIAL CHECK
13800 SETSTS IN,0 ;SET FOR CHAR AT A TIME INPUT
13900 MOVSI T3,(<POINT 7,0>)
14000 HLLM T3,IBUF+1 ;SET INPUT BYTE POINTER
14100 MOVE T3,IBUF+2 ;TAKE BACK THE WORD WE JUST TOOK OUT
14200 IMULI T3,5 ;AND CONVERT TO CHARS
14300 AOS T3 ;BECAUSE SOS AT GETWD
14400 MOVEM T3,IBUF+2
14500
14600 RDTECO: HRRZM T1,TMPT1 ;SAVE THIS FOR A WHILE
14700 MOVEI T3,1(T1) ;ZERO OUT A FEW WORDS
14800 HRL T3,T1
14900 SETZM (T1)
15000 BLT T3,MXWPL(T1)
15100 ADDI T1,1 ;THIS IS WHERE CHRS SHOULD BE PUT
15200 PUSH P,T1 ;SAVE
15300 MOVE T1,SVWD ;LAST LINE NUMBER
15400 MOVE T2,INCR
15500 PUSHJ P,ASCIAD
15600 MOVEM T1,SVWD ;SAVE FOR LATER
15700 MOVEM T1,SVWD2 ;AND FOR ORDER CHECK
15800 CAMGE T1,INCR
15900 JRST INSPG1 ;FORCE PAGE INSERT
16000 EXCH T1,(P) ;GET OLD T1 BACK AND SAVE NUMBER
16100 MOVEI T2,MXWPL*5-2 ;COUNT
16200 MOVEI T3,11 ;FIRST CHR
16300 HRLI T1,(<POINT 7,0>)
16400 IDPB T3,T1
16500 LINL1: PUSHJ P,GETWD ;NEXT CHR
16600 CAIN T3,15
16700 JRST LINL1 ;IGNORE RETURNS
16800 CAIN T3,14
16900 JRST IPGMK ;GO PUT IN A PAGE MARK
17000 JUMPE T3,EOF1 ;MUST BE END OF FILE
17100 POP P,-1(T1) ;PUT NUMBER IN PROPER PLACE
17200 JRST LP1 ;AND READ MORE OF LINE
17300
17400 CLP: PUSHJ P,GETWD
17500 LP1: CAIN T3,15 ;IGNORE RETURNS
17600 JRST CLP
17700 CAIE T3,0 ;FOR EOF
17800 CAIN T3,12 ;OR LINE FEED
17900 JRST LINFD ;GO PUT IN RETURN LINE FEED
18000 IDPB T3,T1 ;ELSE DEPOSTI
18100 SOJG T2,CLP ;HAVE WE RUN OUT
18200 ADD T1,[XWD 700,0] ;BACK UP POINTER
18300 TLZ FL,TECOF ;USE THE ABSENCE AS A FLAG
18400 PUSHJ P,GETWD
18500 CAIE T3,12
18600 JUMPN T3,.-2
18700 LINFD: MOVEI T3,15
18800 IDPB T3,T1
18900 MOVEI T3,12
19000 IDPB T3,T1
19100 MOVEI T1,1(T1)
19200 MOVE T3,T1
19300 SUB T3,TMPT1 ;GET COUNT
19400 ADDM T3,WC
19500 TLOE FL,TECOF ;IF OFF WE HAD A LTL ERR
19600 JRST FILBF0 ;THIS WILL FINISH UP
19700 PUSH P,T1 ;SET UP FOR LTL CODE
19800 AOS WC
19900 AOS (P)
20000 SOJA T1,INLTL1
20100 INSPG1: POP P,T1
20200 SKIPA
20300 IPGMK: POP P,T2 ;GET RID OF IT
20400 MOVEI T3,1 ;SO IT WILL NOT BE EOF
20500 MOVEM T3,SVWD ;SO WE START OVER
20600 MOVE T3,PGMK
20700 MOVEM T3,OLDLIN
20800 MOVEM T3,-1(T1)
20900 MOVEI T2,2
21000 ADDM T2,WC
21100 MOVE T3,PGMKTX
21200 MOVEM T3,(T1)
21300 SETZM 1(T1) ;FORCE A ZERO WORD AT END
21400 MOVEI T1,1(T1) ;INCREMENT T1 AND CLEAR LH
21500 AOS INPG ;INCREMENT PAGE
21600 JRST FILBF3
21700
21800 EOF1: POP P,T2 ;CLEAR STACK
21900 SOJA T1,SNEOF
00100 SUBTTL RANGE SPECIFIER READERS
00200 ;ROUTINE TO GET ONE LINE NUMBER FROM INPUT STREAM. HANDLES + AND -
00300
00400 GETL: TRZ FL,LINSN+ADDL+SUBL
00500 TRZ FL2,STARF
00600 TLZ FL2,UPAROW
00700 CAIN C,"*"
00800 JRST DOLST
00900 CAIN C,"^" ;BEGINNING OF PAGE?
01000 JRST FRSLST
01100 TRZN FL,NUMF
01200 POPJ P, ;SCAN DID NOT SEE A NUMBER RETURN
01300 MOVEM T1,HILN ;SAVE THE NUMBER HERE
01400 GETL1: TRO FL,LINSN ;SET A FLAG TO SAY WE SAW THE LINE
01500 PUSHJ P,SCAN ;SCAN FOR + OR -
01600 CAIN C,"+"
01700 JRST ADDNUM
01800 CAIE C,"-"
01900 POPJ P, ;NEITHER
02000 TROA FL,SUBL ;SET SUBTRACT FLAG
02100 ADDNUM: TRO FL,ADDL ;SET ADD FLAG
02200 PUSHJ P,SCAN ;SCAN ANOTHER
02300 TRZN FL,NUMF ;WAS IT A NUMBER
02400 NERROR ILC ;ANYTHING ELSE IS ILLEGAL
02500 MOVEM T2,SVINC ;SAVE IT
02600 JRST SCAN ;RETURN AFTER SCANNING ONE MORE
02700
02800 FRSLST: TLOA FL2,UPAROW
02900 DOLST: TRO FL2,STARF
03000 JRST GETL1
00100 ;ROUTINE TO RESOLVE THE + AND - IN THE LINE NUMBER. WE MUST WAIT
00200 ;UNTIL THE PAGE HAS BEEN DEFINED BEFORE DOING THIS
00300
00400 ADDSUB: MOVE SINDEX,HILN ;GET THE NUMBER
00500 MOVE T1,HIPG ;GET THE REQUIRED PAGE
00600 MOVEM T1,DPG ;AND SET IT AS THE DESIRED ONE
00700 TRNN FL2,STARF
00800 JRST DOAS
00900 MOVE SINDEX,[<ASCII /99999/>!1] ;FIND A BIG LINE
01000 PUSHJ P,FIND
01100 CAME T1,[<ASCII /99999/>!1] ;IF ITS THERE ITS LAST
01200 PUSHJ P,FINDB ;ELSE BACK UP
01300 SKIPE T1 ;CHECK TO SEE IF EMPTY PAGE
01400 CAMN T1,PGMK
01500 JRST .+2
01600 MOVE SINDEX,T1 ;OK, USE ONE FOUND, ELSE LEAVE BIG
01700 DOAS: TLNN FL2,UPAROW ;GET TOP OF PAGE?
01800 JRST NOTAS ;NO!
01900 MOVE SINDEX,[<ASCII /00000/>!1]
02000 PUSHJ P,FIND
02100 MOVE SINDEX,T1 ;GET THE FIRST LINE NUMBER
02200 AOS SVINC ;FUDGE IN THE INC
02300 NOTAS: TRZE FL,ADDL ;DID WE WANT TO ADD?
02400 JRST ADLIN ;YES, GO ADD
02500 TRZN FL,SUBL ;OR SUBTRACT?
02600 CPOPJ: POPJ P, ;NO, RETURN
02700 PUSHJ P,FIND ;GET THE DESIRED LINE
02800 SUBL1: SOSGE SVINC ;DO WE WANT TO GO BACK STILL FARTHER
02900 POPJ P, ;NO, ALL DONE
03000 PUSHJ P,FINDB ;GET THE PREVIOUS LINE
03100 SKIPE T1 ;0 MUST BE AT START OF BUFFER, QUIT
03200 CAMN T1,PGMK ;WAS IT A PAGE MARK?
03300 POPJ P, ;YES, AS FAR AS WE GO, SINDEX HAS CORRECT NUMBER
03400 MOVE SINDEX,T1 ;THIS WILL DO
03500 JRST SUBL1 ;GO TRY FOR MORE
03600
03700 ADLIN: PUSHJ P,FIND ;GET DESIRED LINE
03800 CAME T1,PGMK ;WAS IT A PAGE MARK?
03900 JUMPN T1,ADLIN1 ;OR 0 (I.E. END OF FILE)
04000 POPJ P, ;RETURN WITH ORIGINAL NUMBER
04100
04200 ADLIN1: CAME T1,HILN ;SEE IF AN EXACT MATCH
04300 SOS SVINC ;IF NO, ALREADY ARE +1
04400 MOVE SINDEX,T1 ;GET THE WORD WE HAVE FOUND
04500 ADLIN2: SOSGE SVINC ;NEED TO GO FURTHER
04600 POPJ P, ;NO, RETURN RESULTS
04700 PUSHJ P,FINDN ;GET THE NEXT LINE IN SEQUENCE
04800 CAME T1,PGMK ;PAGE MARK?
04900 JUMPN T1,.+2 ;OR EOF
05000 POPJ P, ;YES, RETURN
05100 MOVE SINDEX,T1 ;ACCEPT NEW NUMBER
05200 JRST ADLIN2 ;AND LOOK FOR MORE
00100 ;ROUTINE GETS A FULL SEQ NUMBER OF FORM A/B
00200
00300 GETLAS: PUSHJ P,SCAN
00400 GETLA: PUSHJ P,GETL ;GET THE LINE NUMBER PART
00500 TRZ FL,PGSN ;NO PAGE SEEN YET
00600 CAIE C,"/" ;IS THIS A PAGE COMMING?
00700 JRST NOPG ;NO, A LINE NUMBER AT MOST
00800 PUSHJ P,SCAN ;YES, GET THE PAGE NUMBER
00900 SKIPLE T2 ;NUMBERS LESS THAN OR EQUAL TO 0 LOSE
01000 TRZN FL,NUMF ;WAS IT A NUMBER
01100 JRST GETBPG ;TEST FOR A "*"
01200 GETRST: TRO FL,PGSN ;YEP, WE SAW IT
01300 MOVEM T2,HIPG ;SAVE THAT NUMBER
01400 PUSHJ P,SCAN ;CHECK FOR + OR -
01500 CAIN C,"+"
01600 JRST PGPLS
01700 CAIE C,"-"
01800 JRST NOPG ;NO, GO DO ADSUB ON LINE NUMBER
01900 PUSHJ P,SCAN ;GET THE NUMBER
02000 TRZN FL,NUMF ;MUST BE A NUMBER
02100 NERROR ILC
02200 MOVE T1,HIPG
02300 SUB T1,T2
02400 MOVEM T1,HIPG ;FILL IN NUMBER
02500 NOPGA: PUSHJ P,SCAN ;SCAN PAST NUMBER
02600 NOPG: TRNN FL,LINSN!PGSN ;DID WE SEE A LINE OR A PAGE?
02700 NERROR ILC ;NO, SOMETHING IS WRONG
02800 PUSH P,T1 ;SAVE (HAVE ALREADY SCANNED)
02900 PUSH P,T2
03000 PUSHJ P,ADDSUB ;TAKE CARE OF + AND - FOR LINE
03100 POP P,T2
03200 POP P,T1
03300 MOVEM SINDEX,HILN ;SAVE RESULT
03400 POPJ P, ;AND RETURN
03500
03600 PGPLS: PUSHJ P,SCAN ;GET NUMBER TO ADD
03700 TRZN FL,NUMF ;A NUMBER?
03800 NERROR ILC ;NO, NERROR
03900 ADDM T2,HIPG ;ADD IT IN
04000 JRST NOPGA ;AND CLEAN UP
04100
04200 ;ROUTINE SETS HIPG IN CASE NONE SEEN BY GETLA, THEN CALLS GETLA
04300
04400 GET1S: PUSHJ P,SCAN
04500 GET1: MOVE T3,CPGL
04600 MOVEM T3,HIPG
04700 JRST GETLA
04800 GETBPG: CAIE C,"*" ;IS IT "/*"
04900 NERROR ILC ;LOSE LOSE
05000 TRNE FL,BGSN ;HAVE WE SEEN THAT PAGE
05100 JRST HAVPAG ;YES, ALL IS OK
05200 MOVSI T1,1 ;WILL HAVE TO SEARCH FOR IT
05300 MOVEM T1,DPG
05400 MOVEI SINDEX,0
05500 PUSHJ P,FIND
05600 TRNN FL,BGSN ;SHOULD HAVE SEEN IT NOW
05700 ERROR ICN ;WE ARE IN TROUBLE
05800 HAVPAG: MOVE T2,BGPG ;FAKE IT
05900 JRST GETRST ;RETURN
00100 ;GET A PAIR OF FORM A/B,C/D LOLN IS SET BY CALLER BEFORE CALL
00200
00300 GET2S: PUSHJ P,SCAN
00400 GET2: TRZ FL,CNTF ;NOT A ! COMMAND
00500 PUSHJ P,GET1 ;GET A LINE AND PAGE NUMBER PAIR
00600 MOVE T3,HIPG ;NOW SET LOWER PAGE TO THE ONE SEEN
00700 MOVEM T3,LOPG
00800 MOVE T3,HILN ;RESET LOW LINE IS A NUMBER SEEN
00900 TRNE FL,LINSN
01000 MOVEM T3,LOLN
01100 GET2HF: MOVE T3,[<ASCII /99999/>!1] ;SET UP A LARGE NUMBER
01200 TRNN FL,LINSN ;IF NO LINE NUMBER SEEN
01300 MOVEM T3,HILN
01400 TRZ FL,PGSN ;SO DELETE CAN DETECT A SECOND PAGE SPEC
01500 CAIN C,"!" ;IS IT A ! COMMAND?
01600 JRST GET2CT ;GO TAKE CARE OF IT
01700 CAIE C,":" ;CHECK FOR SECOND SET
01800 POPJ P, ;NOPE, RETURN
01900 MOVEM T3,HILN ;SET HILN ANYWAY
02000 JRST GETLAS ;AND GO GET THE SECOND PAIR
02100
02200 GET2CT: TRO FL,CNTF ;SET THE APPROPRIATE FLAG
02300 PUSHJ P,SCAN ;THERE SHOULD BE A NUMBER HERE
02400 TRNN FL,NUMF
02500 NERROR ILC ;LOSE
02600 MOVEM T2,SVCNT ;HANG ON TO IT
02700 JRST SCAN ;SCAN NEXT AND RETURN
02800
00100 SUBTTL INITIALIZE
00200
00300 STPT: TDZA FL2,FL2 ;CLEAR ALL FALGS IN FL2
00400 MOVEI FL2,RPGSW ;CLEAR ALL FLAGS BUT RPGSW
00500 RESET
00600 MOVE P,PDLPNT ;SET UP STACK POINTER
00700 MOVE T2,[XWD LOWBEG,LOWBEG+1]
00800 SETZM LOWBEG
00900 BLT T2,LOWEND
01000 MOVSI FL,QMODF ;SET FOR ' IS NOT SPECIAL
01100 TRNN FL2,RPGSW
01200 JRST RPGRET ;THIS IS A SWITCH FROM THE OLD WAY
01300 MOVEI T1,STPT ;RESET START
01400 HRRM T1,.JBSA
01500 MOVE T1,[XWD 2,[SIXBIT /EDT/
01600 IOWD 20,TMPBUF]]
01700 TMPCOR T1,
01800 JRST NOTMP ;NOT THERE.
01900 MOVE T1,[POINT 7,TMPBUF]
02000 MOVEM T1,TEMPP ;SET UP POINTER
02100 JRST RPGRET
02200 NOTMP: INIT TTY,1
02300 SIXBIT /DSK/
02400 TIBUF
02500 EXIT
02600 MOVEI T1,3
02700 PJOB T2,
02800 RPGA: IDIVI T2,12
02900 MOVEI T3,20(T3) ;ADD TO T3 A SIXBIT 0
03000 LSHC T3,-6
03100 SOJG T1,RPGA
03200 HRRI T4,(SIXBIT/EDT/)
03300 MOVE T1,T4
03400 MOVSI T2,(SIXBIT/TMP/)
03500 SETZB T3,T4
03600 LOOKUP TTY,T1
03700 JRST STPT ;GO TO NORMAL MODE
03800
03900 RPGRET: MOVEI T1,PDLOV ;SET UP A PDLOV TRAP
04000 MOVEM T1,.JBAPR
04100 MOVEI T1,200000 ;SET FOR PDLOV ONLY
04200 APRENB T1,
04300 MOVE T1,[XWD RPGR%,RPGR]
04400 BLT T1,RPGR+1 ;ALL THIS FOR MOVING TWO WORDS
04500 MOVE T1,BYPPI%
04600 MOVEM T1,BYPPI
04700 MOVE T1,[JRST DOUUO]
04800 MOVEM T1,ERRHD+1
04900 MOVE T1,[<ASCII /00100/>!1]
05000 MOVEM T1,INCR
05100 TRNE FL2,RPGSW
05200 JRST RPGRT1
05300 INIT TTY,1
05400 SIXBIT /TTY/
05500 TIBUF
05600 EXIT ;DON'T WIN
05700 RPGRT1: TDZ FL2,[ALTOF,,FORCEF!RALPHF!ALTIOF!DSKSMF]
05800 TRO FL2,DSKCK ;INITIALIZE TO CHECK THE DISK OUTPUT
05900 TRZ FL2,BAKFLG ;DON'T MAKE A *.BAK FILE UPON EXIT
06000 TRNN FL2,RPGSW
06100 TTCALL 3,[ASCIZ /
06200 FILE NAME: /]
06300 TRNE FL2,RPGSW
06400 PUSHJ P,GNCH ;KILLS THE S
06500 MOVEI T5,NAMDEV
06600 PUSHJ P,READNM ;GET A FILE NAME
06700 JRST ILFN ;ILLEGAL FORMAT
06800 TRNE FL2,SSW ;CHECK FOR AN S SWITCH
06900 JRST ILFN
07000 MOVE T1,NAMDEV
07100 MOVEM T1,ORGDEV
07200 MOVE T1,NAMI
07300 MOVEM T1,ORGNAM
07400 MOVEM T1,XLOOK+2
07500 MOVE T1,NAMI+1
07600 MOVEM T1,ORGEXT
07700 MOVEM T1,XLOOK+3
07800 MOVE T1,NAMI+3
07900 MOVEM T1,ORGPPN
08000 MOVEM T1,XLOOK+1
08100 SKIPE T1,NAMI+2
08200 MOVEM T1,ORGPRO
08300 TRNE FL2,RSW ;ON IF /R
08400 TRO FL,READOF
08500 TRNN FL,TERMF ;IS IT A TERMINATOR?
08600 JRST ILFN
08700 MOVEI T1,14 ;MODE 14
08800 MOVE T2,ORGDEV ;DEVICE
08900 MOVEI T3,IBUF ;BUFFER
09000 INIT IN,14
09100 SIXBIT /IN/
09200 IBUF
09300 JRST .+3
09400 TRO FL2,ALTIOF
09500 JRST .+3
09600 OPEN IN,T1
09700 JRST NODSK
09800 MOVSI T1,'DSK'
09850 SKIPN ORGPPN
09900 CAMN T2,['SYS ']
10000 MOVEM T1,ORGDEV
10100 MOVEI T1,100 ;DEFAULT VALUE
10200 MOVEM T1,OVRDRW ;OF OVERDRAW QUOTA
10300
10400 TRYOUT: CAIN C,ALTMOD ;IS IT A CREATE?
10500 JRST NOLOOK
10600 MOVEI T1,16
10700 MOVEM T1,XLOOK ;16 WORD EXTENDED LOOKUP
10800 LOOKUP IN,XLOOK
10900 JRST NOFIL ;IT IS NOT THERE
11000 MOVE T2,[POINT 6,XLOOK+16] ;POINTER TO DEVICE
11100 MOVE T3,[POINT 6,T4]
11200 MOVEI T5,6
11300 MOVEI T4,0
11400 GETST: ILDB T1,T2 ;GET BYTE
11500 CAIGE T1,'A' ;IS IT A LETTER
11600 JRST THATAL ;NO
11700 IDPB T1,T3 ;SAVE IT
11800 SOJN T5,GETST
11900 THATAL: TLZN FL2,DEVSYS ;WAS IT SYS
12000 MOVEM T4,ORGDEV
12100 NOLOOK: MOVE T1,ORGDEV
12200 MOVEM T1,STRNAM
12300 GETPPN T2,
12400 MOVEM T2,STRNAM+1
12500 MOVEI T1,14 ;MODE 14
12600 MOVE T2,ORGDEV ;DEVICE
12700 MOVSI T3,OBUF ;BUFFER
12800 INIT OUT,14
12900 SIXBIT /OUT/
13000 XWD OBUF,0
13100 JRST .+3
13200 TDO FL2,[ALTOF,,ALTIOF]
13300 JRST .+3
13400 OPEN OUT,T1
13500 JRST NODSK ;WE ARE IN TROUBLE
13600 MOVSI T1,(SIXBIT/OUT/)
13700 DEVCHR T1,
13800 JUMPE T1,GOTOUT ;OUT DOES NOT EXIST
13900 TLNN T1,200000 ;SKIP IF OUT IS A DISK
14000 TRZ FL2,DSKCK ;OUT IS NOT A DSK; NOCHECK
14100 GOTOUT: MOVE T1,.JBFF
14200 MOVEM T1,TTYBUF
14300 SKIPN TEMPP
14400 INBUF TTY,2
14500 ADDI T1,203*2
14600 MOVEM T1,.JBFF
14700 MOVEM T1,BUFHD ;FOR LATER RECOPY OPERATIONS
14800 INBUF IN,2 ;GET DISK BUFFERS SET UP
14900 OUTBUF OUT,2
15000 MOVE T1,.JBFF
15100 SETZM (T1) ;SAVE A ZERO WORD
15200 ADDI T1,1 ;NEXT ONE STARTS
15300 MOVEM T1,BUFP ;START OF THE BUFFER
15400 SETZM NAMO
15500 MOVE T1,[XWD NAMO,NAMO+1]
15600 BLT T1,NAMO+3
15700 DATE T1, ;CURRENT DATE
15800 MOVEM T1,DATEX
15900 TIMER T2, ;CLOCK IN TICKS
16000 LSH T1,^D21 ;USE TO MAKE A STRANGE NAME
16100 IOR T1,T2
16200 TDZ T1,[XWD 202020,202020]
16300 TDO T1,[XWD 404040,404040]
16400 ADD T1,[XWD 010101,010101]
16500 MOVEM T1,EDNAM ;SAVE FOR LATER
16600 MOVEM T1,NAMO
16700 MOVSI T1,(SIXBIT/TMP/)
16800 MOVEM T1,NAMO+1
16900 TRY: HRRZ T1,.JBREL ;FIND THE END OF CORE
17000 ; IF DDT IS LOADED THEN THE SYMBOL TABLE WILL BE
17100 ; SQUASHED DOWN NEAR THE TOP OF THE CODE.(LOW SEG)
17200 MOVEM T1,CORTOP
17300 SUBI T1,2*MXWPL+2 ;LEAVE SPACE FOR A COUPLE OF LINES
17400 MOVEM T1,FILPT ;THIS IS HOW FAR TO FILL THE BUFFER
17500 MOVE T1,CORTOP ;NOW FIND THE SIZE
17600 SUB T1,BUFP
17700 MOVE T2,T1 ;GET A COPY
17800 SUBI T2,MXWPL+1 ;WHEN TO START DUMPING
17900 MOVEM T2,MAXWC
18000 ASH T1,-1 ;TAKE HALF OF IT
18100 MOVEM T1,HLFWC ;SAVE THAT FIGURE
18200 ADD T1,BUFP ;CHECK TO SEE IF ENOUGH ROOM
18300 CAMGE T1,FILPT
18400 JRST NODPY ;ALL SET
18500 HRRZ T1,.JBREL
18600 ADDI T1,2000 ;NEED ANOTHER 1 K
18700 CORE T1, ;GRAB IT
18800 ERROR NEC ;LOSER
18900 JRST TRY
19000 NODPY: MOVE T1,[<ASCII /00000/>!1]
19100 MOVEM T1,CLN ;SET UP THE CURRENT LINE
19200 MOVE T1,INCR
19300 MOVEM T1,CURINS ;CURRENT PLACE TO INSERT IF NO ARGS TO I
19400 MOVEI T1,1 ;AND THE CURRENT PAGE
19500 MOVEM T1,CPG
19600 MOVEM T1,CPGL
19700 MOVEM T1,IPG ;CURRENT PAGE TO INSERT ON
19800 SETZM CASEBT ;0 FOR LETTERS AS UPPER CASE 40 FOR LOWER
19900 SETZM SRPNT ;NO SEARCH STRINGS YET
20000 SETZM R1PNT ;ALSO REPLACE STRINGS
20100 SETZM R2PNT
20200 QRET: MOVE PNTR,BUFP ;SET THE BUFFER POINTER
20300 MOVEI T1,1 ;SET INPUT PAGE
20400 MOVEM T1,INPG
20500 SETZM SVWD ;O WORDS WAITING
20600 SETZM OLDLIN ;USED FOR ORDER CHECKING ON INPUT
20700 SETZM WC ;ZERO WORD COUNT FOR START
20800 MOVEI T1,TOBUFF
20900 MOVEM T1,TOBUF ;3 WORD HEADER BLOCK FOR PHONY TTY OUT
21000 HRLI T1,(POINT 7,0) ;AND A BYTE POINTER
21100 MOVEM T1,TOBUF+1
21200 MOVEI T1,167 ;BUFFER SIZE - 1
21300 MOVEM T1,TOBUF+2
21400 TRNE FL2,QENDF
21500 JRST QRET2
21600 CAIN C,ALTMOD ;IS IT ALTMODE
21700 JRST CREAT
21800 MOVSI T1,1 ;SET BIG PAGE LARGE FOR NOW
21900 MOVEM T1,BGPG
22000 QRET2: TRNE FL2,QENDF ;IS THIS A Q COMMAND?
22100 JRST [SETZM XLOOK+1
22200 LOOKUP IN,XLOOK
22300 JRST NOFIL
22400 JRST .+1]
22500 TRNE FL,READOF
22600 JRST NOENT ;DO NOT ENTER
22700 HLRZ T1,XLOOK+4 ;CATCH THE ORIGINAL PROTECTION
22800 ANDI T1,777000 ;ZAP ALL BUT THE PROTECTION BITS
22900 HRLZM T1,ORGPRO ;SAVE IT FOR LATER
23000 MOVE T1,XLOOK+6
23100 MOVEM T1,ORGVRS# ;SAVE THE VERSION
23200 NOOPEN: ENTER OUT,NAMO
23300 JRST EDFLIN ;SOME OTHER BASTARD IS USING IT
23400 SETZM COMNDS
23500 NOENT: TRO FL,BOF ;IS AT START OF FILE
23600 TRNE FL2,QENDF
23700 TDZ FL,[XWD TECOF,EOF+EOF2]
23800 TRZ FL2,QENDF
23900 TLO FL,FSTOPF ;FIRST OP
24000 PUSHJ P,FILLBF ;AND FILL UP THE BUFFER
24100 MOVEI T1,1
24200 MOVEM T1,CPG ;MAKE SURE OF CURRENT PG (FOR Q COMMAND).
24300 JRST COMND ;GET A COMMAND AND DO IT
24400
24500 ;CREATE A NEW FILE
24600
24700 CREAT: LOOKUP IN,NAMI ;SEE IF THERE IS ONE OF THAT NAME
24800 JRST CRTOK ;NO, ALL IS WELL
24900 TTCALL 3,[ASCIZ /
25000 FILE ALREADY EXISTS! DELETE? /]
25100 PUSHJ P,CONFRM ;GET ANSWER
25200 JRST STPT ;HE SAID NO. HE MUST KNOW.
25300 CRTOK: ENTER OUT,NAMO ;GO DO THE OUTPUT
25400 JRST EDFLIN ;FOOBAZ
25500 MOVSI T1,057000
25600 MOVEM T1,ORGPRO
25700 SETZM (PNTR) ;ZERO FIRST WORD OF BUFFER
25800 TRZ FL,READOF ;CREAT AND READOF ARE NOT POSSIBLE
25900 TRO FL,BOF!EOF!EOF2 ;SAY AT START AND NO MORE TO READ
26000 MOVEI T1,1 ;SET BGPG
26100 MOVEM T1,BGPG
26200 TRNE FL2,RPGSW
26300 TRO FL2,CRTINF
26400 OUTSTR ASCRLF
26500 JRST CRTINS ;GO RIGHT INTO INSERTING. HE CAN ESCAPE.
00100 SUBTTL ERROR ROUTINES
00200
00300 EDFLIX: TTCALL 3,[ASCIZ /
00400 TEMPORARY EDIT FILE MISSING. I GIVE UP
00500 /]
00600 EXIT
00700
00800 EDFLIN: TTCALL 3,[ASCIZ /
00900 TEMPORARY EDIT FILE IN USE. I GIVE UP
01000 /]
01100 EXIT
01200
01300 NODSK: TTCALL 3,[ASCIZ /
01400 NO DISK AVAILABLE. PLEASE CHECK THE DISK YOU HAVE REQUESTED
01500 /]
01600 EXIT
01700
01800 NOFIL: TTCALL 3,[ASCIZ /
01900 FILE NOT FOUND
02000 CREATION ASSUMED
02100 /]
02200 MOVEI C,ALTMOD ;FUDGE IN AN ALTMOD
02300 JRST NOLOOK ;NO GO THE CREATE THING
02400
02500 ILFN: TTCALL 3,[ASCIZ /
02600 ILLEGAL FILE SPECIFICATION/]
02700 CLRBFI
02800 TRNE FL2,RPGSW
02900 EXIT ;IF IN RPG
03000 JRST STPT ;IF HE'S DOING IT BY HAND
03100
03200 DOUUO: MOVEM T1,SVT1E ;SAVE T1 IN CASE OF RERROR
03300 HRRZ T1,40 ;PICK UP THE ERROR NUMBER
03400 SKIPE T1
03500 CAILE T1,NUMER
03600 ERROR ILUUO ;WRONG ERROR, CALL SELF
03700 MOVEM T1,SVERN ;SAVE FOR =ERROR COMMAND
03800 TRNE FL,EXTOG
03900 SKIPA T1,ETBL-1(T1) ;(NN ZERO ERRORS) GET MESSAGE
04000 MOVE T1,ETBL2-1(T1) ;GET LONG FORM
04100 TTCALL 3,(T1)
04200 IFDEF DEBFLG <HRRZ T1,ERRHD ;GET NEXT ADDRESS
04300 TLNE FL2,DEBFLG ;ARE WE DEBUGGING?
04400 PUSHJ P,TELLAD>
04500 DEBUG <IN DOUUO>
04600 LDB T1,[POINT 9,40,8] ;GET UUO
04700 CAILE T1,3
04800 ERROR ILUUO ;IT WAS ILLEGAL
04900 XCT ERND(T1) ;DO GOOD THING
05000 JRST @ERRHD ;RERROR WILL FALL THROUGH XCT AND RETURN
05100
05200 ERND: ERROR ILUUO ;0 IS AN ERROR
05300 EXIT 1,
05400 JRST TTYFLU ;FLUSH TTY AND RETURN
05500 MOVE T1,SVT1E ;RERROR- RESTORE T1
05600
05700 TTYFLU: TRNE FL2,RPGSW
05800 JRST TTYFL1
05900 MOVE T1,TIBUF+1 ;THE BYTE POINTER FOR TTY IN
06000 JRST .+2 ;SKIP
06100 TTYFL1: MOVE T1,TIBUF+1 ;THE BYTE POINTER FOR DISK
06200 ILDB T1,T1 ;PICK UP A BYTE
06300 JUMPE T1,COMND ;EMPTY IT IS
06400 TTYFL2: PUSHJ P,GNCHF ;I HOPE HIS WASN'T A PDLOV
06500 CAIN C,12 ;FLUSH TO LINE FEED
06600 JRST COMND
06700 JRST TTYFL2
06800
06900 GNCHF: MOVE T1,TIBUF+2
07000 SOSG T1
07100 JRST GNCHFX ;NONE THERE GIVE A 12
07200 JRST GNCHFG ;GO GET ONE
07300
07400 GNCHFX: MOVEI C,12
07500 POPJ P,
07600
07700 GNCHFG: PUSHJ P,GNCH
07800 POPJ P,
07900
08000 ETBL: ERMS <ICN,DIE,DDE,ILC,ILUUO,LTL,NLN,NSP,ORDER,UNA,ILR>
08100 ERMS <WAR,TMS,STL,ISS,ILFMT,NSG,FNF,DNA,NEC,IRS,STC,ITD>
08200 ERMS <NNN,FORM>
08300 NUMER==.-ETBL
08400 ETBL2: ERMS <INTERNAL CONFUSION,DEVICE INPUT ERROR>
08500 ERMS <DEVICE OUTPUT ERROR,ILLEGAL COMMAND,ILLEGAL UUO>
08600 ERMS <LINE TOO LONG>
08700 [ASCIZ /
08800 *NO SUCH LINE(S)*
08900 /]
09000 ERMS <NO SUCH PAGE>
09100 ERMS <OUT OF ORDER,DEVICE NOT AVAILABLE,ILLEGAL REPLACEMENT>
09200 ERMS <WRAP AROUND,TOO MANY STRINGS,STRING TOO LONG>
09300 ERMS <ILLEGAL SEARCH STRING,ILLEGAL LINE FORMAT>
09400 ERMS <NO STRING GIVEN,FILE NOT FOUND,DISK NOT AVAILABLE>
09500 ERMS <INSUFFICIENT CORE AVAILABLE,ILLEGAL REPLACEMENT STRING>
09600 ERMS <SEARCH STRING TOO COMPLEX,ILLEGAL TRANSFER DESTINATION>
09700 ERMS <NO NEXT LINE,IMPROPER FORMAT>
09800 SALL
00100 SUBTTL COMMAND DECODER
00200
00300 RESE1==NEGF!DEMCHR!ASSMF!ALTSRF!NUMSRF!ARBITG!EXCTSR!NOPRN!DECID!EXCTS1
00400 RESE2==ADDL!SUBL!IDF!NUMF!TERMF!LINSN!PGSN!CNTF
00500 RESE3==STARF!RUBF!ALTDUP!RUBF2!QENDF!BENDF!ALTFLG
00600
00700 RESETF: XWD RESE1,RESE2 ;FLAGS TO BE ZEROED AT COMND LEVEL
00800 RESET2: XWD UPUPUP,RESE3 ;MORE OF THE SAME
00900
01000 REENTR: ;THE REENTRY POINT
01100 COMND: TDZ FL,RESETF ;RESET CERTAIN FLAGS
01200 TDZ FL2,RESET2 ;RESET CERTAIN FLAGS
01300 HRLI PNTR,0 ;JUST IN CASE WE MESSED IT UP
01400 SETZM LOLN ;GET THIS SET TO START THINGS OFF
01500 SETZM SAVCHR ;SCAN SHOULD GET RESET AT THIS POINT
01600 SKIPN TEMPP
01700 SETSTS TTY,1 ;JUST IN CASE DUPLEXING IS OFF
01800 TLNE FL,SRCOP ;THIS CASE IS SPECIAL SINCE WE
01900 SKIPA P,COPDL ;SHOULD NOT DESTROY SAVED ITEMS
02000 MOVE P,PDLPNT ;ALSO PDL (IN CASE OF ERRORS)
02100 TLNE FL,SRCOP
02200 JRST NOCPCK ;DO NOT GET OUT OF COPY MODE
02300 TLZE FL,ISCOP ;IN COPY MODE?
02400 JRST COPDON ;YES, DO SPECIAL CLEAR OUT
02500 TRNE FL2,RPGSW
02600 JRST CMND1
02700 NOCPCK: SKPINC ;KILL
02800 JFCL ; ^O
02900 OUTCHR ["*"]
03000 AOS COMNDS
03100 CMND1: TRNE FL2,RPGSW
03200 JRST [TRNN FL2,CRTINF
03300 JRST .+1
03400 MOVE T1,TIBUF+1
03500 ILDB T1,T1
03600 JUMPN T1,.+1 ;NOT EMPTY OR NULL SO JUMP
03700 TRZ FL2,CRTINF!RPGSW
03800 RELEAS TTY,0 ;FINISHED WITH THE DISK
03900 SETZM TEMPP
04000
04100 INIT TTY,1
04200 SIXBIT /TTY/
04300 TIBUF
04400 EXIT
04500 MOVE C,TTYBUF
04600 EXCH C,.JBFF
04700 INBUF TTY,2
04800 MOVEM C,.JBFF
04900 JRST CRTINS]
05000 PUSHJ P,GNCH ;READ A CHARACTER
05100 CAIN C,15
05200 JRST [PUSHJ P,GNCH ;CLEAR LF
05300 JRST COMND]
05400 JUMPE CS,CMND1 ;IGNORE SPACES ETC
05500 TLNE CS,LETFX ;CHECK TO SEE IF LETTER
05600 TRZ C,40 ;AND CONVERT TO UPPER CASE
05700 MOVSI T1,-CMDLG ;GET LENGTH OF COMMAND TABLE
05800 LDB T2,[POINT 8,CMD1(T1),12] ;PICK UP COMMAND
05900 CAIE C,(T2) ;COMPARE
06000 AOBJN T1,.-2 ;GO TRY THE NEXT COMMAND POSSIBILITY
06100 JUMPL T1,@CMD1(T1) ;DISPATCH IF FOUND
06200 NERROR ILC ;ELSE ERROR
06300
06400 CMD1: ;THE TABLE OF COMMANDS
06500 CMNDEF 12,NXTLIN
06600 CMNDEF ALTMOD,BAKLIN
06700 CMNDEF "I",INSERT
06800 CMNDEF ".",MOVEIT
06900 CMNDEF "P",PRINT
07000 CMNDEF "F",SEARCH
07100 CMNDEF "S",SUBST
07200 CMNDEF "A",ALTER
07300 CMNDEF "N",NUMBER
07400 CMNDEF "C",COPY
07500 CMNDEF "T",TRANS
07600 CMNDEF "@",INDIR
07700 CMNDEF "X",XPAND
07800 CMNDEF "Q",QEND
07900 CMNDEF "D",DELETE
08000 CMNDEF "J",JOIN
08100 CMNDEF "R",REPLAC
08200 CMNDEF "=",GIVE
08300 CMNDEF "_",SET
08400 CMNDEF "H",HELP
08500 CMNDEF "M",MARK
08600 CMNDEF "K",DEPGMK
08700 CMNDEF 15,COMND
08800 CMNDEF "G",GEND
08900 CMNDEF "E",ENDIT
09000 CMNDEF "L",LIST
09100 CMNDEF "B",BEND
09200 CMDLG==.-CMD1
09300
09400 HELP: TTCALL 3,[ASCIZ/
09500 TYPE SYS:EDITS.USR FOR HELP
09600 /]
09700 JRST TTYFLU
09800
09900 INDIR: NERROR ILC
09950 MOVEI T5,NAMDEV
10000 PUSHJ P,READNM ;GET A FILE NAME
10100 JRST [CAIE T1,'M ' ;MONITOR?
10200 NERROR ILC
10300 TLO FL2,MONTR
10400 JRST .+1]
10500 MOVEI T1,0
10600 MOVE T2,NAMDEV
10700 MOVEI T3,TIBUF
10800 OPEN TTY,T1 ;OPEN TTY CHANNEL
10900 NERROR DNA
11000 LOOKUP TTY,NAMI
11100 NERROR FNF
11200 TRO FL2,CRTINF
11300 JRST COMND
00100 SUBTTL PRINT COMMAND
00200
00300 MOVEIT: TLO FL2,MOVIT ;SET THE MOVE POINTER FLAG
00400 PRINT: PUSHJ P,GET2S ;GET A DOUBLE STRING
00500 TRNN FL,TERMF ;DID IT END WITH A TERMINATOR
00600 NERROR ILC ;NO, ILLEGAL
00700 TRZ FL,LINSN ;USE THIS AS A FLAG TO CHECK FOR NULL RANGE
00800 MOVE T1,LOPG ;FIND THE FIRST LINE WANTED
00900 MOVEM T1,DPG ;SET IT AS THE ONE WE WANT
01000 MOVE SINDEX,LOLN ;PICK UP THE LINE
01100 PUSHJ P,FIND ;GO GET IT
01200 SKIPE LOLN ;DID WE WANT TO PRINT AN ENTIRE PAGE
01300 JRST PRNT1 ;NO, GO CHECK BOUNDS
01400 MOVE T2,CPG ;WHICH ONE ARE WE ON
01500 MOVEM T2,CPGL
01600 PUSHJ P,PGPRN ;PRINT THE PAGE HEADER
01700 TRO FL,LINSN ;THIS CAN COUNT AS A LINE
01800 PRNT1: PUSHJ P,ONMOV ;CHECK TO SEE IF STILL IN RANGE
01900 JRST EPRNT ;NO, END
02000 TRO FL,LINSN ;WE HAVE SEEN ONE
02100 CAMN T1,PGMK ;IS IT A PAGE MARK?
02200 JRST PRNT3 ;YES, DO SOMETHING SPECIAL
02300 MOVEM T1,CLN
02400 MOVEM T2,CPGL ;SAVE PAGE TOO
02500 MOVE T1,PNTR ;GET THE POINTER TO IT
02600 TLNN FL2,MOVIT ;TYPE?
02700 PUSHJ P,OUTLIN ;AND PRINT
02800 PRNT4: PUSHJ P,FINDN ;GET THE NEXT LINE
02900 JRST PRNT1 ;AND CONTINUE
03000 PRNT3: MOVEM T2,CPGL
03100 PUSHJ P,PGPRN ;GO PRINT A PAGE HEADER
03200 AOS CPG
03300 MOVE T2,[<ASCII /00000/>!1]
03400 MOVEM T2,CLN ;SET LINE TO FIRST ON THAT PAGE
03500 JRST PRNT4 ;AND CONTINUE
03600 EPRNT: TLZ FL2,MOVIT ;CLEAR THE FLAG
03700 TRZN FL,LINSN ;DID WE PRINT SOMETHING
03800 NERROR NLN ;NO, ERROR
03900 JRST COMND ;YES, RETURN FOR COMMAND
04000
04100 ;CHECK TO SEE IF OUT OF LIMITS SKIP RETURN IF OK
04200
04300 ONMOV: JUMPE T1,CPOPJ ;0, MUST BE EOF SO ALL DONE
04400 MOVE T2,CPG ;GET THE CURRENT PAGE
04500 CAMN T1,PGMK ;ARE WE AT A PAGE MARK?
04600 ADDI T2,1 ;YES, TREAT AS NEXT PAGE
04700 TRNE FL,CNTF ;IS THIS A ! TYPE COMMAND?
04800 JRST ONCNT
04900 CAMLE T2,HIPG ;HOW DOES IT COMPAGE WITH UPPER LIMIT
05000 POPJ P, ;HIGHER, ALL DONE
05100 CAME T1,PGMK ;IF PAGE MARK, DO NOT COMPARE LINE
05200 CAME T2,HIPG ;OR IF NOT ON LAST PAGE
05300 SKIPA
05400 CAMG T1,HILN ;ARE WE OUT OF LINES?
05500 AOS (P) ;SKIP RETURN ALL OK
05600 POPJ P, ;GO
05700
05800 ONCNT: CAMN T1,PGMK ;DO NOT COUNT PAGE MARKS
05900 SKIPG SVCNT ;IF PAGE MARK, GIVE UP IF DONE
06000 SOSL SVCNT ;ARE WE OUT
06100 AOS (P) ;SKIP RETURN FOR OK
06200 POPJ P,
06300
06400 PGPRN: TTCALL 3,[ASCIZ /
06500 PAGE /]
06600 PUSHJ P,DPRNT ;PRINT THE NUMBER IN T2
06700 TTCALL 3,ASCRLF
06800 POPJ P,
06900
07000 OPRNT: SKIPA T5,[8] ;OCTAL PRINTER
07100 DPRNT: MOVEI T5,^D10 ;DECIMAL PRINTER
07200 IDIV T2,T5
07300 HRLM T3,(P)
07400 SKIPE T2
07500 PUSHJ P,DPRNT+1
07600 HLRZ C,(P)
07700 ADDI C,"0"
07800 TTCALL 1,C
07900 POPJ P,
08000 ;CHARACTER OUTPUT
08100
08200 OCHR: MOVE CS,CTBL(C) ;GET THE MAGIC BITS
08300 TLNE CS,LETFX ;CHECK FOR LETTER
08400 TDC C,CASEBT ;AND CHANGE CASE AS NECESSARY
08500 TRNE FL,DPYF ;IS IT A DISPLAY
08600 JRST OCH2 ;YES, JUST PRINT
08700 PUSH P,C ;SAVE THE CHARACTER
08800 LDB C,[POINT 7,CTBL(C),10] ;GET PRINT EQUIV.
08900 JUMPE C,OCH1 ;NONE, PRINT ORIGINAL
09000 TDNE CS,[XWD LETFX,M37] ;IS THIS A LETTER OR SPECIAL
09100 TRNN FL,M37F ;AND A MODEL 37
09200 SKIPA
09300 JRST OCH1 ;THEN PRINT NORMALLY
09400 MOVEM C,(P) ;SAVE IN STACK
09500 MOVEI C,"'"
09600 SOSG TOBUF+2
09700 PUSHJ P,TTYOUT
09800 IDPB C,TOBUF+1 ;OUTPUT THE CHR
09900 OCH1: POP P,C ;GET THE CHR TO PRINT
10000 OCH2: SOSG TOBUF+2
10100 PUSHJ P,TTYOUT
10200 IDPB C,TOBUF+1
10300 POPJ P, ;AND RETURN
10400
10500 OUTLIN: HRLI T1,(<POINT 7,0>) ;GET SET TO PRINT A LINE
10600 OUTL1: ILDB C,T1 ;GET A CHR
10700 PUSHJ P,OCHR ;AND PRINT IT
10800 CAIE C,12 ;IS IT LINE FEED
10900 JRST OUTL1 ;NO, CONTINUE
11000 PUSHJ P,TTYOUT ;FLUSH IT
11100 POPJ P,
00100 SUBTTL END ROUTINE
00200
00300 BEND: TLNE FL,SRCOP
00400 NERROR ILC ;ILLEGAL IN COPY MODE
00500 TRNN FL2,ALTIOF
00600 JRST BEND.2
00700 BEND.1: TTCALL 3,[ASCIZ"THIS COMMAND WILL NOT WORK WITH ALTERNATE I/O DEVICES
00800 "]
00900 JRST COMND
01000
01100 BEND.2: TRO FL2,BENDF
01200 JRST ENDITX
01300
01400 QEND: TLNE FL,SRCOP
01500 NERROR ILC ;ILLEGAL IN COPY MODE
01600 TRNE FL2,ALTIOF
01700 JRST BEND.1
01800 TRO FL2,QENDF
01900 SETZM COMNDS
02000 JRST ENDITX
02100
02200 GEND: TLOA FL,GCOM ;GO
02300 ENDIT: TLZ FL,GCOM ;SET REGULAR END
02400 TRZ FL2,BENDF!QENDF
02500 ENDITX: TLNE FL,SRCOP
02600 JRST DSCOP ;FINISH UP THE COPY COMMAND
02700 TRNE FL,READOF ;IF READ ONLY
02800 JRST ENDEND
02900 TRZ FL,NEWFL ;SET TO WANTS SAME OLD PROGRAM
03000 MOVE T1,ORGNAM ;GET THE ORIGINAL NAME
03100 MOVEM T1,NAMI ;GET SET UP
03200 MOVE T1,ORGEXT ;AND EXTENSION
03300 HLLZM T1,NAMI+1
03350 SETZM NAMI+3
03400 PUSHJ P,NSCAN ;GET A NAME
03500 NERROR ILC ;SKIPS IF NO ERRORS
03600 MOVE T1,NAMI ;SET AS NAME
03700 MOVEM T1,ORGNAM
03800 MOVE T1,NAMI+1
03900 MOVEM T1,ORGEXT
04000 SKIPE T1,NAMI+2
04100 MOVEM T1,ORGPRO
04200 MOVE T1,NAMI+3
04300 MOVEM T1,ORGPPN
04400 PUSHJ P,OCOMPL ;FINISH COPY
04500 CLOSE IN,0 ;AND CLOSE FILES
04600 CLOSE OUT,0
04700 STATZ OUT,740000
04800 ERROR DDE
04900 END7: SKIPE ORGPPN ;SAME PPN?
04940 JRST END3
04980 SETZM NAMI+3 ;ZERO PPN
05000 TRNN FL2,BAKFLG ;ARE WE TO CREATE A .BAK?
05100 JRST END9 ;NO, GO DELETE THE ORIGINAL
05200 HRLZI T1,'BAK' ;THIS WILL BE NEW EXTENSION
05300 CAMN T1,ORGEXT ;BUT IS THE ORIGINAL *.BAK
05400 AOBJP T1,.+1 ;PRAY THAT HE HAS NO *.BAL
05500 MOVEM T1,NAMI+1 ;HERE WE GO
05600 LOOKUP OUT,NAMI
05700 JRST END9 ;NOT THERE - SO WHAT?
05800 SETZM NAMI
05900 SETZM NAMI+3
06000 RENAME OUT,NAMI ;DELETE IT
06100 JRST FIU ;IT MUST BE WRITE PROTECTED
06200 END9: SETZM NAMI+3
06300 MOVE T1,ORGNAM
06400 MOVEM T1,NAMI
06500 HLLZ T1,ORGEXT
06600 MOVEM T1,NAMI+1
06700 LOOKUP OUT,NAMI ;GET IT
06800 JRST END3 ;NO WORRY
06900 TRNN FL,NEWFL ;IS THIS A NEW FILE?
07000 JRST END4 ;NO, WE SHOULD HAVE FOUND IT
07100 TTCALL 3,[ASCIZ /
07200 FILE ALREADY EXISTS! DELETE? /]
07300 PUSHJ P,CONFRM ;HE MUST MAKE UP HIS MIND
07400 JRST END8 ;HE SAID NO. GET A NEW NAME.
07500
07600 END4: TRNN FL2,BAKFLG ;ARE WE TO CREATE A .BAK?
07700 JRST ENDDEL ;NO, GO DELETE THE ORIGINAL
07800 HRLZI T1,'BAK' ;THIS WILL BE NEW EXTENSION
07900 CAMN T1,ORGEXT ;BUT IS THE ORIGINA A *.BAK
08000 AOBJP T1,.+1 ;PRAY THAT HE HAS NO *.BAL
08100 MOVEM T1,NAMI+1 ;HERE WE GO
08200 SKIPA
08300 ENDDEL: SETZM NAMI ;DELETE THE LOSER
08400 SETZM NAMI+3
08500 RENAME OUT,NAMI
08600 JRST FIU
08700 END3: MOVE T1,EDNAM ;GET THE OUTPUT
08800 MOVEM T1,NAMO
08900 MOVSI T1,(<SIXBIT /TMP/>)
09000 MOVEM T1,NAMO+1
09100 SETZM NAMO+3
09200 LOOKUP OUT,NAMO
09300 JRST EDFLIX ;GIVE UP
09400 MOVEI T1,6
09500 MOVEM T1,XLOOK ;6 WORD EXTENDED RENAME
09600 TDNN FL2,[NOINCV,,QENDF]
09700 AOS ORGVRS
09800 MOVE T1,ORGVRS
09900 MOVEM T1,XLOOK+6
10000 MOVE T1,ORGNAM ;SET TO DESIRED NAME
10100 MOVEM T1,XLOOK+2
10200 MOVE T1,ORGEXT
10300 MOVEM T1,XLOOK+3
10400 MOVE T1,ORGPPN
10450 MOVEM T1,XLOOK+1
10500 CLOSE OUT,0
10600 MOVE T1,ORGPRO ;FETCH THE ORIGINAL PROTECTION
10700 MOVEM T1,XLOOK+4 ;FORCE IT ON THE NEW FILE ALSO
10800 DATE T1,
10900 HRRM T1,XLOOK+4
11000 MSTIME T1,
11100 IDIVI T1,^D<60*1000>
11200 DPB T1,[POINT 11,XLOOK+4,23]
11300 RENAME OUT,XLOOK
11400 JRST INFCNF
11500 ENDEND: CLOSE OUT,0
11600 CLOSE IN,0
11700 TRNN FL2,QENDF
11800 JRST NOTQND
11900 MOVE T1,ORGNAM
12000 MOVEM T1,NAMI
12100 MOVE T1,ORGEXT
12200 MOVEM T1,NAMI+1
12300 SETZM NAMI+2
12400 SETZM NAMI+3
12500 MOVE T1,EDNAM
12600 MOVEM T1,NAMO
12700 MOVSI T1,(SIXBIT/TMP/)
12800 MOVEM T1,NAMO+1
12900 SETZM NAMO+2
13000 SETZM NAMO+3
13100 SETSTS IN,14 ;JUST IN CASE THIS USED TO BE TECO FILE
13200 MOVSI T1,(POINT 36,0)
13300 HLLM T1,IBUF+1 ;RESET THE INPUT BYTE POINTER
13400 JRST QRET
13500 NOTQND: RELEAS OUT,0
13600 RELEAS IN,0
13700 TLNE FL,GCOM
13800 JRST CREFIT
13900 TRNN FL2,BENDF
14000 EXIT
14100 MOVEI T1,1 ;MODE 1
14200 MOVE T2,ORGDEV ;DEVICE
14300 MOVEI T3,IBUF ;BUFFER
14400 OPEN IN,T1
14500 JRST NODSK
14600 MOVE T2,ORGDEV ;DEVICE
14700 MOVSI T3,OBUF ;BUFFER
14800 OPEN OUT,T1
14900 JRST NODSK
15000 MOVE T1,BUFHD
15100 MOVEM T1,.JBFF
15200 INBUF IN,2
15300 OUTBUF OUT,2
15400 SETZM XLOOK+1
15500 LOOKUP IN,XLOOK
15600 JRST BENDCO ;CONFUSION
15700 SETZM XLOOK+1
15800 ENTER OUT,XLOOK
15900 JRST BENDCO
16000 BENDLP: SOSLE IBUF+2
16100 JRST RWB2
16200 INPUT IN,
16300 STATZ IN,740000
16400 ERROR DIE ;INPUT ERROR
16500 STATZ IN,20000
16600 JRST RWBF
16700 RWB2: ILDB C,IBUF+1
16800 MOVEI T1,1
16900 TDNN T1,@IBUF+1 ;TEST FOR SEQ. NO.
17000 JRST RWBEND ;GO WRITE THE CHARACTER
17100 MOVNI T1,5 ;TWIDDLE FOR SEQ NO
17200 ADDM T1,IBUF+2
17300 AOS IBUF+1
17400 JRST BENDLP
17500
17600 RWBEND: JUMPE C,BENDLP ;DONT OUTPUT NULLS
17700 CAIN C,15 ;IGNORE CARRIAGE RETURNS...
17800 JRST BENDLP
17900 CAIN C,12 ;BUT TURN LINE FEEDS INTO
18000 MOVEI C,15 ;CARRIAGE RETURN - LINE FEED
18100 RWB1: SOSLE OBUF+2
18200 JRST .+4
18300 OUTPUT OUT,
18400 STATZ OUT,740000
18500 ERROR DDE
18600 IDPB C,OBUF+1
18700 CAIE C,15 ;WAS THAT A CARRIAGE RETURN?
18800 JRST BENDLP
18900 MOVEI C,12 ;YES, FOLLOW IT BY LINE FEED
19000 JRST RWB1
19100
19200 RWBF: CLOSE IN,
19300 RELEAS IN,
19400 CLOSE OUT,
19500 STATZ OUT,740000
19600 ERROR DDE
19700 RELEAS OUT,
19800 EXIT
19900 BENDCO: TTCALL 3,[ASCIZ/THERE IS GREAT CONFUSION. YOU KEEP
20000 THE FILE WITH THE SEQUENCE NUMBERS IN IT.
20100 /]
20200 EXIT
20300
20400 NSCAN: TRNE FL2,FORCEF
20500 JRST CPOPJ1
20600 PUSHJ P,SCAN ;SEE IF HE WANTS TO GIVE IT A NEW NAME
20700 TRNE FL,TERMF ;TERMINATOR?
20800 JRST CPOPJ1 ;DO SKIP RETURN
20900 MOVE T1,ACCUM
21000 CAME T1,[SIXBIT/R/]
21100 POPJ P,
21200 PUSHJ P,SCAN
21300 CAIE C,":"
21400 NERROR ILC
21500 NSCAN2: PUSHJ P,SCAN
21600 TRNE FL,TERMF
21700 JRST CPOPJ1
21800 MOVEI T5,NAMDEV
21900 PUSHJ P,READN1 ;GET A FILE NAME
22000 POPJ P,
22100 TRNE FL2,SSW!RSW ;SWITCHES ILLEGAL
22200 POPJ P,
22300 TRNN FL,TERMF
22400 POPJ P,
22500 TRO FL,NEWFL
22600 JRST CPOPJ1
22700
22800 END8: TTCALL 3,[ASCIZ /
22900 TYPE NEW FILE NAME
23000 */]
23100 END6: SETZM SAVCHR ;GET A NEW NAME. RESET SCAN
23200 SETZM TIBUF+2
23300 PUSHJ P,NSCAN2
23400 SKIPA
23500 JRST END7
23600 TTCALL 3,[ASCIZ /
23700 ?????
23800 */]
23900 JRST END6 ;YOU'RE GOING TO DO IT OVER AND OVER UNTIL
24000 ;YOU GET IT RIGHT
24100 FIU: TTCALL 3,[ASCIZ /
24200 FILE IN USE OR WRITE PROTECTED. TRY ANOTHER NAME
24300 /]
24400 JRST END6
24500
24600 INFCNF: TTCALL 3,[ASCIZ /
24700 THERE IS INFINITE CONFUSION. YOU LOSE.
24800 /]
24900 EXIT
25000
25100 CREFIT: TTCALL 3,ASCRLF
25200 MOVE T1,[XWD 1,RPGR]
25300 RUN T1,
25400 HALT
00100 SUBTTL SOME GENERAL PURPOSE STUFF
00200
00300 RDTXT: SETZM LIBUF ;READ IN A LINE. FIRST ZERO INPUT BUFFER
00400 MOVE T1,[XWD LIBUF,LIBUF+1]
00500 BLT T1,LIBUF+MXWPL+1
00600 MOVE T1,[POINT 7,LIBUF] ;SET UP POINTER
00700 MOVEI T2,5*MXWPL-2 ;SET FOR AVAILABLE SPACE
00800 POPJ P,
00900
01000 RDLIN: SETZM LIBUF+1 ;READ IN A LINE. FIRST ZERO INPUT BUFFER
01100 MOVE T1,[XWD LIBUF+1,LIBUF+2]
01200 BLT T1,LIBUF+MXWPL+1
01300 MOVE T1,[POINT 7,LIBUF+1] ;SET UP POINTER
01400 MOVEI T2,5*MXWPL-2 ;SET FOR AVAILABLE SPACE
01500 MOVEI C,11 ;START WITH A TAB
01600 JRST RDL3
01700
01800 RDL1: PUSHJ P,GNCH ;GET ANOTHER CHARACTER
01900 CAIN C,15 ;IGNORE RETURN
02000 JRST RDL1
02100 CAIN C,12 ;LINE FEED IS THE ONLY PROPER END
02200 JRST RDL2
02300 CAIN C,ALTMOD ;ALTMODE IS A SPECIAL CASE
02400 POPJ P, ;IT RETURNS WITHOUT MORE WORK
02500 RDL3: IDPB C,T1 ;PUT IT IN THE BUFFER
02600 SOJGE T2,RDL1 ;CHECK FOR OVERFLOW AND CONTINUE
02700 RERROR LTL ;LINE IS TOO LONG
02800 POPJ P, ;NON-SKIP RETURN
02900
03000 RDL2: MOVEI C,15 ;PUT IN A CR-LF
03100 IDPB C,T1
03200 MOVEI C,12
03300 IDPB C,T1
03400 HRRZS T1 ;NOW GET THE SIZE
03500 SUBI T1,LIBUF-1
03600 AOS (P) ;SKIP RETURN IF OK
03700 POPJ P, ;AND RETURN
03800
03900 GETLTH: MOVE T1,PNTR ;GET THE LENGTH OF THE LINE POINTED AT
04000 ADDI T1,1
04100 GETLN1: SKIPN T2,(T1) ;ANY END IS GOOD ENOUGH
04200 JRST GETLN2
04300 TRNN T2,1 ;SEQ-NUM?
04400 AOJA T1,GETLN1
04500 GETLN2: SUB T1,PNTR ;FIND LENGTH
04600 POPJ P, ;AND RETURN
04700
04800 OUTSN: PUSH P,T2
04900 MOVSI T2,(ASCII/ /) ;ASCII TAB
05000 TTCALL 3,T1
05100 POP P,T2
05200 POPJ P,
05300
05400 ASCIAD: AND T2,K2A ;CONVERT TO NUMBERS
05500 IOR T1,K4A ;MAKE SURE THIS IS IN DIGIT FORM
05600 ADD T1,K1A ;GET EACH DIGIT IN RANGE 166 TO 177 FOR CARRY
05700 ADD T2,T1 ;SUM
05800 AND T2,K3A ;GET RID OF 100 BITS IF THERE
05900 MOVE T1,K4A ;FIND OUT WHICH ONES NEED SUBTRACTING
06000 AND T1,T2
06100 ASH T1,-3 ;CONVIENIENTLY THEY NEED 6 SUBTRACTED
06200 SUBM T2,T1 ;SO DO IT
06300 IOR T1,K4A ;AND RECONVERT TO DIGITS
06400 POPJ P, ;WE HAVE ADDED THE ASCII IN T1 AND T2 RESULT IN T1
06500
06600 K1A: BYTE (7) 106,106,106,106,106
06700 K2A: BYTE (7) 17,17,17,17,17
06800 K3A: BYTE (7) 77,77,77,77,77
06900 K4A: <ASCII /00000/>!1
07000 K5A: BYTE (7) 7,7,7,7,7
07100 K6A: BYTE (1) 1 (7) 77,77,77,77,77
07200 K7A: BYTE (1) 0 (7) 106,106,106,106,106
07300
07400 ASCAV: AND T2,K2A
07500 IOR T1,K4A ;THIS ROUTINE AVERAGES 2 ASCII NUMERS
07600 LSH T1,-1
07700 ADD T1,K7A ;IT WORKS MOSTLY BY MAJIC
07800 LSH T2,-1
07900 ADD T2,T1
08000 AND T2,K6A
08100 MOVE T1,T2
08200 ANDCM T1,K3A
08300 AND T2,K3A
08400 MOVE T3,T2
08500 LSH T3,-3
08600 AND T3,K2A
08700 AND T2,K5A
08800 SUB T2,T3
08900 LSH T1,-4
09000 ADD T2,T1
09100 LSH T1,-2
09200 ADD T2,T1
09300 IOR T2,K4A
09400 POPJ P,
09500 ;CHECK TO SEE IF BUFFER TOO FULL AND DUMP IF NEEDED
09600
09700 FILLB: MOVE T1,WC ;GET WORD COUNT
09800 CAMGE T1,MAXWC ;AND COMPARE WITH MAX PERMISSIBLE
09900 POPJ P, ;OK, SO RETURN
10000 MOVE T1,BUFP ;GET BUFFER POINTER
10100 ADDI T1,1
10200 FILLB1: SKIPN T2,(T1) ;FIND END OF FIRST LINE
10300 JRST FILLB2
10400 TRNN T2,1
10500 AOJA T1,FILLB1
10600 FILLB2: PUSHJ P,NOWFL ;PART OF GETN WILL DUMP AND ADJUST POINTERS
10700 JRST FILLB ;SEE IF IN LIMITS NOW
10800
10900 ;INSERT A LINE (IN LIBUF) INTO PLACE POINTED AT BY PNTR
11000 ;WORD COUNT OF OLD LINE IN OCNT. OF NEW LINE IN NCNT
11100
11200 INSED: MOVE T1,NCNT ;SEE HOW THE COUNTS DIFFER
11300 SUB T1,OCNT
11400 JUMPE T1,NOBLT ;THEY ARE SAME, NO MOVING NECESSARY
11500 JUMPG T1,BBLT ;NEW IS LARGER, BLT WILL NOT DO
11600 MOVE T2,PNTR ;SET UP BLT POINTER FROM PNTR+OCNT
11700 ADD T2,OCNT
11800 HRLS T2
11900 HRR T2,PNTR ;TO PNTR+NCNT
12000 ADD T2,NCNT
12100 ADDB T1,WC ;ADJUST WC TO OLD WORD COUNT +NCNT-OCNT
12200 ADD T1,BUFP ;LAST TRANSFERED IS BUFP+WC+NCNT-OCNT
12300 BLT T2,(T1)
12400 NOBLT: SKIPN T1,NCNT ;CHECK FOR 0 NEW COUNT (WE ARE DELETING)
12500 POPJ P, ;IF SO DONE
12600 MOVE T2,PNTR ;GET THE POINTER POSITION FOR BLT
12700 HRLI T2,LIBUF ;FROM LIBUF TO PNTR
12800 ADD T1,PNTR ;STOP AT PNTR+NCNT-1
12900 BLT T2,-1(T1)
13000 POPJ P, ;AND ALL DONE
13100
13200 BBLT: MOVE T2,BUFP ;FAKE BACKWARDS BLT FROM BUFP+WC
13300 ADD T2,WC
13400 ADDB T1,WC ;TO BUFP+WC+NCNT-OCNT (ALSO FIX WC)
13500 ADD T1,BUFP
13600 BBLT1: CAMGE T2,PNTR ;STOP HERE (COULD STOP SOONER BUT THIS IS EASIER)
13700 JRST NOBLT ;AND GO MOVE IN NEW STUF
13800 MOVE T3,(T2) ;TRANSFER A WORD
13900 MOVEM T3,(T1)
14000 SUBI T1,1
14100 SOJA T2,BBLT1 ;AND KEEP IT UP
14200
14300 ;ROUTINE FOR CONFIRMATION OF CHOICES....."Y" OR "N" ANSWERS
14400 ;
14500 ;CALLING SEQ.
14600 ; PUSHJ P,CONFRM ;AFTER ASKING QUESTION
14700 ; N RETURN
14800 ; Y RETURN
14900 ;
15000 INSIST: TTCALL 3,[ASCIZ/? YOU MUST TYPE EITHER /]
15100 CONFRM: TTCALL 3,[ASCIZ/Y OR N :/]
15200 TTCALL 0,SINDEX ;GET HIS RESPONSE
15300 ANDI SINDEX,137 ;FORCE TO UPPER CASE
15400 CLRBFI
15500 CAIE SINDEX,"N"
15600 JRST TRY.Y
15700 OUTSTR [ASCIZ "O
15800 "] ;SURPRISE HIM WITH A N'O'
15900 POPJ P, ;"N" RETURN
16000 TRY.Y: CAIE SINDEX,"Y"
16100 JRST INSIST ;OVER AND OVER WE DO IT, DUMDUM
16200 OUTSTR [ASCII "ES
16300 "] ;A Y'ES' WORKS TOO
16400 AOS (P) ;SKIP RETURN FOR YES
16500 POPJ P,
16600
16700 TELDSK: PUSHJ P,FREDSK
16800 TELD.1: MOVE T2,STRNAM+1 ;PICK UP HIS FREE SPACE
16900 JUMPL T2,TELOVR ;HAS HE OVERDRAWN ALREADY?
17000 TELLFT: PUSHJ P,DPRNT
17100 TTCALL 3,[ASCIZ/ DISK BLOCKS IN YOUR AREA ON /]
17200 TTCALL 3,STRSBN ;TELL HIM WHERE IT IS
17300 TTCALL 3,ASCRLF
17400 MOVE T2,STRNAM+2 ;PICK UP THE WORLD
17500 PUSHJ P,DPRNT ;TELL HIM
17600 TTCALL 3,[ASCIZ/ BLOCKS FOR ALL USERS ON THIS STRUCTURE
17700 /]
17800 POPJ P, ;RETURN
17900
18000 TELOVR: TTCALL 3,[ASCIZ/OVER QUOTA BY /] ;TELL BAD NEWS
18100 MOVN T2,T2
18200 JRST TELLFT
18300
18400 TTYOUT: PUSH P,T1
18500 SETZ T1,
18600 IDPB T1,TOBUF+1
18700 HRRZ T1,TOBUF
18800 TTCALL 3,(T1)
18900 HRLI T1,(POINT 7,0)
19000 MOVEM T1,TOBUF+1
19100 MOVEI T1,167
19200 MOVEM T1,TOBUF+2
19300 POP P,T1
19400 POPJ P,
19500
19600 PDLOV: MOVE P,PDLPNT ;REESTABLISH PDL
19700 NERROR STC
19800
19900 ;ROUTINE TO GET A FULL FILE SPECIFICATION INCLUDING DEVICE
20000 ;
20100 ;TO CALL, LOAD T5 WITH THE ADDRESS OF A BLOCK AS FOLLOWS:
20200
20300 READNM: PUSHJ P,SCAN
20400 READN1: SETZM FILNAM
20500 HRLI T1,FILNAM ;SET UP FOR BLT
20600 HRRI T1,FILEXT ;WE COULDN'T USE XWD
20700 BLT T1,FILPPN ;CLEAR AREA
20800 TRZ FL2,RSW!SSW ;AND SWITCH FLAGS
20900 TRNN FL,IDF!NUMF ;IS IT AN IDENT
21000 POPJ P, ;ERROR RETURN
21100 MOVSI T1,'DSK' ;DEFAULT DEVICE
21200 MOVEM T1,FILDEV
21300 SKIPA
21400 READN2: PUSHJ P,SCAN
21500 MOVE T1,ACCUM
21600 MOVEM T1,FILNAM
21700 PUSHJ P,SCAN
21800 CAIN C,":" ;WAS IT A DEVICE?
21900 JRST [MOVE T1,FILNAM ;YES, MOVE IT
22000 MOVEM T1,FILDEV
22100 JRST READN2] ;NOW GET THE REAL FILE NAME
22200 CAIE C,"."
22300 JRST CKTER1
22400 PUSHJ P,SCAN ;THIS SHOULD BE AN EXTENSION
22500 TRNN FL,IDF!NUMF
22600 POPJ P,
22700 MOVE T1,ACCUM ;GET IT
22800 HLLZM T1,FILEXT ;AND PUT IT IN THE EXTENSION FIELD
22900 CKTERM: PUSHJ P,SCAN ;NOW PICK UP THE REST OF THE COMMAND
23000 CKTER1: CAIN C,"[" ;NOW LOOK FOR PPN
23100 JRST [PUSHJ P,SETPPN
23200 POPJ P,
23300 HRLZM T1,FILPPN
23400 PUSHJ P,SCAN
23500 CAIE C,","
23600 POPJ P,
23700 PUSHJ P,SETPPN
23800 POPJ P,
23900 HRRM T1,FILPPN
24000 PUSHJ P,SCAN
24100 CAIE C,"]"
24200 POPJ P,
24300 JRST CKTERM]
24400 CAIN C,"<"
24500 JRST [PUSHJ P,SETPPN
24600 POPJ P,
24700 DPB T1,[POINT 9,FILPRO,8]
24800 PUSHJ P,SCAN
24900 CAIE C,">"
25000 POPJ P,
25100 JRST CKTERM]
25200 CAIE C,"/" ;CHECK FOR READ ONLY MODE
25300 JRST CPOPJ1 ;ALL OK
25400 PUSHJ P,SCAN
25500 TRNE FL,NUMF
25600 POPJ P,
25700 TRNN FL,IDF
25800 POPJ P,
25900 MOVS T1,ACCUM
26000 CAIN T1,(SIXBIT/R /)
26100 TRO FL2,RSW
26200 CAIN T1,(SIXBIT/S /)
26300 TRO FL2,SSW
26400 CAIN T1,'I '
26500 JRST CKNUM
26600 PUSHJ P,SCAN
26700 TRNE FL2,RSW!SSW
26800 AOS (P)
26900 POPJ P,
27000
27100 SETPPN: PUSHJ P,SCAN
27200 TRNN FL,IDF!NUMF
27300 POPJ P,
27400 PUSHJ P,RJUST ;RIGHT JUSTIFY IT
27500 POPJ P, ;NON-SKIP RETURN IF NOT OCTAL
27600 AOS (P)
27700 POPJ P,
27800
27900 RJUST: MOVE T3,ACCUM ;GET THE SIXBIT
28000 MOVEI T1,0
28100 RJUST1: MOVEI T2,0
28200 LSHC T2,6
28300 CAIL T2,20 ;CHECK FOR OCTAL DIGIT
28400 CAILE T2,31
28500 POPJ P,
28600 IMULI T1,PPBASE ;CONVERT TO PPN
28700 ADDI T1,-20(T2)
28800 JUMPN T3,RJUST1 ;DONE IF NULLS LEFT
28900 AOS (P)
29000 POPJ P, ;SKIP RETURN FOR ALL OK
29100
29200 CKNUM: PUSHJ P,SCAN ;GET THE :
29300 CAIE C,":"
29400 POPJ P,
29500 PUSHJ P,SCAN
29600 TRNN FL,NUMF ;IS IT A NUMBER
29700 POPJ P, ;NO!
29800 CAMN T1,[<ASCII /00000/>!1]
29900 POPJ P, ;CAN'T BE ZERO
30000 MOVEM T1,INCR ;SET THE INCREMENT
30100 PUSHJ P,SCAN ;GET THE TERMINATOR
30200 AOS (P)
30300 POPJ P,
00100 SUBTTL INSERT ROUTINE
00200
00300 CRTINS: MOVEI T1,1 ;SET UP TO START INSERTING AT LINE 100 PAGE 1
00400 MOVEM T1,HIPG
00500 MOVE T1,INCR ;<ASCII /00100/>!1
00600 TRO T1,1
00700 MOVEM T1,HILN
00800 JRST INSGO ;AND AWAY WE GO
00900
01000 INSERT: SETZM INCRX# ;TMP INCR
01100 PUSHJ P,SCAN
01200 TRNE FL,TERMF ;CHECK FOR NO ARGUMENTS
01300 JRST [MOVE T1,IPG
01400 MOVEM T1,HIPG
01500 MOVE T1,CURINS
01600 MOVEM T1,HILN
01700 JRST INSGO] ;GO BACK TO INSERTING WHERE YOU WERE
01800 PUSHJ P,GET1 ;GET ONE LINE/PAGE NUMBER
01900 TRNN FL,READOF ;ERROR IF READ ONLY MODE
02000 TRNN FL,LINSN ;WAS A LINE NUMBER SEEN
02100 NERROR ILC ;ERROR IF NOT
02200 CAIE C,"," ;IF A COMMA, SET INCREMENT
02300 JRST NOINC ;NO, KEEP OLD ONE
02400 PUSHJ P,SCAN ;GET THE NUMBER
02500 TRNE FL,NUMF ;WAS IT A NUMBER?
02600 CAMN T1,[<ASCII /00000/>!1] ;DO NOT PERMIT 0 INCR
02700 NERROR ILC ;HE WAS CONFUSED
02800 MOVEM T1,INCRX ;SET INCREMENT
02900 PUSHJ P,SCAN ;SCAN PAST IT
03000 NOINC: TRNN FL,TERMF ;TERMINATOR?
03100 NERROR ILC ;LOSE
03200 INSGO: MOVE T1,INCR ;GET INCR
03300 SKIPN INCRX ;NO TMP INCR?
03400 MOVEM T1,INCRX ;GET THE TRUE INCR
03500 MOVE T1,HIPG ;GET THE PAGE TO GO TO
03600 MOVEM T1,DPG ;AND SET IT UP
03700 MOVE SINDEX,HILN ;ALSO LINE
03800 PUSHJ P,FIND ;GO GET UM
03900 MOVE T2,CPG ;DEMAND CORRECT PAGE MATCH
04000 CAME T2,HIPG
04100 NERROR NSP
04200 CAMN T1,HILN ;ARE THEY MATCHING?
04300 JRST FIXINL ;GO MAKE UP A LINE NUMBER
04400 INSLP: SETZM OCNT
04500 MOVE T1,HILN ;TELL HIM THE LINE HE IS INSERTING
04600 MOVEM T1,LIBUF ;AND PUT IT IN THE BUFFER
04700 PUSHJ P,OUTSN ;PUT IT OUT
04800 PUSHJ P,RDLIN ;READ A LINE
04900 JRST LVINS ;YES, GET OUT OF INSERT MODE
05000 MOVEM T1,NCNT ;HERE IS THE COUNT OF THE NEW ONE
05100 PUSHJ P,INSED ;GO INSERT
05200 PUSHJ P,FINDN ;MOVE UP A LINE
05300 PUSHJ P,FILLB ;AND DUMP SOME IF NECESSARY
05400 MOVE T1,CPG ;SET CURRENT LINE AND PAGE TO LAST
05500 MOVEM T1,CPGL ;ONE REALLY INSERTED
05600 MOVE T1,HILN
05700 MOVEM T1,CLN
05800 MOVE T2,INCRX ;GET NEXT LINE TO INSERT
05900 PUSHJ P,ASCIAD
06000 CAMG T1,INCRX ;HAVE WE WRAPED AROUND
06100 JRST COMND ;YES, STOP
06200 MOVEM T1,HILN ;STORE FOR REFERENCE
06300 ENTINS: SKIPN T1,(PNTR) ;GET THE LINE POINTED TO
06400 JRST INSLP ;ALWAYS INSERT AT END OF FILE
06500 CAME T1,PGMK ;OR AT END OF PAGE
06600 CAMLE T1,HILN ;HAVE WE FOUND A MATCH OR PASSED OVER A LINE?
06700 JRST INSLP ;NO, INSERT
06800 JRST COMND ;RETURN TO COMMAND
06900
07000 LVINS: MOVE T1,HILN
07100 MOVEM T1,CURINS ;SET PLACE TO INSERT NEXT TIME
07200 MOVE T1,CPG
07300 MOVEM T1,IPG
07400 LEVINS: TTCALL 3,ASCRLF
07500 JRST COMND
07600
07700 FIXINL: MOVE T2,INCRX ;SET TO ADD INCR
07800 PUSHJ P,ASCIAD ;ADD
07900 PUSH P,T1 ;SAVE RESULT
08000 PUSHJ P,FINDN ;GET THE NEXT ONE
08100 POP P,T2
08200 CAMG T2,HILN ;IS THERE A WAR PROBLEM
08300 JRST INCBAD ;YES, WE MUST TRY TO COMPUTE ONE
08400 JUMPE T1,INCOK ;END OF FILE, ANY INC IS OK
08500 CAME T1,PGMK ;ALSO OK IF A PAGE MARK
08600 CAMGE T2,T1 ;OR IN CORRECT ORDER
08700 JRST INCOK
08800 INCBAD: CAME T1,PGMK
08900 SKIPN T1
09000 MOVE T1,[<ASCII /9999:/>!1] ;ONE OVER THE TOP OF THE WORLD
09100 MOVE T2,HILN ;GET CURRENT
09200 PUSHJ P,ASCAV ;FIND AVERAGE
09300 CAME T2,HILN ;THERE MAY HAVE ONLY BEEN A DIF OF 1
09400 JRST INCOK ;ALL IS WELL
09500 NERROR ILR
09600 INCOK: MOVEM T2,HILN
09700 JRST INSLP
00100 SUBTTL DELETE ROUTINE
00200
00300 DEPGMK: TRO FL2,ALTFLG ;SET FLAG FOR LATER
00400 DELETE: TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
00500 NERROR ILC
00600 PUSHJ P,GET2S ;GET TWO PAGE-LINE PAIRS
00700 TRNN FL,PGSN ;ONLY ON IF A SECOND PAGE SPEC
00800 TRNN FL,TERMF ;CHECK FOR TERMINATOR
00900 NERROR ILC
01000 TRZN FL,LINSN ;LINE NUMBER SEEN?
01100 JRST [TRNE FL2,ALTFLG ;IS IT A K COMMAND?
01200 JRST DELPG ;DELETE PAGE MARK A
01300 TTCALL 3,[ASCIZ/
01400 MASSIVE DELETION. CONFIRM: /]
01500 PUSHJ P,CONFRM ;GET ANSWER
01600 SKIPA
01700 JRST .+1 ;HE ASKED FOR IT
01800 TTCALL 3,[ASCIZ/ABORTED.
01900 /]
02000 JRST COMND]
02100 MOVE T1,HIPG ;GET THE PAGE NUMBER
02200 MOVEM T1,DPG
02300 MOVE SINDEX,LOLN ;AND LINE
02400 PUSHJ P,FIND
02500 DELT2: CAME T1,PGMK ;ARE WE AT A PAGE MARK?
02600 PUSHJ P,ONMOV ;CHECK FOR RANGE
02700 JRST DELEND
02800 MOVEM T1,CLN ;MARK AS CURRENT LINE
02900 TRO FL,LINSN ;AND ALSO THAT WE DID SOMETHING
03000 PUSHJ P,DODEL ;GO DO A LINE DELETE
03100 PUSHJ P,FINDN1 ;FIND NEXT BUT ACCEPT LINE IF ALREADY THERE
03200 JRST DELT2 ;GO DO NEXT
03300
03400 DELEND: TRNN FL,LINSN ;DID WE SEE ANYTHING?
03500 NERROR NLN ;NO, GIVE ERROR
03600 MOVE T1,CPG ;YES, SET CURRENT PAGE
03700 MOVEM T1,CPGL
03800 JRST COMND ;AND GET NEXT COMMAND
03900
04000 DELPG: MOVE T1,HIPG ;GET THE DESIRED PAGE TO DELETE
04100 MOVEM T1,DPG ;SET IT
04200 SOJLE T1,DELER ;DO NOT TRY PAGE 1
04300 MOVEI SINDEX,0 ;GUARENTEED TO FIND LINE IMMEDIATELY AFTER PAGE MARK
04400 PUSHJ P,FIND ;GET IT
04500 CAMN T1,PGMK ;IS IT A PAGE MARK?
04600 MOVE T1,[<ASCII/00000/>!1] ;YES, SET CLN TO NO-LINE
04700 MOVEM T1,CLN ;RESET CURRENT LINE TO POINT TO HERE
04800 MOVE T2,CPG ;CHECK FOR MATCH
04900 CAME T2,HIPG
05000 DELER: NERROR NSP ;NO SUCH PAGE
05100 PUSHJ P,FINDB ;GO BACK ONE
05200 CAME T1,PGMK ;IS IT A PAGE MARK?
05300 ERROR ICN ;CONFUSED, GIVE FATEL ERROR
05400 MOVEI T1,2 ;COUNT IS 2
05500 MOVEM T1,OCNT
05600 SETZM NCNT ;AND NEW IS 0
05700 PUSHJ P,INSED
05800 SOS BGPG ;MAX PAGE IS NOW 1 LOWER
05900 SOS INPG
06000 MOVE T1,CPG ;ONLY GOD AND BILL WEIHER KNOW WHY WE
06100 MOVEM T1,CPGL ;HAVE BOTH CPG AND CPGL, BUT THEY ARE NEEDED
06200 PUSHJ P,FINDN1 ;GET THE NEXT LINE
06300 JUMPE T1,COMND ;IF EOF THERE IS NO ORDER ERROR
06400 CAMN T1,PGMK ;OR IF A PAGE MARK
06500 JRST COMND
06600 MOVEM T1,SVWD3 ;SAVE IT FOR COMPARE
06700 PUSHJ P,FINDB ;FIND THE PREVIOUS ONE
06800 JUMPE T1,COMND ;START OF FILE, ALL OK
06900 CAME T1,PGMK ;ANOTHER PAGE MARK
07000 CAMGE T1,SVWD3 ;CHECK THE ORDER
07100 JRST COMND ;ALL OK
07200 NERROR ORDER ;ALL WRONG
00100 SUBTTL INSERT PAGE MARK
00200 ;INSERT A PAGE MARK AT DESIGNATED LINE
00300
00400 PGMK: <ASCII / />!1 ;5 BLANKS WITH BIT 35 SET
00500 PGMKTX: BYTE (7) 15,14,0,0,0 ;THE TEXT OF A STANDARD PAGE MARK
00600
00700 MARK: SETZM HILN ;IN CASE OF /A
00800 TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
00900 NERROR ILC
01000 PUSHJ P,GET1S ;GET ONE LINE/PAGE NUMBER
01100 TRNN FL,TERMF ;CHECK FOR TERMINATOR
01200 NERROR ILC
01300 MOVE T1,HIPG ;GO LOOK FOR IT
01400 MOVEM T1,DPG
01500 MOVE SINDEX,HILN ;AND THE LINE
01600 PUSHJ P,FIND ;GET IT
01700 MOVE T1,CPG
01800 CAME T1,HIPG ;PAGE MUST MATCH
01900 NERROR NSP ;MUST MATCH
02000 AOS T1,CPG ;WILL BE ON HIGHER PAGE WHEN DONE
02100 MOVEM T1,CPGL ;SET UP LOGICAL PAGE
02200 AOS BGPG ;THERE IS NOW ONE MORE
02300 AOS INPG
02400 MOVE T1,[<ASCII /00000/>!1]
02500 MOVEM T1,CLN ;FIRST LINE ON THE PAGE
02600 MOVE T1,PGMK ;PUT A PAGE MARK IN LIBUF
02700 MOVEM T1,LIBUF
02800 MOVE T1,PGMKTX ;TEXT OF A PAGE MARK
02900 MOVEM T1,LIBUF+1
03000 SETZM OCNT ;THIS IS A STRAIGHT INSEET
03100 MOVEI T1,2 ;OF 2 WORDS
03200 MOVEM T1,NCNT
03300 PUSHJ P,INSED ;GO DO IT
03400 PUSHJ P,FINDN ;SINCE FILLB MAY WANT TO DUMP THIS LINE
03500 PUSHJ P,FILLB
03600 MOVE T1,CPG ;NOW RESET "." TO POINT TO FIRST LINE ON PAGE
03700 MOVEM T1,DPG
03800 MOVE SINDEX,CLN ;AND THE LINE
03900 PUSHJ P,FIND ;GET IT
04000 CAME T1,PGMK ;AN EMPTY PAGE?
04100 MOVEM T1,CLN ;NO, SAVE THIS PLACE AS THE CURRENT LINE
04200 JRST COMND ;ALL DONE
00100 SUBTTL RENUMBER
00200
00300 NUMBER: PUSHJ P,SCAN ;GET THE RENUMBER INCREMENT
00400 TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
00500 NERROR ILC
00600 TRNE FL,TERMF ;IS IT SHORT FORM N=N./.
00700 JRST NUMB6 ;YES, GO FORCE DEFAULTS
00800 TRNE FL,NUMF ;WAS IT A NUMBER
00900 CAMN T1,[<ASCII /00000/>!1] ;NO 0 RENUMBER INCR
01000 NERROR ILC
01100 MOVEM T1,REINC ;THE INCREMENT TO USE
01200 MOVEM T1,INCST ;LINE TO START WITH
01300 PUSHJ P,SCAN ;SCAN PAST NUMBER
01400 CAIE C,"," ;AND CHECK FOR COMMA
01500 JRST NUMB8 ;DEFAULT "N<CR><LINE>" TO "/."
01600 PUSHJ P,GET2S ;GET A RANGE
01700 NUMB9: CAIE C,"," ;SEE IF THERE IS A FOURTH ARGUMENT
01800 JRST NUMBL ;NO
01900 PUSHJ P,SCAN ;YES, GET IT
02000 TRNN FL,NUMF ;IS IT A NUMBER?
02100 JRST [TRNN FL,IDF ;WISHES MONOTONIC RENUMBERING?
02200 NERROR ILC ;HE WOULD HAVE BEEN BETTER OFF WITHOUT IT
02300 MOVS T1,ACCUM;GET ARGUMENT
02400 CAIE T1,'M ' ;IS IT AN "M"?
02500 NERROR ILC ;NO
02600 TLO FL2,UPUPUP ;YES, SET FLAG
02700 JRST .+2]
02800 MOVEM T1,INCST ;USS AS STARTING NUMBER
02900 PUSHJ P,SCAN ;SCAN PAST IT
03000 JRST NUMB9 ;GO GET THE NEXT ARGUMENT
03100
03200 NUMBL: TRNN FL,TERMF ;ENDS PROPERLY?
03300 NERROR ILC ;LOSE
03400 MOVE T1,LOPG ;GET PLACE TO START
03500 MOVEM T1,DPG
03600 MOVE SINDEX,LOLN ;AND LINE
03700 PUSHJ P,FIND ;GET IT
03800 TRZ FL,LINSN!ORDF ;SET TO NONE SEEN AND NO ORDER ERROR
03900 PUSHJ P,FINDB ;BACK UP AND SEE HOW ORDER LOOKS
04000 JUMPE T1,NUMB5 ;START OF FILE IT MUST BE OK
04100 CAME T1,PGMK ;ALSO IF A PAGE MARK
04200 CAMGE T1,INCST ;OR IF IN CORRECT ORDER
04300 JRST NUMB5
04400 TRO FL,ORDF ;WRONG SET FLAG
04500 NUMB5: PUSHJ P,FIND ;GET THE CORRECT LINE BACK
04600 NUMB2: PUSHJ P,ONMOV ;CHECK RANGE
04700 JRST NUMB3
04800 CAMN T1,PGMK ;PAGE MARK?
04900 JRST NUMB4 ;SPECIAL TREATMENT
05000 MOVE T1,INCST ;GET STAATING NUMBER
05100 MOVE T2,REINC ;AND INCREMENT
05200 TRON FL,LINSN ;WAS A LINE SEEN?
05300 JRST FSTLIN ;NO, FIRST ONE IS SPECIAL
05400 PUSHJ P,ASCIAD ;SKIP THIS THE FFRST TIME
05500 CAML T1,REINC ;HAVE WE WRAPED
05600 JRST FSTLIN
05700 RERROR WAR ;TELL HIM HE LOST
05800 MOVE T2,CPG ;PRINT THE PAGE
05900 PUSHJ P,PGPRN
06000 FSTLIN: MOVEM T1,INCST ;SAVE FOR NEXT LINE
06100 MOVEM T1,CLN ;AND THE CURRENT LINE
06200 MOVEM T1,(PNTR) ;PUT IT IN
06300 PUSHJ P,FINDN ;GET NEXT
06400 JRST NUMB2 ;AND GO RANGE CHECK
06500
06600 NUMB3: TRNN FL,LINSN ;DONE, WAS THERE SOMETHING THERE?
06700 NERROR NLN ;NO, NULL RANGE ERROR
06800 MOVE T2,CPG ;SET UP CURRENT PAGE
06900 MOVEM T2,CPGL
07000 TRNE FL,ORDF ;WAS THERE AN ORDER ERROR?
07100 NERROR ORDER ;YES, FLAG IT
07200 JUMPE T1,COMND ;CHECK TO SEE IF LOSAGE NOW
07300 CAME T1,PGMK
07400 CAMLE T1,INCST
07500 JRST COMND
07600 NERROR ORDER
07700
07800 NUMB4: PUSHJ P,FINDN ;PAGE MARK, GET THE NEXT LINE
07900 AOS CPG ;NOW ON A HIGHER PAGE
08000 MOVE T1,[<ASCII /00000/>!1]
08100 MOVEM T1,CLN ;SET TO FIRST LINE ON PAGE
08200 TRO FL,LINSN ;WE SAW ONE
08300 TLNN FL2,UPUPUP ;CONTINUE INCREASING SEQ. NUMBERS?
08400 SETZM INCST ;START OVER ON NUMBERS
08500 JRST NUMB2
08600
08700 NUMB6: MOVE T1,INCR ;GET CURRENT INCREMENT
08800 MOVEM T1,REINC ;SET REINCREMENT
08900 MOVEM T1,INCST ;SET START LINE
09000 NUMB7: MOVE T1,CPGL ;GET CURRENT PAGE
09100 MOVEM T1,LOPG ;SET RANGE START
09200 MOVEM T1,HIPG ;SET RANGE END
09300 SETZM LOLN ;SET THE DEFAULT RANGE START LINE
09400 MOVE T1,[<ASCII /99999/>!1] ;MAKE A HIGH LINE
09500 MOVEM T1,HILN ;SET RANGE END LINE
09600 JRST NUMBL
09700
09800 ;IT HAD BETTER BE A TERMINATOR
09900 NUMB8: TRNN FL,TERMF ;IS IT
10000 NERROR ILC ;LOSE
10100 JRST NUMB7 ;DEFAULT TO "/."
00100 SUBTTL ALTER COMMAND
00200
00300 ALTER: TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
00400 NERROR ILC
00500 PUSHJ P,GET2S ;GET THE RANGE
00600 TRNN FL,TERMF ;CHECK FOR PROPER END
00700 NERROR ILC ;UNEND
00800 MOVE T1,LOPG ;START TO PROCESS
00900 MOVEM T1,DPG
01000 MOVE SINDEX,LOLN
01100 PUSHJ P,FIND ;GO GET IT
01200 TRZ FL,LINSN ;NOT SEEN YET
01300 ALT1: PUSHJ P,ONMOV ;CHECK FOR IN RANGE
01400 JRST ALT2 ;NO, FINISH UP
01500 TRO FL,LINSN ;WE DID SEE SOMETHING
01600 CAMN T1,PGMK ;CHEC FOR A PAGE
01700 JRST ALT3 ;DO NNT TRY TO CHANGE THIS
01800 MOVEM T1,CLN ;NOW, IN CASE WE SAID ALTMODE
01900 MOVE T1,CPG ;SAME FOR PAGE
02000 MOVEM T1,CPGL
02100 PUSHJ P,ALTLIN ;GO DO THE ALTER
02200 JRST LEVINS ;HE SAID ALTMODE
02300 PUSHJ P,INSED ;GO INSERT
02400 ALT4: PUSHJ P,FINDN ;GET THE NEXT LINE
02500 PUSHJ P,FILLB ;AND CHECK FOR BUFFER OVERFLOW
02600 MOVE T1,(PNTR) ;GET LINE FOR ONMOV
02700 JRST ALT1 ;CONTINUE LOOP
02800
02900 ALT3: AOS T2,CPG ;WE ARE ON A LATER PAGE NOW
03000 MOVEM T2,CPGL ;SAVE AS .
03100 PUSHJ P,PGPRN ;PRINT HIM A MESSAGE
03200 MOVE T1,[<ASCII /00000/>!1] ;SET TO FIRST? LINE
03300 MOVEM T1,CLN ;FOR .
03400 JRST ALT4 ;CONTINUE PAST IT
03500
03600 ALT2: TRNN FL,LINSN ;WAS THERE ANYTHING THERE?
03700 NERROR NLN ;NO, GIVE ERROR
03800 MOVE T1,CPG ;|ET CURRENT PAGEE
03900 MOVEM T1,CPGL ;SAVE AS .
04000 JRST COMND ;GO
04100
04200 ALTLIN: PUSHJ P,SETALT ;SET UP LINE FOR ALTERATION
04300 ALTN1:
04400 ALTLP2: MOVEI T2,0 ;ZERO REPEAT COUNT
04500 ALTLP: TRZ FL2,ALTDUP ;TURN DUPLEXING BACK OFF
04600 PUSHJ P,GNCH1 ;GET ON CHR IN DDT SUBMODE
04700 CAIN C,15
04800 JRST ALTLP2 ;JUST GET THE LINE-FEED NEXT
04900 TLNE CS,LETFX ;CHECK FOR LETTER
05000 TRZ C,40 ;AND CONVERT TO UPPER CASE
05100 MOVSI T1,-ALTLG ;GET LENGTH OF COMMAND TABLE
05200 LDB T3,[POINT 8,ALTAB(T1),12] ;PICK UP COMMAND
05300 CAIE C,(T3) ;CHECK FOR EQUAL
05400 AOBJN T1,.-2 ;NO, TRY AGAIN
05500 JUMPGE T1,[MOVEI T1,7
05600 TTCALL 1,T1 ;I DON'T UNDERSTAND
05700 JRST ALTLP2] ;AOBJN RAN OUT,RING BELL
05800 PUSHJ P,@ALTAB(T1) ;EXECUTE COMMAND
05900 JRST ALTLP2 ;RESET REPEAT COUNT AND GET NEW COMMAND
06000 JRST ALTLP ;SKIP RETURN FROM DIGITS NO COUNT RESET
06100
06200 ALTAB:
06300 CMNDEF "E",A.EXP ;SETS EXPERT MODE
06400 CMNDEF "N",A.NOV ;SETS NOVICE MODE
06500 CMNDEF "X",ALTX
06600 CMNDEF " ",ALTTB
06700 CMNDEF " ",ALTSP
06800 CMNDEF "I",ALTIN
06900 CMNDEF "D",ALTDL
07000 CMNDEF "S",ALTSR
07100 CMNDEF "K",ALTKL
07200 CMNDEF "F",ALTFNF ;FAST FINISH (NO MORE PRINTING)
07300 CMNDEF "Q",ALTALT
07400 CMNDEF 12,ALTFN
07500 CMNDEF "C",ALTCN
07600 CMNDEF 177,ALTBS
07700 CMNDEF "U"-100,ALTCU
07800 CMNDEF "R",ALTRP
07900 CMNDEF "L",ALTLN
08000 CMNDEF "P",PRINTQ
08100 CMNDEF "J",JOINA
08200 CMNDEF "0",ALTDG
08300 CMNDEF "1",ALTDG
08400 CMNDEF "2",ALTDG
08500 CMNDEF "3",ALTDG
08600 CMNDEF "4",ALTDG
08700 CMNDEF "5",ALTDG
08800 CMNDEF "6",ALTDG
08900 CMNDEF "7",ALTDG
09000 CMNDEF "8",ALTDG
09100 CMNDEF "9",ALTDG
09200 ALTLG==.-ALTAB
09300
09400 A.EXP: TROA FL,EXTOG ;SET EXPERT FLAG
09500 A.NOV: TRZ FL,EXTOG ;CLEAR EXPERT FLAG
09600 POPJ P,
09700
09800 SETALT: SETZM LIBUF ;ZERO OUT INTERNAL LINE BUFFER
09900 MOVE T1,[XWD LIBUF,LIBUF+1]
10000 BLT T1,LIBUF+MXWPL+1
10100 MOVEI T1,LIBUF ;SET POINTER TO TRANSFER
10200 MOVE T2,PNTR
10300 MOVE T3,(T2) ;GET THE FIRST WORD (SEQ NUM)
10400 JRST SALT3
10500
10600 SALT2: SKIPE T3,(T2) ;PICK UP A WORD AND CHECK FOR 0
10700 TRNE T3,1 ;CHECK FOR SEQ NTM
10800 JRST SALT1 ;END OF THIS LINE
10900 SALT3: MOVEM T3,(T1) ;SAVE IT AWAY
11000 ADDI T1,1 ;INCREMENT POINTERS
11100 AOJA T2,SALT2
11200
11300 SALT1: MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET UP POINTER
11400 SETZM ALTCNT ;SO FAR WE ARE 0 CHRS INTO LINE
11500 SUBI T1,LIBUF ;GET COUNT OF OLD LINE
11600 HRRZM T1,OCNT ;AND SAVE IT FOR INSED
11700 SETSTS TTY,201 ;TURN OFF DUPLEXING
11800 TRZ FL2,RUBF!ALTDUP!RUBF2 ;TURN OFF IN RUBOUT FALG AND NO DUPLEXING
11900 TRZ FL2,ALTFLG ;NOTHING INSERTED SO FAR
12000 MOVE T1,LIBUF ;PRINT LINE NUMBER AND TAB
12100 JRST OUTSN
12200
12300 OFFRUB: TRZE FL2,RUBF2
12400 TTCALL 3,[ASCII /\\/]
12500 TRZE FL2,RUBF
12600 TTCALL 1,["\"]
12700 POPJ P, ;AND RETURN
12800
12900 GNCH1A: TTCALL 0,C
13000 ANDI C,177
13100 CAIN C,33
13200 JRST .+3
13300 CAIE C,175
13400 CAIN C,176
13500 MOVEI C,ALTMOD
13600 CAIE C,ALTMOD
13700 TRNN FL2,ALTDUP ;AND NOT UNLESS DESIRED
13800 POPJ P,
13900 CAIE C,12 ;NOT LINE FEED
14000 CAIN C,15 ;OR RETURN
14100 POPJ P,
14200 CAIN C,177 ;AND FINALLY IGNORE RUBOUT
14300 POPJ P,
14400 PUSHJ P,OFFRUB ;IF WE ARE DUPLEXING WE ARE NOT DELETING
14500 TTCALL 1,C ;TYPE
14600 POPJ P,
14700
14800 GNCH1: PUSHJ P,GNCH1A ;GET A CHR IN DDT MODE
14900 CAIN C,175 ;CONVERT ALTMODE TO ALTMOD
15000 MOVEI C,ALTMOD
15100 TLNN FL,QMODF
15200 CAIE C,"'" ;CHECK FOR APOSTROFHY
15300 JRST GNCH1B ;NO, THIS CHR IS OK
15400 PUSHJ P,GNCH1A ;GET ANOTHER
15500 SKIPE CTBL(C) ;IF 0 HN CTBL, KEEP IT
15600 MOVS C,CTBL(C) ;GET ALTERNATE CODE
15700 ANDI C,177 ;GET RID OF EXTRA BITS
15800 GNCH1B: MOVE CS,CTBL(C) ;LOAD CS
15900 TLNE CS,LETFX ;CHECK FOR LETTER
16000 TDC C,CASEBT ;AND APPLY CASE CONVERRION
16100 POPJ P, ;ALL DONE
16200 ALTDG: IMULI T2,^D10 ;ACCUMULATE REPEAT COUNT
16300 ADDI T2,-"0"(C)
16400 AOS (P) ;SKIP RETURN SO AS NOT TO 0 RPT. CNT.
16500 POPJ P,
16600
16700 ALTTB: MOVEI T2,1000 ;ENTRY FOR TAB ROUTINE
16800 ALTSP: PUSHJ P,OFFRUB
16900 ALTSP2: LDB C,ALTP ;GET THE CHR WE ARE POINTING AT
17000 CAIN C,15 ;IF RETURN THEN AS FAR AS CAN GO
17100 JRST ALTSP1 ;SO QUIT
17200 TRNN FL2,RALPHF ;IF SET, DO NOT PRINT. (QUICK EXIT.)
17300 PUSHJ P,OCHR ;PRINT IT
17400 IBP ALTP ;ADVANCE POINTER
17500 AOS ALTCNT ;AND COUNT
17600 SOJG T2,ALTSP2 ;DO CORRECT NUMBER OF TIMES
17700 ALTSP1: PUSHJ P,TTYOUT ;FORCE IT OUT
17800 POPJ P,
17900
18000 ALTX: MOVEM T2,ALTINC ;SAVE NEW LINE INCREMENT
18100 PUSHJ P,ALTTB ;DO YOUR TAB THING
18200 SKIPA ;DON'T SAVE THAR INC AGAIN
18300 ALTIN: MOVEM T2,ALTINC ;SAVE IN CASE HE INSERTS A RETURN
18400 TRO FL2,ALTDUP ;TURN ON DUPLEXING
18500 ALTIN1: PUSHJ P,GNCH1 ;GET A CHARACTER
18600 CAIN C,15 ;IGNORE RETURN
18700 JRST ALTIN1
18800 CAIN C,12 ;FINISH ON LINE FEED OR ALTMODE
18900 JRST INSCR ;GO INSERT A CRLF
19000 CAIN C,ALTMOD
19100 POPJ P, ;GO AWAY
19200 CAIN C,177 ;CHECK FOR BACKSPACE
19300 JRST ALTIBS ;AND DELETE CHR TO LEFT
19400 MOVE T3,ALTP ;GET SET TO SHIFT THINGS
19500 PUSH P,ALTCNT ;SAVE THIS FOR LATER
19600 LDB T1,T3 ;GET CHR FROM LINE
19700 ALTIN2: DPB C,T3 ;SHIFT LINE
19800 JUMPE C,ALTIN3 ;DONE
19900 AOS ALTCNT ;COUNT IT
20000 ILDB C,T3
20100 DPB T1,T3
20200 JUMPE T1,ALTIN3 ;DONE
20300 AOS ALTCNT ;COUNT
20400 ILDB T1,T3
20500 JRST ALTIN2
20600
20700 ALTIN3: MOVE T2,ALTCNT ;SEE IF OVERFLOW HAPPENED
20800 CAIL T2,MXWPL*5
20900 NERROR LTL ;YES
21000 POP P,ALTCNT ;RESTORE OLD COUNT
21100 IBP ALTP ;ADVANCE POINTER
21200 AOS ALTCNT ;AND COUNT
21300 JRST ALTIN1 ;GO GET MORE
21400
21500
21600 INSCR: PUSHJ P,OFFRUB
21700 TTCALL 3,ASCRLF
21800 SKIPN T1,ALTINC ;DID HE SPECIFY AN INCREMENT?
21900 SKIPA T3,INCR ;NO, USE STANDARD
22000 PUSHJ P,ASCON ;CONVERT TO ASCII
22100 MOVE T1,T3 ;FIND THE NEW LINE NUMBER
22200 MOVE T2,LIBUF ;CURRENT ONE
22300 PUSHJ P,ASCIAD ;ADD
22400 PUSH P,T1 ;SAVE RESULT
22500 PUSHJ P,FINDN ;GET THE NEXT ONE
22600 POP P,T2
22700 CAMG T2,LIBUF ;IS THERE A WAR PROBLEM
22800 JRST INCBAX ;YES, WE MUST TRY TO COMPUTE ONE
22900 JUMPE T1,INCOK1 ;END OF FILE, ANY INC IS OK
23000 CAME T1,PGMK ;ALSO OK IF A PAGE MARK
23100 CAMGE T2,T1 ;OR IN CORRECT ORDER
23200 JRST INCOK1
23300 INCBAX: CAME T1,PGMK
23400 SKIPN T1
23500 MOVE T1,[<ASCII /9999:/>!1] ;ONE OVER THE TOP OF THE WORLD
23600 MOVEM T2,LIBUF2 ;SAVE IN CASE NOTHING WILL WORK
23700 MOVE T2,LIBUF ;GET CURRENT
23800 PUSHJ P,ASCAV ;FIND AVERAGE
23900 CAME T2,LIBUF ;THERE MAY HAVE ONLY BEEN A DIF OF 1
24000 JRST INCOK1 ;ALL IS WELL
24100 RERROR ORDER ;TELL HIM
24200 PUSHJ P,FINDB ;GET BACK WHERE WE BELONG
24300 PUSHJ P,ERCOR ;TYPE OUT LINE TO CURRENT POINT
24400 JRST ALTIN1 ;AND CONTINUE INSERT
24500
24600 INCOK1: MOVEM T2,LIBUF2 ;SAVE IT
24700 MOVEM T2,CLN ;AND SET AS CURRENT LINE
24800 PUSHJ P,FINDB ;BACK UP TO WHERE WE BELONG
24900 MOVE T1,[XWD LIBUF+1,LIBUF2+1]
25000 BLT T1,LIBUF2+MXWPL+1 ;SAVE OLD BUFFER
25100 PUSH P,ALTP ;SAVE POINTER
25200 MOVEI C,15
25300 DPB C,ALTP ;AND TERMINATE THIS LINE
25400 MOVEI C,12
25500 IDPB C,ALTP
25600 MOVEI C,0 ;FILL OUT LINE WITH NULLS
25700 INSC2: TLNN ALTP,760000
25800 JRST INSC3
25900 IDPB C,ALTP
26000 JRST INSC2
26100
26200 INSC3: SUBI ALTP,LIBUF-1 ;FIND COUNT
26300 HRRZM ALTP,NCNT
26400 PUSHJ P,INSED ;REPLACE OLD LINE
26500 PUSHJ P,FINDN ;MOVE UP TO NEXT
26600 PUSHJ P,FILLB ;AND DUMP IF OVERFLOW
26700 SETZM OCNT ;THIS IS A NEW LINE GOING IN
26800 MOVE T1,LIBUF2 ;MOVE LINE NUMBER OVER
26900 MOVEM T1,LIBUF
27000 SETZM LIBUF+1
27100 MOVE T1,[XWD LIBUF+1,LIBUF+2]
27200 BLT T1,LIBUF+MXWPL+1 ;ZERO OUT REST
27300 POP P,T2 ;RESTORE POINTER TO REST OF LINE
27400 MOVE ALTP,[POINT 7,LIBUF+1] ;DEST POINTER
27500 ADD T2,[XWD 70000,LIBUF2-LIBUF] ;ADJUST INPUT POINTER
27600 MOVEI C,11 ;AND SET UP THE TAB
27700 MOVNEW: IDPB C,ALTP
27800 CAIN C,12
27900 JRST DONNEW ;FINISHED MOVING REST OF LINE
28000 ILDB C,T2 ;PICK UP ONE
28100 JRST MOVNEW
28200
28300 DONNEW: MOVEI ALTP,1(ALTP) ;GET COUNT
28400 SUBI ALTP,LIBUF
28500 MOVEM ALTP,NCNT
28600 PUSH P,ALTP ;AND SAVE
28700 PUSHJ P,INSED ;INSERT
28800 MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET UP FOR ALTER
28900 SETZM ALTCNT
29000 POP P,OCNT ;SET FOR OLD COUNT
29100 MOVE T1,LIBUF
29200 PUSHJ P,OUTSN
29300 TRO FL2,ALTFLG ;WE HAVE INSERTED AND ALTALT SHOULD CALL FILLB
29400 JRST ALTIN1 ;AND CONTINUE INSERTING
29500 POPJ P,
29600
29700 ALTIBS: MOVEI T2,0 ;SET COUNT TO 0
29800 MOVEM ALTP,SVALTP ;SAVE POINTER
29900 PUSHJ P,ALTBS ;DO A BACKSPACE
30000 EXCH ALTP,SVALTP ;GET BACK AND SAVE CURRENT
30100 PUSHJ P,ALTDL3 ;DELETE THAT CHR
30200 JRST ALTIN1 ;GET MORE
30300
30400 ALTDL: MOVEM ALTP,SVALTP ;SAVE CURRENT POINTER POSITHON
30500 TLZ FL2,SINGDL ;CLEAR THE 1D FLAG
30600 SKIPE T2
30700 TLO FL2,SINGDL
30800 ALTDL1: LDB C,ALTP ;GET CURRENT CHR
30900 CAIN C,15 ;AT END OF LINE?
31000 JRST ALTDL5 ;YES, GO FINISH OFF
31100 TRNE FL,EXTOG ;IN EXPERT MODE?
31200 TLNN FL2,SINGDL
31300 SKIPA
31400 JRST DOSLH
31500 CAIG T2,3 ;FEWER THAN 3 MORE TO DELETE
31600 JRST [PUSH P,C
31700 MOVEI C,"\"
31800 TRNN FL2,RUBF2
31900 PUSHJ P,OCHR
32000 TRZE FL2,RUBF
32100 PUSHJ P,OCHR
32200 TRON FL2,RUBF2
32300 PUSHJ P,OCHR
32400 POP P,C
32500 PUSHJ P,OCHR
32600 JRST .+1]
32700 DOSLH: IBP ALTP ;ADVANCE POINTER
32800 SOJG T2,ALTDL1 ;CHECK COUNT AND CONTINUE
32900 ALTDL5: PUSHJ P,TTYOUT ;FORCE OUTPUT
33000 ALTDL3: MOVE T3,SVALTP ;GET BACK POINTER
33100 ALTDL4: LDB C,ALTP ;MOVE LINE DOWN
33200 DPB C,T3
33300 JUMPE C,[MOVE ALTP,SVALTP ;RESTORE POINTER AGAIN
33400 POPJ P,] ;AND LEAVE
33500 IBP ALTP ;ADVANCE POINTERS
33600 IBP T3
33700 JRST ALTDL4
33800
33900 PRINTQ: PUSH P,ALTCNT ;SAVE CURRENT COUNT
34000 PUSHJ P,ALTLN ;PRINT REST OF LINE AND START OVER
34100 POP P,T2 ;GET BACK COUNT
34200 CAILE T2,0 ;AND SPACE IF NOT 0
34300 JRST ALTSP
34400 POPJ P,
34500
34600 ALTSR: PUSHJ P,OFFRUB
34700 PUSHJ P,GNCH1 ;GET THE CHARACTER TO SEARCH FOR
34800 ALTSR1: PUSH P,T2 ;SAVE NUMBER OF TIMES TO SEARCH
34900 PUSHJ P,ALTCS ;CALL COMMON SEARCH ROUTINE
35000 PUSH P,C ;SAVE THE CHARACTER
35100 PUSHJ P,ALTSP ;GO SPACE CORRECT NUMBER
35200 POP P,C ;RESTORE CHR
35300 POP P,T2 ;AND COUNT
35400 SOJG T2,ALTSR1 ;CONTINUE
35500 POPJ P,
35600
35700 ALTCS: MOVEI T2,1 ;CREATE A REPEAT COUNT
35800 LDB T3,ALTP ;CHEC TO SEE IF AT END OF LINE
35900 CAIN T3,15
36000 POPJ P,
36100 MOVE T1,ALTP ;GET A COPY OF THE POINTER
36200 ALTCS1: ILDB T3,T1 ;GET A CHARACTER
36300 CAIE T3,15 ;DONE IF END OF LINE
36400 CAMN T3,C ;OR A MATCH
36500 POPJ P,
36600 AOJA T2,ALTCS1 ;ELSE KEEP COUNT AND KEEP LOOKING
36700
36800 ALTKL: PUSHJ P,GNCH1 ;ALMOST LINE ALTSR
36900 ALTKL1: PUSH P,T2
37000 PUSHJ P,ALTCS
37100 CAIN T3,15 ;BUT GIVE UP IF CHR NOT FOUND
37200 JRST TPOPJ
37300 PUSH P,C
37400 PUSHJ P,ALTDL ;DELETE THAT NUMBER
37500 POP P,C
37600 POP P,T2
37700 SOJG T2,ALTKL1
37800 POPJ P,
37900 TPOPJ: POP P,T2 ;NEED TO CLEAR STACK
38000 POPJ P,
38100
38200 ALTALT: PUSHJ P,OFFRUB
38300 TRNN FL2,ALTFLG ;SHOULD WE DO A FILLB?
38400 JRST ALTAL1
38500 PUSHJ P,FINDN
38600 PUSHJ P,FILLB ;YES, WE HAVE INSERTED SOMETHING
38700 ALTAL1: SETSTS TTY,1 ;DUMPLEXING BACK ON
38800 JRST TPOPJ ;AND RETURN
38900
39000 ALTFNF: TRO FL2,RALPHF ;SET SWITCH TO SUPPRESS PRINTING
39100 ALTFN: PUSHJ P,OFFRUB
39200 MOVEI T2,1000 ;FINISH UP LINE
39300 PUSHJ P,ALTSP ;BY PRINTING A LARGE NUMBER OF SPCAES
39400 TRZ FL2,RALPHF ;RESET JUST IN CASE WE FORGET
39500 TTCALL 3,ASCRLF
39600 SETSTS TTY,1 ;GET OUT OF NON-DUPLEX MODE
39700 ILDB C,ALTP ;LOOK ONE CHR OVER
39800 CAIE C,12 ;THIS SHOULD BE THE LINE FEED
39900 NERROR ILFMT ;SOMETHING IS WRONG
40000 MOVEI C,0 ;ZERO REMAINDER OF LINE
40100 ALTFN2: TLNN ALTP,760000 ;ALL DONE?
40200 JRST ALTFN3 ;YES
40300 IDPB C,ALTP ;NO, PUT IN ANOTHER 0
40400 JRST ALTFN2
40500 ALTFN3: SUBI ALTP,LIBUF-1 ;GET SIZE OF NEW LINE
40600 HRRZM ALTP,NCNT ;AND SAVE FOR INSED
40700 AOS -1(P) ;SET FOR SKIP RETURN
40800 POP P,T1 ;GET RID OF THE EXTRA CALL
40900 POPJ P, ;RETURN TO CALLER OF ALTLIN
41000
41100 ALTCU: PUSHJ P,OFFRUB
41200 TTCALL 3,[ASCIZ /^U
41300 /]
41400 JRST SETALT ;GO RESTART LINE AND FORGET EDIT SO FAR
41500
41600 ALTRP: PUSHJ P,ALTDL ;REPLACE IS DELETE THEN INSERT
41700 MOVEI T2,0
41800 JRST ALTIN
41900
42000 ALTCN: PUSHJ P,OFFRUB
42100 TRO FL2,ALTDUP ;TURN ON DUPLEXING
42200 ALTCN2: LDB C,ALTP ;AT END OF LINE?
42300 CAIN C,15
42400 POPJ P, ;YES, STOP
42500 ALTCN1: PUSHJ P,GNCH1 ;GET A CHARACTER
42600 CAIE C,177 ;DO NOT LET HIM INSERT A RUBOUT
42700 CAIN C,12 ;IGNORE CRET
42800 JRST ALTCN1
42900 CAIE C,ALTMOD ;STOP ON ALTMODE AND LINE FEED
43000 CAIN C,15
43100 POPJ P,
43200 DPB C,ALTP ;REPLACE IT
43300 IBP ALTP ;ADVANCE POINTER
43400 AOS ALTCNT ;AND COUNT
43500 SOJG T2,ALTCN2 ;CONTINUE
43600 POPJ P,
43700 JOINA: PUSHJ P,OFFRUB
43800 PUSHJ P,FINDN ;GO SEE IF NEXT LINE IS REALLY THERE
43900 CAME T1,PGMK
44000 SKIPN T1
44100 JRST ILCER ;MAKE IT ILLEGAL IF NO LINE THERE
44200 MOVEM T1,LIBUF2 ;SAVE ITS NUMBER
44300 SETZM LIBUF2+1
44400 MOVE T1,[XWD LIBUF2+1,LIBUF2+2]
44500 BLT T1,LIBUF2+MXWPL+1 ;CLEAR OUT REST OF BUFFER
44600 PUSH P,ALTP ;SAVE POINTER TO THIS LINE
44700 ADD ALTP,[XWD 70000,0] ;BACK IT UP
44800 MOVE T2,[POINT 7,LIBUF2+1]
44900 MOVEI C,11
45000 MOVEI T1,6 ;COUNT THE CHARACTERS
45100 MOVLIN: IDPB C,T2
45200 ILDB C,ALTP
45300 CAIE C,15 ;END OF LINE?
45400 AOJA T1,MOVLIN ;KEEP COUNT
45500 MOVEI ALTP,1(PNTR) ;GET POINTER TO SECOND LINE
45600 HRLI ALTP,(<POINT 7,0,6>)
45700 TRN1: ILDB C,ALTP
45800 IDPB C,T2
45900 ADDI T1,1
46000 CAIL T1,MXWPL*5+6 ;CHECK SIZE
46100 JRST LTLER
46200 CAIE C,12
46300 JRST TRN1 ;NOT DONE YET
46400 EXCH T2,(P) ;SAVE OUTPUT POINTER AND GET OLD ALTP BACK
46500 SUBI ALTP,-1(PNTR) ;GET OLD COUNT OF SECOND LINE
46600 PUSH P,ALTP ;AND SAVE IT
46700 MOVEI C,15 ;FINISH CURRENT LINE
46800 DPB C,T2
46900 MOVEI C,12
47000 IDPB C,T2
47100 MOVEI C,0
47200 INSC2X: TLNN T2,760000
47300 JRST INSC3X ;FILL WITH NULLS
47400 IDPB C,T2
47500 JRST INSC2X
47600 INSC3X: SUBI T2,LIBUF-1 ;GET COUNT
47700 HRRZM T2,NCNT
47800 PUSHJ P,FINDB ;BACK UP TO POINT TO IT
47900 PUSHJ P,INSED
48000 PUSHJ P,FINDN
48100 PUSHJ P,FILLB
48200 POP P,OCNT ;OLD CONT
48300 HRRZS OCNT
48400 POP P,ALTP ;GET OUTPUT POINTER BACK
48500 SUBI ALTP,LIBUF2-1
48600 HRRZM ALTP,NCNT
48700 MOVE T1,[XWD LIBUF2,LIBUF]
48800 BLT T1,LIBUF+MXWPL+1
48900 PUSHJ P,INSED
49000 TRO FL2,ALTFLG ;MARK AS NEED TO DO FILLB
49100 MOVE T1,NCNT ;GET THE COUNT JUST USED
49200 MOVEM T1,OCNT ;AND SET AS THE OLD COUNT
49300 MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET UP
49400 SETZM ALTCNT
49500 TTCALL 3,ASCRLF
49600 MOVE T1,LIBUF
49700 MOVEM T1,CLN ;SET UP CURRENT LINE
49800 JRST OUTSN ;AND PRINT NUMBER
49900
50000 LTLER: RERROR LTL
50100 POP P,ALTP ;RESTORE ALTP
50200 SKIPA
50300 ILCER: RERROR NNN
50400 PUSHJ P,FINDB ;MOVE BACK TO RIGHT PLACE
50500 ERCOR: PUSH P,ALTCNT ;SAVE COUNT
50600 SETZM ALTCNT
50700 MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET BACK TO START
50800 PUSHJ P,ALTCBS ;PRINT LINE NUMBER
50900 POP P,T2 ;COUNT
51000 JUMPN T2,ALTSP ;AND SPACE OVER
51100 POPJ P, ;NO SPACES TO DO
51200 ALTBS: CAMN ALTP,[POINT 7,LIBUF+1,13] ;ARE WE AT START OF LINE
51300 JRST ALTCBS ;YES, GIVE CR/LF AND SEQ NUMBER
51400 ONRUB
51500 SUBI ALTP,1 ;BACKSPACE POINTER
51600 IBP ALTP
51700 IBP ALTP
51800 IBP ALTP
51900 ILDB C,ALTP
52000 PUSHJ P,OCHR
52100 SOS ALTCNT ;DECREASE COUNT
52200 SOJG T2,ALTBS ;MORE,MORE
52300 PUSHJ P,TTYOUT
52400 POPJ P,
52500
52600 ALTCBS: PUSHJ P,OFFRUB
52700 TTCALL 3,ASCRLF
52800 MOVE T1,LIBUF ;ALSO PRINT SEQ NUM
52900 JRST OUTSN
53000
53100 ALTLN: MOVEI T2,1000 ;FINISH PRINTING THE LINE
53200 PUSHJ P,ALTSP
53300 MOVE ALTP,[POINT 7,LIBUF+1,13] ;POINTER TO START
53400 SETZM ALTCNT ;RESET COUNT
53500 JRST ALTCBS ;AND PRETEND A BACKSPACE
00100 SUBTTL THE _ COMMAND
00200
00300 SET: PUSHJ P,SCAN ;GET THE THING TO SET TO
00400 TRNN FL,IDF ;MUST BE AN IDENT
00500 NERROR ILC
00600 PUSH P,ACCUM ;SAVE IT
00700 PUSHJ P,SCAN ;AND CHECK FOR TERMINATOR
00800 TRNN FL,TERMF
00900 NERROR ILC
01000 POP P,T1 ;SHOULD BE "UPPER" OR "LOWER"
01100 MOVNI T2,1 ;CHECK
01200 CAMN T1,[SIXBIT /UPPER/]
01300 MOVEI T2,0 ;USE 0 FOR UPPER CASE
01400 CAMN T1,[SIXBIT /LOWER/]
01500 MOVEI T2,40 ;AND 40 FOR LOWER
01600 SKIPGE T2 ;DID WE SET ONE OR THE OTHER
01700 JRST SET1 ;TEY FOR MODEL NUMBER
01800 MOVEM T2,CASEBT ;SET UP CASE
01900 JRST COMND
02000
02100 SET1: CAMN T1,[SIXBIT /M37/] ;MODEL 37?
02200 JRST SETM37
02300 CAMN T1,[SIXBIT /DPY/]
02400 JRST SETDPY
02500 CAMN T1,[SIXBIT /RUN/]
02600 JRST SETRUN
02700 CAMN T1,[SIXBIT /NOVICE/]
02800 JRST SETNOV
02900 CAMN T1,[SIXBIT /EXPERT/]
03000 JRST SETEXP
03100 CAMN T1,[SIXBIT /C128/]
03200 JRST QON
03300 CAMN T1,[SIXBIT /INC/]
03400 JRST SETINC
03500 CAMN T1,[SIXBIT /VERSIO/]
03600 JRST SETVRS
03700 CAMN T1,[SIXBIT/CHECK/]
03800 JRST SETCK
03900 CAMN T1,[SIXBIT/NOCHEC/]
04000 JRST CLRCK
04100 CAMN T1,[SIXBIT/BAK/]
04200 JRST SETBAK
04300 CAMN T1,[SIXBIT/NOBAK/]
04400 JRST CLRBAK
04500 IFDEF DEBFLG <ONOFF DEBUG,NODEB,DEBFLG,L,FL2>
04600 CAMN T1,[SIXBIT /C64/]
04700 JRST QOFF
04800 CAME T1,[SIXBIT /M33/] ;OR 33
04900 NERROR ILC ;LOSE
05000 TRZA FL,M37F ;MODEL 33
05100 SETM37: TRO FL,M37F
05200 TRZ FL,DPYF ;IN NEITHER CASE IS IT A DISPLAY
05300 JRST COMND
05400 SETDPY: TRZ FL,M37F ;NOT A MODEL 37
05500 TRO FL,DPYF ;BUT IS A DISPLAY
05600 JRST COMND
05700
05800 QON: TLZA FL,QMODF
05900 QOFF: TLO FL,QMODF
06000 JRST COMND
06100
06200 SETNOV: TRZA FL,EXTOG
06300 SETEXP: TRO FL,EXTOG
06400 JRST COMND
06500
06600 SETCK: TROA FL2,DSKCK
06700 CLRCK: TRZ FL2,DSKCK
06800 JRST COMND
06900
07000 SETBAK: TROA FL2,BAKFLG
07100 CLRBAK: TRZ FL2,BAKFLG
07200 JRST COMND
07300
07400 SETRUN: MOVEI T5,RPGR ;POINT TO RUN UUO BLOCK
07500 PUSHJ P,READNM ;FIND OUT WHERE TO GO
07600 NERROR ILC ;HE SAID SOMETHING WRONG
07700 TRNN FL,TERMF ;DID HE SAY ANYTHING EXTRA?
07800 NERROR ILC ;YES
07900 JRST COMND
08000
08100 SETINC: PUSHJ P,SCAN ;GET NUMBER
08200 TRNE FL,NUMF ;IS IT A NUMBER
08300 CAMN T1,[<ASCII /00000/>!1] ;0 INC IS A NO-NO
08400 NERROR ILC ;HE BLEW IT
08500 MOVEM T1,INCR ;SET THE INC
08600 PUSHJ P,SCAN ;GET THE TERMINATOR
08700 TRNN FL,TERMF ;WAS IT A TERMINATOR
08800 NERROR ILC ;HE BLEW IT AGAIN
08900 JRST COMND ;RETURN
09000
09100 SETVRS: OUTCHR ["V"]
09200 SETZB T1,T4
09300 VRS1: PUSHJ P,GNCH ;GET A CHARACTER
09400 JUMPE CS,VRS1 ;IGNORE TABS AND SPACES
09500 JUMPL CS,VRS2 ;CHECK FOR SPECIAL CHAR
09600 TLNE CS,SNUMFX ;NUMBER?
09700 JRST [ASH T1,3
09800 ANDI CS,7
09900 ADD T1,CS
10000 DPB T1,[POINT 9,T4,11]
10100 JRST VRS1] ;GET ANOTHER
10200 TLNE CS,TERMX ;IS IT A TERMINATOR?
10300 JRST OVRS
10400 TLNN CS,LETFX ;MUST BE A LETTER
10500 NERROR FORM
10600 SUBI C,100 ;CONVERT TO OCTAL
10700 DPB C,[POINT 6,T4,17]
10800 PUSHJ P,GNCH ;GET A CHAR
10900 VRS2: JUMPE CS,.-1
11000 TLNE CS,TERMX
11100 JRST OVRS
11200 CAIE C,"("
11300 NERROR FORM
11400 MOVEI T1,0
11500 VRS3: PUSHJ P,GNCH ;GET A CHAR
11600 JUMPE CS,VRS3
11700 JUMPL CS,VRS4
11800 TLNE CS,TERMX ;TERMINATOR?
11900 JRST OVRS
12000 TLNN CS,SNUMFX ;NUMBER?
12100 NERROR FORM
12200 ASH T1,3
12300 ANDI CS,7
12400 ADD T1,CS
12500 HRRM T1,T4 ;SAVE THE EDIT NUMBER
12600 JRST VRS3
12700 VRS4: CAIE C,")"
12800 NERROR FORM
12900 PUSHJ P,GNCH
13000 JUMPE CS,.-1
13100 TLNE CS,TERMX
13200 JRST OVRS
13300 CAIE C,"-"
13400 NERROR FORM
13500 PUSHJ P,GNCH
13600 JUMPE CS,.-1
13700 TLNN CS,SNUMFX
13800 NERROR FORM
13900 ANDI CS,7
14000 DPB CS,[POINT 3,T4,2]
14100 PUSHJ P,GNCH
14200 JUMPE CS,.-1
14300 TLNN CS,TERMX
14400 NERROR FORM
14500 OVRS: MOVEM T4,ORGVRS ;SAVE THE VERSION NUMBER
14600 TLO FL2,NOINCV ;DON'T INCREMENT VERSION
14700 JRST COMND
00100 SUBTTL = COMMAND
00200
00300 GIVE: PUSHJ P,SCAN ;FIND OUT WHAT HE WANTS TO KNOW
00400 CAIN C,"." ;CURRENT LINE/PAGE?
00500 JRST GVDOT ;YES
00600 TRNN FL,IDF ;IF NOT, MUST BE AN IDENT
00700 NERROR ILC
00800 PUSH P,ACCUM ;SAVE IT
00900 PUSHJ P,SCAN ;CHECK FOR TERM
01000 TRNN FL,TERMF
01100 NERROR ILC
01200 POP P,T1 ;NOW FIND OUT WHAT HE WANTS
01300 CAMN T1,[SIXBIT /ERROR/]
01400 JRST GIVER
01500 CAMN T1,[SIXBIT/DSK/]
01600 JRST GIVDSK
01700 CAMN T1,[SIXBIT/BAK/]
01800 JRST GIVBAK
01900 CAMN T1,[SIXBIT/CHECK/]
02000 JRST GIVECK
02100 CAMN T1,[SIXBIT /VERSIO/]
02200 JRST GETVRS
02300 CAMN T1,[SIXBIT/SUBS/]
02400 JRST GIVSUB
02500 CAMN T1,[SIXBIT/COMNDS/]
02600 JRST GIVCOM
02700 CAMN T1,[SIXBIT /CASE/]
02800 JRST GVCASE
02900 CAMN T1,[SIXBIT /STRING/] ;DOES HE WANT STRINGS?
03000 JRST GVSTR
03100 CAMN T1,[SIXBIT /INC/]
03200 JRST GVINC ;CURRENT INCREMENT
03300 CAME T1,[SIXBIT /BIG/]
03400 NERROR ILC ;NOTHING
03500 TRNE FL,BGSN ;HAVE WE SEEN THAT PAGE
03600 JRST GVBG1 ;YES, ALL IS OK
03700 MOVSI T1,1 ;WILL HAVE TO SEARCH FOR IT
03800 MOVEM T1,DPG
03900 MOVEI SINDEX,0
04000 PUSHJ P,FIND
04100 TRNN FL,BGSN ;SHOULD HAVE SEEN IT NOW
04200 ERROR ICN ;WE ARE IN TROUBLE
04300 GVBG1: MOVE T1,BGPG ;GET IT
04400 GIV2: MOVEI T3,OCHR ;ROUTINE FOR DECIMAL PRINTER TO OUTPUT TO
04500 PUSHJ P,DECPR ;PRINT DECIMAL
04600 PUSHJ P,TTYOUT ;FORCE OUTPUT
04700 GIV1: TTCALL 3,ASCRLF
04800 JRST COMND
04900
05000 GVCASE: TRNE FL,DPYF
05100 TTCALL 3,[ASCIZ /DISPLAY /]
05200 TRNE FL,M37F
05300 TTCALL 3,[ASCIZ /MODEL 37 /]
05400 TLNE FL,QMODF
05500 TTCALL 3,[ASCIZ /C64 /]
05600 MOVEI T1,[ASCIZ /LOWER
05700 /]
05800 SKIPN CASEBT
05900 MOVEI T1,[ASCIZ/UPPER
06000 /]
06100 TTCALL 3,(T1)
06200 JRST COMND
06300
06400 GETVRS: OUTSTR [ASCIZ "V"]
06500 LDB T2,[POINT 9,ORGVRS,11]
06600 PUSHJ P,OPRNT
06700 LDB T2,[POINT 6,ORGVRS,17]
06800 JUMPE T2,.+3
06900 ADDI T2,100
07000 OUTCHR T2
07100 OUTCHR ["("]
07200 HRRZ T2,ORGVRS
07300 PUSHJ P,OPRNT
07400 OUTCHR [")"]
07500 LDB T2,[POINT 3,ORGVRS,2]
07600 JUMPE T2,.+3
07700 OUTCHR ["-"]
07800 PUSHJ P,OPRNT
07900 OUTSTR ASCRLF
08000 JRST COMND
08100
08200 GIVER: SKIPN T1,SVERN
08300 JRST COMND
08400 TTCALL 3,@ETBL2-1(T1)
08500 JRST COMND
08600
08700 GIVDSK: PUSHJ P,TELDSK
08800 JRST COMND
08900
09000 GIVECK: TRNN FL2,DSKCK
09100 TTCALL 3,[ASCIZ/NO /]
09200 TTCALL 3,[ASCIZ/DISK CHECK
09300 /]
09400 JRST COMND
09500
09600 GIVBAK: TRNN FL2,BAKFLG
09700 TTCALL 3,[ASCIZ/NO /]
09800 TTCALL 3,[ASCIZ/BACKUP (*.BAK) FILE WILL BE LEFT BEHIND
09900 /]
10000 JRST COMND
10100
10200 GIVSUB: MOVE T2,SAVCNT ;SUPPOSEDLY SET DURING LAST SUB
10300 PUSHJ P,DPRNT ;TYPE IT OUT
10400 TTCALL 3,[ASCIZ/ SUBSTITUTION LINE(S) SINCE THE LAST S COMMAND
10500 /]
10600 JRST COMND
10700
10800 GIVCOM: MOVE T2,COMNDS ;RESET AT LAST WRAP-AROUND
10900 PUSHJ P,DPRNT ;TYPE IT OUT
11000 TTCALL 3,[ASCIZ/ COMMANDS NOT YET SAVED ON THE DISK
11100 /]
11200 JRST COMND
11300
11400 GVINC: MOVE T1,INCR ;GET CURRENT INCREMENT
11500 PUSHJ P,OUTSN ;GO PRINT IT
11600 JRST GIV1 ;AND A CRRET
11700
11800 GVDOT: PUSHJ P,SCAN ;SEE IF A TERMINATOR IS THERE
11900 TRNN FL,TERMF
12000 NERROR ILC ;NO TERMINATOR
12100 MOVE T1,CLN ;GET CURRENT LINE
12200 PUSH P,T2
12300 MOVSI T2,(ASCII ./.) ;JUST A SLASH
12400 TTCALL 3,T1
12500 POP P,T2 ;RESTORE
12600 MOVE T1,CPGL ;AND CURRENT PAGE
12700 JRST GIV2 ;|O TO IT
12800
12900 DECPR: IDIVI T1,^D10 ;THE USUAL DECIMAL PRINTER
13000 HRLM T2,(P)
13100 SKIPE T1
13200 PUSHJ P,DECPR
13300 HLRZ C,(P)
13400 ADDI C,"0"
13500 JRST (T3) ;EXCEPT HAS ARBITRARY OUTPUT ROUTINE
13600
13700 GVSTR: MOVEI T1,SRPNT ;GET THE POINTER TO POINTER BLOCK
13800 HRLI T1,-SRNUM ;SET COUNT
13900 TTCALL 3,[ASCIZ / SEARCH:
14000 /]
14100 PUSHJ P,GVSTR3
14200 TTCALL 3,[ASCIZ/ EXPAND:
14300 /]
14400 MOVE T2,[POINT 7,XPSTR]
14500 SETZM T1
14600 PUSHJ P,GVSTR2 ;TELL HIM
14700 MOVEI T1,R2PNT
14800 HRLI T1,-SRNUM
14900 TTCALL 3,[ASCIZ / SUBSTITUTE:
15000 /]
15100 PUSHJ P,GVSTR3
15200 MOVEI T1,R1PNT
15300 HRLI T1,-SRNUM
15400 TTCALL 3,[ASCIZ / FOR:
15500 /]
15600 PUSHJ P,GVSTR3
15700 JRST COMND
15800
15900 GVSTR3: SKIPN T2,(T1) ;IS THERE ONE THERE?
16000 POPJ P, ;NO, DONE
16100
16200 GVSTR2: ILDB C,T2 ;NEXT CHR
16300 JUMPE C,GVSTR1 ;DONE
16400 PUSHJ P,OCHR ;PRINT IT
16500 JRST GVSTR2 ;AND CONTINUE
16600 GVSTR1: PUSHJ P,TTYOUT ;CLEAR OUTPUT DEVICE
16700 TTCALL 3,ASCRLF
16800 AOBJN T1,GVSTR3 ;IF THERE IS ONE
16900 POPJ P,
17000
00100 SUBTTL LIST COMMAND
00200
00300 LIST: PUSHJ P,SCAN ;GET SOME INFORMATION
00400 TRNN FL,TERMF ;JUST A TERMINATOR
00500 JRST LIST7 ;NO, GO LOOK FOR A COMMAND STRING
00600 MOVEI T1,1 ;LIST ENTIRE FILE
00700 MOVEM T1,LOPG
00800 MOVSI T1,1 ;FROM 1 TO IMPOSSIBLY HIGH
00900 MOVEM T1,HIPG
01000 TRZ FL,CNTF ;MAKE SURE THAT THIS FLAG IS OFF
01100 JRST LIST8 ;GO START WORK
01200
01300 LIST7: PUSHJ P,GET2 ;HAVE ALREADY SCANNED, GET 2 NUMBERS
01400 TRNN FL,TERMF ;END OK?
01500 NERROR ILC
01600 LIST8: TRZ FL,LINSN ;NONE SEEN YET
01700 MOVEI T1,0 ;MODE 0
01800 MOVE T2,ORGDEV ;DEVICE
01900 MOVSI T3,LOBUF ;BUFFER
02000 INIT LPT,0
02100 SIXBIT /LPT/
02200 XWD LOBUF,0
02300 SKIPA ;TRY DSK IF ERROR
02400 JRST .+3 ;NO ERROR
02500 OPEN LPT,T1
02600 NERROR UNA ;CAN NOT GET IT
02700 MOVEI T1,LPTBUF ;ADDRESS OF THE BUFFER
02800 EXCH T1,.JBFF ;INTO .JBFF
02900 MOVEM T1,LPTFFS ;AND SAVE OLD .JBFF
03000 OUTBUF LPT,1 ;FIRST, ASK FOR 1 BUFFER
03100 MOVEI T2,LPTBUF
03200 EXCH T2,.JBFF ;RESET .JBFF TO LPTBUF & NEW .JBFF IN T2
03300 SUBI T2,LPTBUF ;FIND OUT HOW MUCH SPACE FOR BUFFER
03400 MOVEI T1,203*2+1 ;SPACE ALLOWED FOR BUFFERS
03500 IDIV T1,T2 ;THIS IS HOW MANY BUFFERS WILL FIT
03600 OUTBUF LPT,(T1) ;ASK FOR THAT MANY
03700 MOVE T1,LPTFFS ;FINALLY, RESTORE OLD
03800 MOVEM T1,.JBFF ;OLD JOB FF
03900 MOVE T1,ORGNAM
04000 MOVSI T2,(SIXBIT/LPT/)
04100 SETZB T3,T4
04200 ENTER LPT,T1
04300 NERROR UNA
04400 MOVE T1,[XWD PGHS,PGHD] ;GET A COPY OF THE BLANK HEADER
04500 BLT T1,PGHD+7
04600 MOVE C,[POINT 7,PGHD,27] ;START TO FILL IT
04700 MOVE T2,ORGNAM ;USE THE ORIGINAL NAME
04800 PUSHJ P,PRTSX1 ;PUT IT IN THE HEADER
04900 SKIPN T2,ORGEXT ;GET THE EXTENSION
05000 JRST LIST1 ;NONE THERE, IGNORE
05100 MOVEI T1,"." ;A DOT BETWEEN
05200 IDPB T1,C
05300 PUSHJ P,PRTSX1
05400 LIST1: MOVE ALTP,[POINT 7,PGHD+3] ;TIME+DATE (ALTP IS FREE)
05500 DATE T1,
05600 IDIVI T1,^D31 ;LEAVES DAY IN T2
05700 PUSH P,T2 ;SAVE IT
05800 IDIVI T1,^D12 ;LEAVES MONTH IN T2 YEAR IN T1
05900 EXCH T1,(P) ;INVERT ORDER OF DAY AND YEAR
06000 PUSH P,T1 ;AND SAVE
06100 MOVEI T1,1(T2) ;GET MONTH (MUST ADD 1)
06200 MOVEI T3,HDOCH ;PLACE FOR DECPR TO PUT THINGS
06300 PUSHJ P,DECPR
06400 MOVEI T1,"-" ;SEPERATE
06500 IDPB T1,ALTP
06600 POP P,T1 ;THE DAY
06700 ADDI T1,1
06800 PUSHJ P,DECPR ;PRINT IT TOO
06900 MOVEI T1,"-"
07000 IDPB T1,ALTP
07100 POP P,T1 ;THE YEAR
07200 ADDI T1,^D64 ;CONVERT TO REAL YEAR
07300 PUSHJ P,DECPR
07400 IBP ALTP ;SKIP OVER A SPACE
07500 MSTIME T1, ;TIME IN MILLISECONDS
07600 IDIVI T1,^D60000 ;CONVERT TO MINUTES
07700 IDIVI T1,^D60 ;NOW TO HOURS
07800 PUSH P,T2 ;SAVE MINUTES
07900 PUSHJ P,DECPR ;PRINT
08000 MOVEI T1,":"
08100 IDPB T1,ALTP
08200 POP P,T1 ;GET MINUTES BACK
08300 MOVEI T2,"0" ;MAKE SURE THERE ARE 2 DIGITS
08400 CAIG T1,^D9
08500 IDPB T2,ALTP
08600 PUSHJ P,DECPR
08700 SETZM LOGPG ;LOGICAL PAGE TO 0
08800 MOVE T1,LOPG ;GET SET TO PRINT
08900 MOVEM T1,DPG
09000 MOVE SINDEX,LOLN
09100 PUSHJ P,FIND ;GO FIND IT
09200 SETZM LSTCNT ;COUNT OF NUMBER OF LINES PER PAGE
09300 LST2: PUSHJ P,ONMOV ;CHECK RANGE
09400 JRST LST6 ;FINISH UP
09500 TRO FL,LINSN ;YEP, WE HAVE SEEN ONE
09600 CAMN T1,PGMK ;CHECK FOR PAGE MARK AND HANDLE SPECIAL
09700 JRST LST4
09800 MOVEM T1,CLN ;THE CURRENT LINE
09900 MOVEI T2,0 ;COUNT OF NUMBER OF CHRS SEEN
10000 SOSG LSTCNT ;CHECK TO SEE IF RUN OUT
10100 PUSHJ P,HDPRNT ;AND PRINT HEADING
10200 MOVE T1,PNTR ;GET THE POINTER
10300 HRLI T1,(<POINT 7,0>) ;AND SET UP BYTE POINTER
10400 LST3: ILDB C,T1 ;GET CHR
10500 CAIGE C,11
10600 JRST NSPEC1
10700 CAIGE C,15
10800 JRST SPHD
10900 CAIN C,15
11000 JRST LST5
11100 CAIGE C,40
11200 JRST NSPEC1
11300 CAIN C,77 ;SPECIAL FO QUESTION MARK
11400 JRST NSPEC1
11500 CAIGE C,140
11600 JRST LST5
11700 NSPEC1: PUSH P,C
11800 MOVEI C,"'"
11900 PUSHJ P,POCHR
12000 ADDI T2,1
12100 POP P,C
12200 LDB C,[POINT 7,CTBL(C),10]
12300 LST5: PUSHJ P,POCHR ;PRINT IT
12400 AOJA T2,LST3 ;COUNT AND CONTINUE
12500
12600 SPHD: CAIN C,12 ;LINE FEED IS END OF LINE
12700 JRST [PUSHJ P,POCHR ;PRINT IT
12800 PUSHJ P,FINDN ;GET NEXT
12900 JRST LST2] ;AND GO
13000 CAIN C,11 ;COUNT SPECIAL FOR TAB
13100 JRST [ADDI T2,10
13200 ANDCMI T2,7
13300 PUSHJ P,POCHR
13400 JRST LST3]
13500 CAIN C,14
13600 JRST [PUSHJ P,POCHR ;FORM FEED GETS A HEADING
13700 PUSHJ P,HDPRNT
13800 JRST LST3]
13900 CAIN C,"\" ;NEEDS DELETE,DELETE
14000 JRST [MOVEI C,177
14100 PUSHJ P,POCHR
14200 JRST LST5] ;AND AGAIN
14300 CAIE C,13 ;VERT.TAB
14400 ERROR ICN ;CONFUSED
14500 PUSHJ P,POCHR
14600 MOVE T3,LSTCNT
14700 CAIG T3,<%LPP+2>/3
14800 JRST [PUSHJ P,HDPRNT
14900 JRST LST3]
15000 CAIG T3,<2*<%LPP+2>>/3
15100 MOVEI T3,<%LPP+2>/3
15200 CAIL T3,<2*<%LPP+2>>/3
15300 MOVEI T3,<2*<%LPP+2>>/3
15400 MOVEM T3,LSTCNT
15500 JRST LST3
15600
15700 LST4: AOS T1,CPG ;GET PAGE CORRECTLY
15800 MOVEM T1,CPGL
15900 SETZB T2,LOGPG ;ZERO LOGICAL PAGE AGAIN
16000 PUSHJ P,HDPRNT ;PRINT A HEADER
16100 AOS LSTCNT ;INCREASE BY 1 TO MAKE IT COME OUT RIGHT
16200 PUSHJ P,FINDN ;ADVANCE
16300 JRST LST2 ;AND CONTINUE
16400
16500 LST6: RELEAS LPT,0 ;GET RID OF IT
16600 TRNN FL,LINSN ;WERE ANY SEEN?
16700 NERROR NLN ;NO, ERROR
16800 MOVE T1,CPG ;SET UP PAGE
16900 MOVEM T1,CPGL
17000 JRST COMND ;AND GET MORE COMMANDS
17100
17200 POCHR: SOSG LOBUF+2 ;ROOM FOR MORE?
17300 OUTPUT LPT,0
17400 IDPB C,LOBUF+1
17500 POPJ P,
17600
17700 HDPRNT: PUSH P,T1 ;SAVE POINTER
17800 MOVEI C,15 ;GET TO LEFT OF PAGE
17900 PUSHJ P,POCHR
18000 MOVE T1,[POINT 7,PGHD] ;GET SET TO PRINT HEADER
18100 HDPR1: ILDB C,T1 ;GET A CHARACTER
18200 JUMPE C,HDPR2 ;DONE?
18300 PUSHJ P,POCHR ;PRINT IT
18400 JRST HDPR1 ;CONTINUE
18500
18600 HDPR2: PUSH P,T2 ;SAVE CHARACTER COUNT
18700 MOVE T1,CPG ;GET CURRENT PAGE
18800 MOVEI T3,POCHR ;WHERE TO PRINT IT
18900 PUSHJ P,DECPR ;PRINT
19000 MOVEI C,"-"
19100 PUSHJ P,POCHR
19200 AOS T1,LOGPG ;GET NEXT LOGICAL PAGE
19300 PUSHJ P,DECPR
19400 MOVEI C,15 ;NOW RET AND 2 LFDS
19500 PUSHJ P,POCHR
19600 MOVEI C,12
19700 PUSHJ P,POCHR
19800 PUSHJ P,POCHR
19900 MOVEI T1,%LPP ;RESET LINE COUNT
20000 MOVEM T1,LSTCNT
20100 POP P,T2 ;GET BACK COUNT OF CHRS
20200 JUMPE T2,TPOPJ1 ;IF 0 THEN ALL OK
20300 MOVE T3,T2 ;GET COPY
20400 MOVEI C," " ;PRINT CORRECT NUMBER OF SPACES
20500 PUSHJ P,POCHR
20600 SOJG T3,.-1
20700 TPOPJ1: POP P,T1 ;RESTORE POINTER
20800 POPJ P,
20900
21000 PRTSX: MOVEI T1,0 ;SET TO RECIEVE A CHR
21100 LSHC T1,6 ;GQT ONE
21200 ADDI T1,40 ;CONVERT
21300 IDPB T1,C ;PUT IN HEADER
21400 PRTSX1: JUMPN T2,PRTSX ;ONLY SPACES LEFT?
21500 POPJ P, ;RETURN
21600
21700 HDOCH: IDPB C,ALTP ;PUT CHRS FROM DECPR INTO HEADER
21800 POPJ P,
00100 SUBTTL REPLACE COMMAND
00200
00300 REPLAC: TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
00400 NERROR ILC
00500 SETZM INCRX
00600 PUSHJ P,GET2S ;WHAT DO WE WANT TO REPLACE?
00700 CAIE C,"," ;HE CAN SPECIFY INCREMENT TOO
00800 JRST REPLA1 ;BUT HE DIDN'T, LOOK FOR TERMINATOR
00900 PUSHJ P,SCAN ;GET INCR
01000 TRNE FL,NUMF ;WHICH MUST BE A NUMBER
01100 CAMN T1,[<ASCII /00000/>!1] ;NOT 0 FOR INCR
01200 NERROR ILC
01300 MOVEM T1,INCRX
01400 PUSHJ P,SCAN ;SCAN PAST
01500 REPLA1: MOVE T1,INCR
01600 SKIPN INCRX
01700 MOVEM T1,INCRX
01800 TRNN FL,PGSN ;WAS A SECOND PAGE GIVEN?
01900 TRNN FL,TERMF ;OR PERHAPS NO TERMINATOR
02000 NERROR ILC
02100 MOVE T1,LOPG ;FIND START OF THE WORLD
02200 MOVEM T1,DPG
02300 MOVE SINDEX,LOLN
02400 PUSHJ P,FIND ;WE WILL ALSO USE LOLN FOR START OF INSERT
02500 SKIPN LOLN ;IN CASE HE SAID /A OR SOMETHING
02600 MOVEM T1,LOLN ;USE START OF PAGE
02700 MOVE T2,CPG ;GET CURRENT PAGE
02800 CAME T2,LOPG ;AND FIND OUT IF ITS THE ONE WE WANT
02900 NERROR NSP
03000 NEXT: CAME T1,PGMK ;PAGE MARK STOPS THE WORLD
03100 PUSHJ P,ONMOV ;CHECK RANGE
03200 JRST GOINS ;OUT OF THINGS TO DELETE, INSERT
03300 MOVEM T1,LASDEL ;NUMBER OF THE LAST LINE DELETED
03400 PUSHJ P,DODEL ;DELETE A LINE
03500 SKIPE T1,(PNTR) ;ARE WE AT END OF BUFFER
03600 JRST NEXT ;NO
03700 NEXT1: MOVE T1,WC ;SEE IF ROOM TO INSERT
03800 ADD T1,BUFP
03900 CAML T1,FILPT
04000 JRST NXTBF ;TOO FULL, GET NEXT BUFFER AND DELETE
04100 MOVE T1,LOLN ;THE LINE TO INSERT
04200 CAML T1,LASDEL ;ONLY IF SMALLER THAN LAST DELETED
04300 JRST NXTBF
04400 SETZM OCNT ;INSERT A FRESH LINE
04500 MOVEM T1,LIBUF
04600 PUSHJ P,OUTSN
04700 PUSHJ P,RDLIN ;GET ONE
04800 JRST FINDL ;LINE TOO LONG ERROR
04900 MOVEM T1,NCNT ;SET UP NEW COUNT
05000 PUSHJ P,INSED ;INSERT
05100 PUSHJ P,FINDZ ;GET NEXT LINE, BUT NOT IN NEW BUFFER
05200 MOVE T1,CPG ;SET UP .
05300 MOVEM T1,CPGL
05400 MOVE T1,LOLN
05500 MOVEM T1,CLN
05600 MOVE T2,INCRX ;FIND NEXT LINE
05700 PUSHJ P,ASCIAD
05800 CAMG T1,INCRX ;CHECK FOR WRAP AROUND
05900 JRST FINDEL
06000 MOVEM T1,LOLN ;AND SAVE IT
06100 JRST NEXT1 ;CHECK TO SEE IF INSERT OR DELETE IN ORDER
06200
06300 DODEL: SETZM NCNT ;NEW IS 0
06400 PUSHJ P,GETLTH ;OLD LENGTH
06500 MOVEM T1,OCNT
06600 JRST INSED ;GO INSERT AND RETUNR
06700
06800 GOINS: SKIPE T2,LOLN ;IS THERE REALLY ONE THERE?
06900 CAMN T2,PGMK
07000 JRST COMND ;TRIED TO REPLACE BLANK PAGE
07100 MOVEM T2,HILN ;SET UP FOR INSERT
07200 JRST ENTINS ;AND JUMP INTO THE MIDDLE OF IT
07300
07400 FINDL: MOVE T1,LOLN
07500 MOVEM T1,CURINS
07600 MOVE T1,CPG
07700 MOVEM T1,IPG
07800 FINDEL: PUSHJ P,FINDN1 ;GET THE NEXT LINE
07900 CAME T1,PGMK ;QUIT IF PAGE MARK
08000 PUSHJ P,ONMOV ;OR IF OUT OF RANGE
08100 JRST LEVINS
08200 PUSHJ P,DODEL ;DELETE IT
08300 JRST FINDEL
08400
08500 NXTBF: PUSHJ P,FINDN1 ;GET TO A NEW BUFFER IF NECESSARY
08600 JRST NEXT ;AND PROCEED TO NEXT
08700
00100 SUBTTL COMMON SEARCH ROUTINES FOR F AND S
00200
00300 ; ! SOME COMMON ROUTINES FOR SEARCHING FILES!
00400 ; ! THIS ROUTINE GENERATES CODE FOR FINDING A MATCH
00500 ;FOR THE FIRST CHARACTER OF A SEARCH STRING. THE POINTER
00600 ;TO A SET OF BYTE POINTERS FOR SEARCH STRINGS IS IN T1 !
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 READCH: 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,16 ;"')"ARBITRARY NUMBER OF SOMETHING
02100 JRST ARBIT.
02200 CAIN C,24 ;"'/" ANY CHARACTER
02300 JRST ANY
02400 CAIN C,5 ;"'%" NOT THIS ONE
02500 JRST [TLC FL,NEGF
02600 TLO FL,DEMCHR ;WE REALLY JEED IT
02700 JRST READCH]
02800 CAIN C,174 ;"':" SEPERATOR
02900 JRST SEP.
03000 CAIN C,36 ;"'7" 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,LETFX ;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,[<CAIN 40>-<CAIE>] ;AND TEST FOR OTHER CASE
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 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,
05100
05200 SEP.: MOVE C,[SKIPG CS,CTBL(C)] ;GET BITS
05300 MOVEM C,(T2)
05400 MOVE C,[TRNE CS,NSEPF] ;CHECK FOR %,$,OR .
05500 MOVEM C,1(T2)
05600 TLNE FL,NEGF ;SKIPA IN NORMAL CASE
05700 JRST COMXCT
05800 GENSKP: MOVSI C,(<SKIPA>)
05900 MOVEM C,2(T2)
06000 AOJA T2,COMXCT ;SO XCT WILL GO IN RIGHT PLACE
06100
06200 QUOTE: ILDB C,T3 ;GET NEXT CHR
06300 JUMPE C,[NERROR ISS] ;END OF STRING IS ILLEGAL
06400 JRST COMLET ;TREAT AS NORMAL CHARACTER
06500
06600 NORMCR: HRLI C,(<CAIN C,>) ;EXACT OR NOT LETTER
06700 TLNE FL,NEGF
06800 TLC C,(<CAIN>-<CAIE>) ;USE OTHER TEST - SIGN WAS AN XOR
06900 NORMC1: MOVEM C,(T2)
07000 SOJA T2,COMXCT ;MAKE THE XCT GO IN RIGHT PL@CE
07100
07200 ANY: MOVE C,[CAIE C,15] ;'%'/ IS 15
07300 TLNE FL,NEGF
07400 TLC C,(<CAIN>-<CAIE>) ;- SIGN WAS AN XOR OPERATION IN FAIL
07500 JRST NORMC1
07600
07700 ARBIT.: ILDB C,T3 ;GET NEXT
07800 CAIN C,"" ;JUST CHECK VALIDITY
07900 JRST ARBIT.
08000 CAIN C," "
08100 ILDB C,T3
08200 JUMPE C,[NERROR ISS] ;END OF STRING ERROR
08300 JRST READCH ;LOOK FOR FIRST OTHER CHR
08400
08500 JSPR: JSP T1,SRCRET ;CALL CONTINUE SEARCH
08600
08700 ;READ INTHE STRING TO SEARCH FOR
08800 ;T3 HAS PLACE TO PUT POINTERS T1 A BYTE POINTER FOR STRINGS
08900
09000 SSTRNG: MOVEI T2,SRBLG ;THE PERMISSIBLE LENGTH
09100 HRLI T3,-SRNUM ;T3 HAS POINTER TO PLACE BYTE POINTERS
09200 SSTR0: MOVEM T1,SVPT ;SAVE THE POINTER FOR END OF STRING
09300 SSTR1: PUSHJ P,GNCH ;GET A CHR
09400 CAIN C,ALTMOD ;ALTMODE TERMINATES
09500 JRST SSTEND
09600 CAIN C,15 ;IGNORE RETURNS
09700 JRST SSTR1
09800 CAIN C,12 ;LINE FEED IS END OF ONE STRING
09900 JRST SSTR2
10000 IDPB C,T1 ;PUT IN OUTPUT STRING
10100 SOJG T2,SSTR1
10200 SSTR3: RERROR STL ;THE STRING WAS TOO LONG
10300 SSTR4: HRLZ T1,T3 ;ZERO OUT FIRST POINTER
10400 MOVNS T1
10500 ADDI T1,-SRNUM(T3) ;FIND START
10600 SETZM (T1)
10700 JRST COMND
10800
10900 SSTR2: CAMN T1,SVPT ;NULL STRING?
11000 JRST [HLRZ C,T3 ;FIRST ONE?
11100 CAIE C,-SRNUM ;WELL?
11200 JRST .+1 ;NO
11300 MOVEI C,12 ;RETURN A LINE FEED
11400 POPJ P,]
11500 RETSTR: MOVEI C,0 ;TERMINATE STRING WITH 0
11600 IDPB C,T1
11700 SOJLE T2,SSTR3
11800 MOVE C,SVPT ;SET UP POINTER
11900 MOVEM C,(T3)
12000 AOBJN T3,SSTR0 ;IF ROOM FOR MORE, GET THEM
12100 RERROR TMS ;TOO MANY GIVEN
12200 JRST SSTR4
12300
12400 SSTEND: CAIN T2,SRBLG ;DID WE SEE ANY?
12500 POPJ P, ;NO, RETURN
12600 MOVEI C,0 ;YES, TERMINATE LAST
12700 IDPB C,T1
12800 MOVE T1,SVPT
12900 MOVEM T1,(T3) ;SET POINTER
13000 SSTR5: AOBJP T3,CPOPJ1 ;ZERO OUT OTHER POINTERS
13100 SETZM (T3)
13200 JRST SSTR5
13300
13400 ;THE SEARCH ITSELF
13500
13600 COMSRC: MOVEM T2,BUFSAV ;SAVE THE POINTER TO STRINGS
13700 MOVNI T3,1 ;THE COUNT OF HOW FAR INTO LINE WE ARE
13800 MOVEI ALTP,1(PNTR) ;SET BYTE POINTER
13900 HRLI ALTP,(<POINT 7,0,6>)
14000 MOVEI C,15 ;START WITH A LINE DELIMITER
14100 JRST CODEBF ;GO SCAN
14200 COMSRT: ILDB C,ALTP ;WE RETURN HERE IF NO MATCH FOR THIS ONE
14300 CAIE C,15 ;DONE?
14400 AOJA T3,CODEBF ;NO, GO ON
14500 POPJ P, ;YES, NON-MATCH RETUNR
14600
14700 SRCRET: PUSH P,T1 ;SAVE THE RETURN ADDRESS
14800 PUSH P,ALTP ;AND THE STRING POINTER
14900 PUSH P,C ;AND THE CHARACTER
15000 LDB T1,[POINT 4,-1(T1),12] ;GET STRING NUMBER
15100 ADD T1,BUFSAV ;POINT TO BYTE POINTER
15200 SKIPN T1,(T1) ;GET IT
15300 ERROR ICN ;THERE SHOULD BE ONE THERE
15400 MOVE T2,[POINT 7,ARBBUF] ;SET UP ARBIT MATCH
15500 MOVEI T4,MXWPL*^D10 ;POINTER AND COUNT
15600 SETZM ARBCNT ;THE NUMBER OF ARBITRARY MATCHES SEEN
15700 TLZ FL,ARBITG ;OFF AT START
15800 PUSHJ P,LINMAT ;GO CHECK FOR MATCH
15900 JRST LOSE ;WE LOSE, CONTINUE SCAN
16000 MOVEM ALTP,SRCALP ;POINTER TO END OF STRING
16100 POP P,C ;RESTORE
16200 POP P,ALTP
16300 POP P,T1
16400 CPOPJ1: AOS (P) ;SKIP RETURN
16500 POPJ P,
16600
16700 LOSE: POP P,C ;RESTORE
16800 POP P,ALTP
16900 POPJ P, ;AND CONTINUE SEARCH
17000
17100 NXTCHR: CAIN C,12 ;WAS THAT LAST OF LINE?
17200 POPJ P, ;YES, LOSE
17300 ILDB C,ALTP ;NO, TRY NEXT
17400 LINMAT: PUSHJ P,CHRMAT ;CHECK FOR MATCH
17500 POPJ P, ;NONE, RETURN
17600 CAIE CS,0 ;IS SO ALL DONE
17700 JRST NXTCHR ;NO, TRY MORE
17800 JRST CPOPJ1 ;SKIP RETURN
17900
18000 CHRMAT: TLZ FL,NEGF+DEMCHR ;NO SEEN AND CHR CAN BE 0
18100 REDCH1: ILDB CS,T1 ;GET NEXT
18200 JUMPE CS,MATCH ;END OF STRING IS USUALLY GOOD
18300 CAIN CS,5 ;CHEC FOR NEGATE
18400 JRST [TLC FL,NEGF
18500 TLO FL,DEMCHR ;MUST BE FOLLOWED BY A CHR
18600 JRST REDCH1]
18700 CAIN CS,174 ;SEPERATOR?
18800 JRST SEP
18900 CAIN CS,16 ;ARBITRARY NUMBER
19000 JRST ARBIT
19100 CAIN CS,24 ;"'/"ANY?
19200 JRST ANY.
19300 CAIN CS,36 ;QUOTE NEXT?
19400 JRST [ILDB CS,T1
19500 JUMPN CS,.+1 ;MUST HAVE ONE THERE
19600 NERROR ISS] ;ELSE ILLEGAL
19700 CAMN C,CS ;ARE THEY THE SAME
19800 JRST ISTRU1 ;YES, CHECK NEGF
19900 MOVE T5,CTBL(CS) ;GET BITS
20000 TLNN FL,EXCTS1!EXCTSR ;EXACT?
20100 TLNN T5,LETFX ;OR NOT LET
20200 JRST ISFALS ;NO MATCH
20300 XORI CS,40 ;CHECK OTHER CASE
20400 CAMN C,CS
20500 JRST ISTRU1
20600 JRST ISFALS ;LOSE
20700
20800 MATCH: TLNE FL,DEMCHR ;DID WE NEED A CHARACTER THERE?
20900 NERROR ISS ;YES, ILLEGAL STRING
21000 JRST CPOPJ1 ;OK RETURN
21100
21200 ANY.: CAIE C,15
21300 JRST ISTRU ;YES THIS IS ANY CHR
21400 ISFALS: CAIN C,15 ;IS IT A RETURN
21500 AOSA T4 ;ADJUST COUNT AND ENTER A NULL STRING
21600 IDPB C,T2 ;SAVE IN ARBIT
21700 MOVEI T5,0
21800 IDPB T5,T2
21900 SUBI T4,2 ;COUNT THEM
22000 JUMPLE T4,ILFMTR ;THIS LINE MUST HAVE ILLEGAL FORMAT
22100 AOS ARBCNT ;ONE MORE SEEN
22200 TLNE FL,NEGF ;WAS NEG FLAG ON?
22300 AOS (P) ;YES, A MATCH
22400 POPJ P,
22500
22600 SEP: SKIPG T5,CTBL(C)
22700 TRNE T5,NSEPF
22800 JRST ISFALS ;NOT A SEP
22900 ISTRU: CAIN C,15
23000 AOSA T4
23100 IDPB C,T2 ;SAVE CHR
23200 MOVEI T5,0
23300 IDPB T5,T2
23400 SUBI T4,2
23500 JUMPLE T4,ILFMTR
23600 AOS ARBCNT
23700 ISTRU1: TLNN FL,NEGF ;NEGATE?
23800 AOS (P) ;NO, MATCH
23900 POPJ P,
24000
24100 ILFMTR: MOVE T2,CPG ;GIVE HIM AN ERROR MESSAGE AND PAGE
24200 PUSHJ P,PGPRN ;AND LINE
24300 MOVE T1,(PNTR)
24400 PUSHJ P,OUTSN
24500 NERROR ILFMT
24600 ARBIT: TLNN FL,NEGF ;THIS HAS NO MEANING
24700 TLOE FL,ARBITG ;ARE WE SEEING
24800 NERROR ISS ;YES, ILLEGAL STRING
24900 PUSH P,T1 ;SAVE SEARCH POINTER
25000 MOVEI T5,0 ;SET ARBITRARY STRING TO NULL
25100 IDPB T5,T2
25200 SOJLE T4,ILFMTR
25300 AOS ARBCNT
25400 PUSH P,ARBCNT ;SAVE IN CASE WE COME BACK WITH NO MATCH
25500 PUSH P,T2
25600 PUSH P,T4
25700 PUSH P,C
25800 CHKTHS: TLO FL,DEMCHR ;NEED A CHARACTER NOW
25900 PUSHJ P,REDCH1 ;CALL SELF RECURSIVELY
26000 JRST PROCED ;THIS COULD NOT MATCH JUST SCAN ON
26100 MOVE T2,-3(P) ;RESTORE ARBIT COUNT
26200 MOVEM T2,ARBCNT
26300 MOVE T4,-1(P) ;AND ARBIT CHR COUNT
26400 MOVE T2,-2(P) ;AND POINTER
26500 PUSH P,ALTP ;SAVE CHR POINTER
26600 TLZ FL,ARBITG ;CAN SEE ANOTHER NOW
26700 PUSHJ P,LINMAT ;A MATCH
26800 JRST RECUR ;NO, TRY FOR ANOTHER OF THAT CHR
26900 SUB P,[XWD 7,7] ;GET ALL THAT JUNK OFF STACK
27000 JRST CPOPJ1 ;AND RETURN TO CALLER OF LINMAT
27100
27200 RECUR: POP P,ALTP ;GET BACK POINTER
27300 POP P,C ;AND CHR
27400 MOVE T4,-2(P) ;RESTORE COUNT
27500 MOVEM T4,ARBCNT
27600 POP P,T4
27700 POP P,T2 ;ALSO CHR COUNTER AND POINTER
27800 DPB C,T2 ;PUT IN THAT CHR
27900 MOVEI T5,0 ;AN@ TERMINATOR
28000 IDPB T5,T2
28100 SOJLE T4,ILFMTR
28200 PUSH P,T2
28300 PUSH P,T4 ;RESAVE
28400 MOVE T1,-3(P) ;RESTORE SEARCH POINTER
28500 ILDB C,ALTP ;GET ANOTHER CHR
28600 PUSH P,C ;SAV IT
28700 TLZ FL,NEGF ;TURN THIS OFF FOR RECURSION
28800 CAIE C,12 ;END OF WORLD?
28900 JRST CHKTHS
29000 SUB P,[XWD 5,5] ;RECUCE STACK
29100 POPJ P, ;AND ERROR RET
29200
29300 PROCED: TLZ FL,ARBITG!NEGF ;JUST GO ON
29400 POP P,C
29500 POP P,T4
29600 POP P,T2
29700 POP P,ARBCNT
29800 POP P,(P) ;GET RID OF EXTRA POINTER
29900 JRST CHRMAT ;CONTINUE MATCH SCANNING
00100 SUBTTL FIND COMMAND (SEARCHES)
00200 ;DO A SEARCH OF A FILE
00300
00400 SEARCH: TLZ FL,ASSMF ;CLEAR ALL FLAGS
00500 SETZM SRCNT ;START WITH ZERO
00600 MOVE T1,[POINT 7,SRBUF] ;SET UP BYTE POINTER
00700 MOVEI T3,SRPNT ;AND POINTER TO BYTE POINTER TABLE
00800 PUSHJ P,SSTRNG ;GET A SEARCH STRING
00900 JRST [SKIPN SRPNT ;WAS STRING SET?
01000 NERROR NSG ;NO, TELL HIM
01100 CAIN C,12
01200 JRST ASSMD1 ;SPECIAL CONTINUE MODE
01300 JRST .+1] ;YES, USE OLD ONE
01400 TLZ FL,NUMSRF!ALTSRF!EXCTSR ;CLEAR FLAGS
01500 PUSHJ P,SCAN ;CHECK FOR WHAT COMES AFTER
01600 TRNN FL,TERMF ;IF TERMINATOR
01700 CAIN C,"," ;OR ,
01800 JRST ASSMDT ;SET UP LIMITS SPECIALLY
01900 CAIE C,"!"
02000 CAIN C,":"
02100 JRST ASSMDT ;LET HIM SPECIFY 2ND HALF OF RANGE
02200 PUSHJ P,GET2 ;ELSE CALL USUAL LIMIT ROUTINE
02300 SRC4: MOVE T1,HILN ;SAVE END OF RANGE
02400 MOVEM T1,SRHILN
02500 MOVE T1,HIPG
02600 MOVEM T1,SRHIPG
02700 CAIE C,"," ;ANY MORE ARGUMENTS?
02800 JRST SRC1 ;NO, CHECK TERMINATOR AND PROCEED
02900 PUSHJ P,SCAN ;YES, SEE WHAT IT IS
03000 TRNN FL,IDF ;SHOULD BE IDENT OR NUMBER
03100 JRST SRC2 ;NOT IDENT, CHECK FOR NUMBER OF SEARCHES
03200 MOVS T1,ACCUM ;GET THE IDENT
03300 CAIN T1,(SIXBIT/N /) ;AND FIND OUT WHAT IT IS
03400 TLO FL,NUMSRF
03500 CAIN T1,(SIXBIT/X /) ;DOES HE WANT TO EXPAND THAT LINE?
03600 TLO FL,DECID
03700 CAIN T1,(SIXBIT/A /)
03800 TLO FL,ALTSRF ;FIRST CHECK FOR A OR N
03900 TRNE FL,READOF ;IF READ ONLY AND ALTER
04000 TLNN FL,ALTSRF!DECID
04100 JRST .+2
04200 NERROR ILC ;WE DO NOT PERMIT IT
04300 TLNN FL,NUMSRF!ALTSRF!DECID ;WAS IT EITHER?
04400 JRST SRC3 ;NO, CHECK E
04500 PUSHJ P,SCAN ;CONTINUE LOOKING
04600 CAIE C,","
04700 JRST SRC1 ;NO MORE ARGUMENTS
04800 PUSHJ P,SCAN ;WELL WHAT KIND IS THIS ONE?
04900 TRNN FL,IDF ;MORE IDENTS?
05000 JRST SRC2 ;NO, MUST BE NUMBER OF SEARCHES
05100 MOVS T1,ACCUM
05200 SRC3: CAIE T1,(SIXBIT/E /)
05300 NERROR ILC ;NO, HE MUST HAVE MADE A MISTAKE
05400 TLO FL,EXCTSR ;YES, REMEMBER IT
05500 PUSHJ P,SCAN ;AND CHECK FOR MORE
05600 CAIE C,","
05700 JRST SRC1 ;NO MORE
05800 PUSHJ P,SCAN ;ONLY ONE THING IT CAN BE NOW
05900 SRC2: TRNN FL,NUMF
06000 NERROR ILC ;NOPE, LOSE
06100 MOVEM T2,SRCNT ;SAVE AS COUNT OF LINES TO FIND
06200 PUSHJ P,SCAN ;GET TERMINATOR (WE HOPE)
06300 SRC1: TRNN FL,TERMF ;ALLS WELL THAT ENDS WELL
06400 NERROR ILC ;BUT THIS DOSNT
06500 SRCH1A: MOVEI T1,SRPNT ;GET POINTER TO STRINGS
06600 PUSHJ P,CODSR ;AND GENERATE CODE
06700 MOVE T1,LOPG ;GET SET TO HUNT IT
06800 MOVEM T1,DPG
06900 MOVEM T1,SRPG ;FLAG TO SAY IF WE SHOULD PRINT PAGE
07000 MOVE SINDEX,LOLN
07100 PUSHJ P,FIND
07200 TRZ FL,LINSN ;NO LINES YET
07300 ONSRC: PUSHJ P,ONMOV ;CHECK RANGE
07400 JRST ENDSRC ;DONE
07500 TLZE FL,ASSMF ;FIRST TIME AND WANT .+1?
07600 JRST [CAME T1,LOLN ;IS THERE EXACT MATCH?
07700 JRST .+1 ;NO, THIS IS .+1
07800 AOS SVCNT ;PRETEND WE DIDNT SEE IT
07900 JRST SRNXT] ;AND TAKE NEXT
08000 TRO FL,LINSN ;WE SAW ONE
08100 CAMN T1,PGMK ;PAGES ARE SPECIAL
08200 JRST SRCPAG ;SO TAKE GOOD CARE OF THEM
08300 MOVEI T2,SRPNT ;POINTER TO STRINGS
08400 PUSHJ P,COMSRC ;GO SEARCH THIS LINE
08500 JRST SRNXT ;LOSER
08600 MOVEM T3,SVCCNT ;SAVE AWAY THE CHARACTER COUNT
08700 MOVE T2,CPG ;GET CURRENT PAGE
08800 CAME T2,SRPG ;AND SEE IF WE SHOULD PRINT IT
08900 PUSHJ P,PGPRN ;YES
09000 MOVE T2,CPG ;NOW SET IT AS CURRENT
09100 MOVEM T2,CPGL
09200 MOVEM T2,SRPG ;ALSO RESET FLAG
09300 MOVE T2,(PNTR) ;ALSO SET LINE
09400 MOVEM T2,CLN
09500 TLNE FL,ALTSRF ;ARE WE GOING TO EDIT?
09600 JRST SRCALT ;YES, GO SET THINGS UP
09700 TLNE FL,DECID ;SHALL WE EXPAND
09800 JRST [PUSHJ P,XPGUTS ;YES
09900 JRST SRNXTC] ;ALL DONE EXPANDING
10000 TLNE FL,NUMSRF ;DO WE WANT ONLY LINE NUMBERS?
10100 JRST SRCNUM ;YES
10200 MOVE T1,PNTR ;GO PRINT LINE
10300 PUSHJ P,OUTLIN
10400 SRNXTC: SOSG SRCNT ;HAVE WE FOUND ENOUGH
10500 JRST COMND ;YES, GIVE UP (WE HAVE SEEN AT LEAST ONE)
10600 TLNN FL,DECID ;DON'T FINDN IF DONE IN XPGUTS
10700 SRNXT: PUSHJ P,FINDN ;GET NEXT LINE TO LOOK A
10800 JRST ONSRC
10900 SRCNUM: MOVE T1,(PNTR) ;PRINT SEQUENCE NUMBER
11000 PUSHJ P,OUTSN
11100 TTCALL 3,ASCRLF
11200 JRST SRNXTC ;AND GO
11300
11400 ENDSRC: TRZN FL,LINSN ;DID WE SEE ONE?
11500 NERROR NLN ;NULL RANGE
11600 JRST COMND
11700
11800 SRCPAG: AOS CPG ;JUST ADVANCE PAGE COUNTER
11900 JRST SRNXT ;AND PROCEED
12000
12100 SRCALT: PUSHJ P,SETALT ;SET THINGS UP
12200 SKIPLE T2,SVCCNT ;GET COUNT (DO NOT CALL IF 0
12300 PUSHJ P,ALTSP ;SPACE OVER CORRECTLY
12400 PUSHJ P,ALTN1 ;GO ALTER
12500 JRST LEVINS ;HE SAID ALTMODE
12600 PUSHJ P,INSED ;INSERT IT
12700 PUSHJ P,FINDN
12800 PUSHJ P,FILLB ;MAKE SURE WE HAVE NOT GOTTEN TOO BIG
12900 MOVE T1,(PNTR) ;GET POINTER BACK
13000 SOSG SRCNT
13100 JRST COMND ;DONE
13200 JRST ONSRC ;GO ON
13300
13400 ASSMD1: TROA FL,CNTF ;MARK AS KEEP END OF RANGE
13500 ASSMDT: TRZ FL,CNTF ;JUST IN CASE
13600 TLO FL,ASSMF ;WE ASSUME .+1
13700 MOVE T1,CLN ;SET THINGS UP FOR . TO INFINITY
13800 MOVEM T1,LOLN
13900 MOVEM T1,HILN ;AS GOOD AS ANYTHING WITH THE PAGE WE WILL
14000 MOVE T1,CPGL ;USE
14100 MOVEM T1,LOPG
14200 TRZE FL,CNTF ;KEEP END?
14300 JRST NOSPC ;YES
14400 CAIE C,":" ;IF A : OR !
14500 CAIN C,"!"
14600 JRST HALFSP ;GET THE SECOND HALF (.+1 TO GIVEN)
14700 MOVSI T1,377777 ;GET A LARGE PAGE
14800 MOVEM T1,HIPG
14900 JRST SRC4 ;BACK INTO THINGS
15000
15100 HALFSP: MOVEM T1,HIPG ;SET TOP AS /.
15200 PUSHJ P,GET2HF ;GET THE SECOND HALF
15300 JRST SRC4 ;AND GO
15400
15500 NOSPC: MOVE T1,SRHIPG
15600 MOVEM T1,HIPG ;PUT BACK END
15700 MOVE T1,SRHILN
15800 MOVEM T1,HILN
15900 JRST SRCH1A
00100 SUBTTL ALTMODE AND LINE FEED COMMANDS
00200
00300 NXTLIN: OUTCHR [15] ;OUTPUT A CR
00400 MOVE T1,CPGL ;REALLY FIND THE CURRENT LINE
00500 MOVEM T1,DPG
00600 MOVE SINDEX,CLN
00700 PUSHJ P,FIND
00800 CAMN T1,CLN ;DID WE REALLY FIND IT
00900 PUSHJ P,FINDN ;YES, GET NEXT ELSE WE ALREADY HAVE IT
01000 JUMPE T1,[NERROR NLN] ;EOF AND NOT FOUND
01100 NXTL1: CAMN T1,PGMK ;IS THIS A PAGE MARK?
01200 JRST NXTPG ;TREAT SPECIALLY
01300 MOVEM T1,CLN ;SET AS CURRENT
01400 MOVE T1,PNTR ;GET THE CURRENT POINTE
01500 PUSHJ P,OUTLIN ;AND PRINT
01600 JRST COMND ;DONE
01700 NXTPG: AOS T2,CPG ;WE ARE ON THE NEXT PAGE
01800 MOVEM T2,CPGL
01900 PUSHJ P,PGPRN ;TELL HIM
02000 PUSHJ P,FINDN ;FIND A LINE ON IT
02100 JUMPN T1,NXTL1 ;THERE IS ONE THERE, PRINT IT
02200 MOVE T1,[<ASCII /00000/> !1] ;END OF FILE, SET TO THAT PAGE
02300 MOVEM T1,CLN
02400 JRST COMND
02500
02600 BAKLIN: OUTSTR ASCRLF
02700 MOVE T1,CPGL ;FIND CURRENT
02800 MOVEM T1,DPG
02900 MOVE SINDEX,CLN
03000 PUSHJ P,FIND
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 BAK1: PUSHJ P,FINDB
03600 CAMN T1,PGMK
03700 JRST PRVPAG ;TELL HIM WE CROSSED A PAGE BOUNDARY
03800 MOVEM T1,CLN ;SET AS CURRENT
03900 MOVE T1,PNTR
04000 PUSHJ P,OUTLIN
04100 JRST COMND
04200
04300 PRVPAG: MOVE T2,CPG
04400 MOVEM T2,CPGL
04500 PUSHJ P,PGPRN
04600 TRNE FL,BOF ;CHECK FOR START OF WORLD
04700 CAME PNTR,BUFP
04800 JRST BAK1 ;OK, BACK UP SOME MOR
04900 MOVE T1,[<ASCII /00000/>!1]
05000 MOVEM T1,CLN
05100 JRST COMND
00100 SUBTTL COPY AND TRANSFER COMMANDS
00200
00300 TRANS: TLOA FL,TRANFL ;SET AS TRANSFER COMMAND
00400 COPY: TLZ FL,TRANFL ;JUST TO MAKE SURE
00500 TRNE FL,READOF ;DO NOT LET HIM IN READ ONLY MODE
00600 NERROR ILC
00700 SETZM SVJRL2 ;NO SECOND .JBREL SAVED
00800 PUSHJ P,GET1S ;GET PLACE TO PUT LINES
00900 MOVE T1,HIPG ;STORE IT AWAY FOR LATER
01000 MOVEM T1,DESTPG
01100 MOVE T1,HILN
01200 MOVEM T1,DESTLN
01300 CAIN C,"_" ;DOES HE WANT TO COME FROM ANOTHER FILE?
01400 JRST ALTFIL ;YES
01500 TLZ FL,COPFIL ;NO, MAKE SURE FLAG IS OFF
01600 COPY1: CAIE C,"," ;SHOULD BE COMMA EVEN IF FROM ALTFIL
01700 NERROR ILC ;HE MUST SAY WHERE TO PUT IT
01800 COPY1A: PUSHJ P,GET2S ;GO GET PLACE TO FIND LINES
01900 MOVE T1,INCR ;SAVE INCREMENT AS CURRENT
02000 MOVEM T1,FINCR
02100 SETZM SINCR ;SET NO SECOND INCREMENT
02200 CAIE C,"," ;CHECK FOR MORE ARGUMENTS
02300 JRST CKTER2 ;NO, LOOK FOR TERMINATOR
02400 PUSHJ P,SCAN
02500 CAME T1,[<ASCII /00000/>!1] ;AVOID 0 INCREMENTS
02600 TRNN FL,NUMF ;SHOULD BE INCREMENT, MUST BE NUMBER
02700 NERROR ILC
02800 MOVEM T1,FINCR
02900 PUSHJ P,SCAN
03000 CAIE C,","
03100 JRST CKTER2
03200 PUSHJ P,SCAN
03300 CAME T1,[<ASCII /00000/>!1]
03400 TRNN FL,NUMF
03500 NERROR ILC
03600 MOVEM T1,SINCR
03700 PUSHJ P,SCAN
03800 CKTER2: TRNN FL,TERMF
03900 NERROR ILC ;DID NOT END PROPERLY, LOSE
04000 SETOM NLIN1 ;LINES ON FIRST PAGE
04100 SETZM NLIN2 ;LINES ON LAST PAGE
04200 TLO FL,ISCOP ;SO WE WILL DO SPECIAL RESET IF ERROR
04300 MOVE ALTP,.JBREL ;SET UP SAVE POINTER
04400 MOVEM ALTP,SVJRL ;SO WE CAN RESET IT
04500 MOVEI T1,2000(ALTP) ;ASK FOR ANOTHER 1K
04600 CORE T1,
04700 NERROR NEC ;ALL OUT, GIVE UP
04800 HRLI ALTP,-2000 ;SET COUNT OF HOW MUCH IS THERE
04900 SETZM LSTPG ;HAVE SEEN NO PAGES YET
05000 MOVE T1,LOPG ;LOOK FOR SOURCE
05100 MOVEM T1,DPG
05200 MOVE SINDEX,LOLN
05300 PUSHJ P,FIND
05400 TRZ FL,LINSN ;AND NO LINES
05500 TLNN FL,TRANFL ;IS THIS A TRANSFER COMMAND?
05600 JRST GOCOP ;NO, IGNORE ALL THIS SPECIAL STUFF
05700 HRRZM ALTP,STARTD ;SAVE THE START OF DELETED CODE
05800 HRRZM ALTP,ENDD ;AND THE END
05900 MOVE T1,CPG ;GET THE PAGE ON WHICH DELETION STARTS
06000 MOVEM T1,TRANST ;AND SAVE IT
06100 SKIPN -1(PNTR) ;ARE WE AT THE START OF THE BUFFER
06200 TRNN FL,BOF ;AND OF THE WORLD
06300 SKIPA
06400 JRST BEGFIL ;YES, DO NOT LOOK BACK
06500 PUSHJ P,FINDB ;GET THE PREVIOUS LINE
06600 CAMN T1,PGMK ;A PAGE IS SPECIAL
06700 JRST SPCPG
06800 MOVEM T1,BOTLIN ;SAVE IT FOR LATER
06900 PUSHJ P,FINDN ;GO FORWARD AGAIN
07000 JRST GOCOP
07100 SPCPG: SKIPE LOLN ;DO WE INTEND TO ABSORD THIS ONE
07200 JRST BEGFIS ;MOVE FORWARD AND RECORD
07300 SKIPN -1(PNTR) ;CHECK FOR START OF WORLD AGAIN
07400 TRNN FL,BOF
07500 SKIPA
07600 JRST BEGFIS
07700 PUSHJ P,FINDB ;BACK UP
07800 AOS CPG ;FIX PAGE COUNT
07900 PUSH P,T1 ;SAVE THAT LINE
08000 PUSHJ P,FINDN
08100 PUSHJ P,FINDN ;AND GO BACK WHERE WE BELONG
08200 POP P,T1 ;GET LINE NUMBER BACK
08300 CAMN T1,PGMK ;THERE'S THAT PAGE AGAIN
08400 JRST BEGFIA
08500 MOVEM T1,BOTLIN ;SAVE LINE NUMBER
08600 JRST GOCOP
08700 BEGFIS: AOSA CPG
08800 BEGFIA: AOSA CPG
08900 PUSHJ P,FINDN
09000 BEGFIL: SETOM BOTLIN ;A VERY SMALL NUMBER
09100 GOCOP: SETZM PGDELS ;TOTAL NUMBER OF PAGES DELETED IS 0
09200 SKIPE LOLN ;DID HE ASK FOR THE WHOLE PAGE
09300 JRST NOISTP ;NO
09400 MOVE T1,PGMK ;YES, PUT IN THE PAGE MARK
09500 MOVEM T1,1(ALTP)
09600 MOVE T1,PGMKTX
09700 MOVEM T1,2(ALTP)
09800 HRRZM ALTP,LSTPG
09900 ADD ALTP,[XWD 2,2]
10000 SETZM NLIN1 ;NO LINES ON FIRST PAGE
10100 TLNN FL,TRANFL ;IS THIS A TRANSFER
10200 JRST NOISTP ;NO, START TRANSFER OF DATA
10300 MOVE T1,CPG ;CHECK TO SEE IF WE SHOULD REALLY DELETE
10400 CAIN T1,1 ;NOT IF PAGE 1
10500 JRST RSTSTP
10600 PUSHJ P,FINDB ;GET THAT PAGE
10700 SETZM NCNT ;DELETE
10800 MOVEI T1,2
10900 MOVEM T1,OCNT
11000 PUSHJ P,INSED
11100 PUSHJ P,FINDN1 ;MAKE SURE WE ARE AT THE LINE WE WERE AT
11200 AOS CPG ;KEEP COUNT STRAIGHT
11300 AOSA PGDELS ;ONE DELETED
11400 RSTSTP: HRRZM ALTP,STARTD ;RESET START IF NONE DELETED
11500 HRRZM ALTP,ENDD ;RESET END
11600 NOISTP: MOVE T1,(PNTR) ;MAKE SURE WE HAVE THAT JUNK BACK
11700 ONCOPY: PUSHJ P,ONMOV ;STILL IN RANGE?
11800 JRST ENDCOP ;NO, START INSERTING
11900 TRO FL,LINSN ;WE SAW ONE
12000 CAMN T1,PGMK ;IS IT A PAGE?
12100 JRST MOVPG ;YES, TREAT SPECIAL
12200 MOVLI.: MOVE T1,PNTR ;START TRANSFER
12300 MOVE T2,(T1) ;PICK UP FIRST WORD (SEQ NUM)
12400 MOVEM T2,LSTLN ;SAVE FOR INC CALC
12500 TRLIN: MOVEM T2,1(ALTP) ;PUT LINE AWAY
12600 AOBJP ALTP,RESTCR ;NEED MORE CORE?
12700 TRLIN1: SKIPN T2,1(T1) ;END OF LING?
12800 JRST NXTLI.
12900 TRNN T2,1
13000 AOJA T1,TRLIN ;NO MOVE NEXT WORD
13100 NXTLI.: TLNN FL,TRANFL ;IS THIS TRANSFER?
13200 JRST NXTLCP ;NO, DON'T DELETE
13300 HRRZM ALTP,ENDD ;SAVE END OF DELETED TEXT
13400 SETZM NCNT
13500 SUBI T1,-1(PNTR) ;GET LENGTH
13600 MOVEM T1,OCNT
13700 PUSHJ P,INSED
13800 PUSHJ P,FINDN1 ;MAKE SURE A LINE IS THERE
13900 SKIPA ;SKIP THE FINDN
14000 NXTLCP: PUSHJ P,FINDN ;YES, GET NEXT
14100 AOS NLIN2 ;ONE MORE LINE
14200 JRST ONCOPY
14300
14400 MOVPG: AOS CPG ;WE ARE ON NEXT PAGE
14500 MOVE T1,NLIN2
14600 SKIPGE NLIN1 ;PUT ON FIRST PAGE IF NOT SOME ALREADY THERE
14700 MOVEM T1,NLIN1
14800 SETZM NLIN2
14900 HRRZM ALTP,LSTPG ;SAVE RECORD OF WHERE SEEN
15000 AOS PGDELS ;RECORD ONE MORE PAGE DELETED
15100 JRST MOVLI. ;NOW MOVE IT
15200 RESTCR: MOVE T2,.JBREL ;GET END
15300 ADDI T2,2000
15400 CORE T2, ;GET MORE
15500 NERROR NEC
15600 HRLI ALTP,-2000
15700 JRST TRLIN1 ;AND CONTINUE
15800
15900 ENDCOP: TRNN FL,LINSN ;WERE THERE ANY THERE?
16000 NERROR NLN ;NO LOSE
16100 SETZM 1(ALTP) ;MAKE SURE THERG IS AN END FLAG THERE
16200 TLZE FL,COPFIL ;ARE WE COMMING OFF A FILE
16300 PUSHJ P,RSCOP ;YES, RESET POINTERS
16400 MOVE T1,DESTPG ;LOOK FOR DESTINATION
16500 MOVEM T1,DPG
16600 TLNN FL,TRANFL ;IS IT A TRANSFER?
16700 JRST DOINS1 ;NO, PUT THE COPIED TEXT IN
16800 SETZM PGINSD ;NO EXTRA PAGE MARK INSERTED YET
16900 SKIPN T2,(PNTR) ;ARE WE AT EOF
17000 JRST NOPGIN ;YES, DO NOT INSERT A PAGE MARK
17100 CAME T2,PGMK ;ALSO NOT IF PAGE MARK
17200 CAMLE T2,BOTLIN ;OR GREATER THAN LINE LEFT OVER
17300 SKIPA
17400 SETOM PGINSD ;WE WILL HAVE TO INSERT ONE
17500 NOPGIN: MOVN T2,PGDELS ;GET MINUS NUMBER OF PAGES DELETED
17600 SUB T2,PGINSD ;ONE LESS IF A PAGE MARK INSERTED
17700 CAMGE T1,TRANST ;(T1 HAS DEST. PAGE) IF SMALLER THAN START
17800 JRST DOSUB ;EVERYTHING IS OK
17900 CAMN T1,TRANST ;IS IT SAME?
18000 JRST DSEQTR ;SPECIAL CHECK REQUIRED
18100 CAMGE T1,CPG ;INSIDE RANGE DELETED?
18200 NERROR ITD ;LOSE BIG
18300 CAMN T1,CPG ;SAME AS TOP PAGE?
18400 JRST DSEQCP
18500 ADDM T2,DESTPG ;ADJUST PGE WE ARE TO FIND
18600 ADDM T2,DPG
18700 DOSUB: ADDM T2,CPG ;ADJUST FOR REMOVED PAGES
18800 ADDM T2,INPG
18900 ADDM T2,BGPG
19000 SKIPN PGINSD ;SEE IF WE WANT TO INSERT ONE
19100 JRST DOINS1
19200 MOVE T1,PGMK
19300 MOVEM T1,LIBUF
19400 MOVE T1,PGMKTX
19500 MOVEM T1,LIBUF+1
19600 SETZM OCNT
19700 MOVEI T1,2
19800 MOVEM T1,NCNT
19900 PUSHJ P,INSED
20000 PUSHJ P,FINDN ;ADVANCE OVER IT
20100 PUSHJ P,FILLB ;IN CASE OF OVERFLOW
20200 TTCALL 3,[ASCIZ /PAGE MARK INSERTED TO PREVENT ORDER ERROR
20300 /]
20400 JRST DOINS1
20500
20600 ALLSAM: SKIPN LOLN
20700 SKIPE PGINSD ;IF DID NOT DELETE PAGE OR INSERTED ONE
20800 JRST DOSUB ;ALL OK
20900 SKIPE T1,(PNTR) ;ELSE MUST BE IN UPPER PART
21000 CAMN T1,PGMK
21100 NERROR ITD ;THERE IS NO UPPER PART
21200 CAMLE T1,DESTLN
21300 NERROR ITD
21400 SOS T1,DESTPG ;THIS WILL BE ON A LOWER PAGE
21500 MOVEM T1,DPG
21600 JRST DOSUB
21700
21800 DSEQTR: CAMN T1,CPG ;IS IT ALL ON SAME PAGE?
21900 JRST ALLSAM ;YES, SPECIAL CHECKING
22000 SKIPN LOLN ;DID WE START WITH A PAGE
22100 NERROR ITD ;YES, LOSE
22200 SKIPE PGINSD ;WAS THERE A PAGE INSERTED?
22300 JRST DOSUB ;YES, ALL OK
22400 SKIPE T1,(PNTR) ;FIND OUT WHAT THE NEXT LINE IS
22500 CAMN T1,PGMK
22600 JRST DOSUB ;THIS WILL BE OK
22700 CAMG T1,DESTLN ;SEE IF WE ARE IN TROUBLE
22800 NERROR ITD
22900 JRST DOSUB ;OK
23000
23100 DSEQCP: SKIPE PGINSD ;WAS ONE INSERTED
23200 JRST AOSTRA ;SET PAGE PROPERLY
23300 MOVE T1,DESTLN
23400 CAMG T1,BOTLIN
23500 NERROR ITD
23600 SKIPA T1,TRANST
23700 AOSTRA: AOS T1,TRANST
23800 MOVEM T1,DESTPG
23900 MOVEM T1,DPG ;ALSO SET THIS
24000 JRST DOSUB
24100
24200 DOINS1: MOVE SINDEX,DESTLN
24300 PUSHJ P,FIND
24400 MOVE T1,CPG
24500 CAME T1,DESTPG ;PAGES MUST MATCH
24600 JRST [TLNN FL,TRANFL
24700 NERROR NSP
24800 MOVE T1,PGMK
24900 MOVEM T1,LIBUF
25000 MOVE T1,PGMKTX
25100 MOVEM T1,LIBUF+1
25200 SETZM OCNT
25300 MOVEI T1,2
25400 MOVEM T1,NCNT
25500 PUSHJ P,INSED
25600 PUSHJ P,FINDN
25700 PUSHJ P,FILLB
25800 AOS CPG
25900 AOS INPG
26000 AOS BGPG
26100 TTCALL 3,[ASCIZ /TEXT INSERTED AT END OF FILE
26200 /]
26300 MOVE T1,CPG
26400 JRST .+1]
26500 MOVEM T1,CPGL ;SET THIS AS CURRENT PAGE
26600 MOVE T1,DESTLN ;GET THE PAGE NUMBER TO PUT OUT
26700 MOVEM T1,CLN ;AND THIS AS CURRENT LINE
26800 MOVEM T1,SVLNUM
26900 MOVE ALTP,SVJRL ;POINT TO START OF LINES TO COPY
27000 TLZ FL,TRANFL ;THIS FLAG NO LONGER NEEDED
27100 SKIPE T3,(PNTR) ;GET NEXT LINE AFTER THE INSERT
27200 CAMN T3,PGMK
27300 JRST [MOVEI T1,^D100000 ;USE HIGH NUMBER IF NONE THERE
27400 JRST SETHI]
27500 PUSHJ P,NUMCON ;CONVERT ASCID TO NUMBER
27600 SETHI: MOVEM T1,HIGH1 ;SAVE FOR LATER
27700 MOVE T3,DESTLN ;GET NUMBER OF FIRST LINE TO BE INSERTED
27800 PUSHJ P,NUMCON
27900 MOVEM T1,DESTN ;SAVE IT TOO
28000 SKIPGE NLIN1 ;DID WE SEE ANY PAGE MARKS?
28100 JRST ONSET ;NO, ONLY ONE INC TO WORRY ABOUT
28200 SKIPE SINCR ;WAS A SECOND INCREMENT GIVEN?
28300 JRST DOSINC ;YES
28400 SKIPE T3,(PNTR)
28500 CAMN T3,PGMK ;ARE THERE ANY LINES AFTER IT
28600 JRST OKINC2 ;NO, OK TO LEAVE LINES AS THEY ARE
28700 DOSINC: MOVE T1,HIGH1 ;CALCULATE MAX POSSIBLE INCREMENT
28800 AOS T2,NLIN2 ;WHICH WILL NOT RUIN ORDER
28900 IDIV T1,T2
29000 JUMPE T1,ORDSEC ;THERE IS NO POSSIBLE GOOD ONE
29100 CAIL T1,^D100000 ;A VERY LARGE ONE IS POSSIBLE
29200 JRST OKINC2 ;SO JUST USE THE ONE GIVEN
29300 PUSHJ P,ASCON ;CONVERT TO ASCID
29400 SKIPN SINCR ;WAS THERE AN INC GIVEN?
29500 JRST [MOVE T1,LSTLN ;GET THE HIGHEST LINE PICKED UP
29600 CAML T1,(PNTR) ;SEE IF IT IS OK
29700 JRST ONST3 ;NO
29800 JRST OKINC2]
29900 CAML T3,SINCR ;SEE IF ONE GIVEN IS OK
30000 JRST OKINC2 ;YES
30100 ONST3: MOVEM T3,SINCR ;NO, STORE CALCULATED
30200 ONST2: PUSH P,T2
30300 MOVE T2,[ASCII/INC2=/]
30400 PUSHJ P,ONSTX
30500 POP P,T2
30600
30700 OKINC2: MOVEI T1,^D100000 ;FIND A SUITABLE FIRST INCREMENT
30800 SUB T1,DESTN
30900 SKIPN NLIN1 ;WERE THERE ANY?
31000 JRST INSL2 ;NO, ALL IS OK
31100 IDIV T1,NLIN1 ;GET USABLE ONE
31200 JUMPE T1,ORDCP2 ;NONE POSSIBLE
31300 CAIL T1,^D100000
31400 JRST INSL2 ;ALL OK
31500 PUSHJ P,ASCON ;CONVER
31600 CAML T3,FINCR ;IS ONE GIVEN SMALLER?
31700 JRST INSL2 ;YES, ALL OK
31800 MOVEM T3,FINCR
31900 JRST ONST1 ;LET HIM KNOW
32000
32100 ONSET: SKIPG NLIN2 ;WERE THERE ANY?
32200 JRST INSL2 ;ALL OK
32300 MOVE T1,HIGH1
32400 SUB T1,DESTN
32500 IDIV T1,NLIN2 ;CALCULATE INCREMENT
32600 JUMPE T1,ORDCOP ;NONE POSSIBLE
32700 CAIL T1,^D100000
32800 JRST INSL2 ;VERY BIG, ALL OK
32900 PUSHJ P,ASCON
33000 CAML T3,FINCR ;IS ONE GIVEN SMALLER?
33100 JRST INSL2
33200 MOVEM T3,FINCR
33300 ONST1: PUSH P,T2
33400 MOVE T2,[ASCII/INC1=/]
33500 PUSHJ P,ONSTX
33600 POP P,T2
33700 JRST INSL2 ;HE HAS BEEN TOLD
33800
33900 ONSTX: PUSH P,T4
34000 MOVE T4,ASCRLF
34100 TTCALL 3,T2
34200 POP P,T4
34300 POPJ P,
34400
34500 ORDCP2: SKIPA T3,[ASCII /WAR /]
34600 ORDCOP: MOVE T3,[ASCII /ORDER/]
34700 JRST ONST1
34800 ORDSEC: MOVE T3,[ASCII /ORDER/]
34900 JRST ONST2
35000
35100 ASCON: MOVSI T3,400000 ;WILL BECOME LOW ORDER BIT
35200 ASCO2: IDIVI T1,^D10
35300 ADDI T2,"0"
35400 LSHC T2,-7
35500 TRNN T3,1 ;HAS IT GOTTEN THERE?
35600 JRST ASCO2
35700 POPJ P,
35800
35900 NUMCON: MOVEI T1,0
36000 TRZ T3,1 ;GET RID OF LOW ORDER BIT
36100 NUMC1: MOVEI T2,0
36200 LSHC T2,7
36300 IMULI T1,^D10
36400 ADDI T1,-"0"(T2)
36500 JUMPN T3,NUMC1
36600 POPJ P,
36700 INSLN: MOVE T2,FINCR ;GENERATE NEW SEQUENCE NUMBER
36800 SKIPN T1,SVLNUM ;BUT ONLY IF WE ARE SUPPOSED TO
36900 JRST INSL2
37000 PUSHJ P,ASCIAD
37100 MOVEM T1,SVLNUM ;PUT EITHER NGW OR 0 BACK
37200 INSL2: SETZM LIBUF ;ZERO OUT PLACE TO PUT LINE
37300 MOVE T1,[XWD LIBUF,LIBUF+1]
37400 BLT T1,LIBUF+MXWPL+1
37500 MOVEI T1,LIBUF ;SET UP OUTPUT POINTER
37600 SKIPN T2,1(ALTP) ;AT END?
37700 JRST INSDON ;FINISHED
37800 INS1: MOVEM T2,(T1) ;PUT IT AWAY
37900 ADDI ALTP,1 ;NEXT
38000 SKIPN T2,1(ALTP) ;CHECK FOR END OF LING
38100 JRST DOINS
38200 TRNN T2,1 ;BY EITHER METHOD
38300 AOJA T1,INS1 ;GO ON WITH TRANSFER
38400 DOINS: SUBI T1,LIBUF-1 ;GET COUNT
38500 MOVEM T1,NCNT ;AND SET AS NEW
38600 SETZM OCNT ;OLD IS ZERO
38700 MOVE T1,LIBUF ;GET SEQ NUM
38800 CAMN T1,PGMK ;CHECK FOR PAGE
38900 JRST INSPG ;AND DO SPECIAL
39000 SKIPN T1,SVLNUM ;IF A NON-ZERO NUMBER THEN REPLACE
39100 MOVE T1,LIBUF
39200 MOVEM T1,LIBUF
39300 NOINCR: MOVEM T1,CLN ;SET AS CURRENT LINE
39400 PUSHJ P,INSED ;INSERT IT
39500 PUSHJ P,FINDN ;GET NEXT
39600 PUSHJ P,FILLB ;AND DUMP IF NEEDED
39700 JRST INSLN ;GO PUT IN MORE
39800
39900 INSPG: AOS T3,CPG ;WE ARE ON THE NEXT PAGE
40000 MOVEM T3,CPGL ;SET AS CURRENV
40100 MOVE T1,[<ASCII /00000/>!1] ;SET TO SAY LINE 0
40200 AOS BGPG ;ONE MORE PAGE IN FILE
40300 AOS INPG
40400 SETZM SVLNUM ;DO NOT DO ANY MORE SEQUENCE REPLACEMENT
40500 MOVEI T2,-2(ALTP) ;SINCE WE HAVE ALREADY GONE PAST
40600 CAMN T2,LSTPG ;UNLESS STARTING LAST PAGE
40700 SKIPN T3,SINCR ;ANF SECOND SEQUENCE NUMBER GIVEN
40800 JRST NOINCR
40900 MOVEM T3,FINCR ;SET UP INCREMENT
41000 MOVEI T3,1 ;AND RESTART NUMBERING
41100 MOVEM T3,SVLNUM
41200 JRST NOINCR
41300
41400 INSDON:
41500 COPDON: RELEASE ALTDV,0 ;JUST FOR GOOD MEASURE
41600 TLZE FL,COPFIL ;ARE WE COPYING FROM A FILE (ERRORS ONLY)
41700 PUSHJ P,RSCOP ;YES, CLEAN UP POINTERS
41800 TLZ FL,ISCOP ;RESET COPY FLAG
41900 TLNN FL,TRANFL ;IF TRANSFER, WE MUST REINSERT
42000 JRST COPD1 ;NO
42100 MOVE ALTP,STARTD
42200 REINXT: MOVEI T1,LIBUF
42300 CAMN ALTP,ENDD
42400 JRST COPD1 ;ALL DONE
42500 MOVE T2,1(ALTP)
42600 JRST REINWD
42700
42800 REINS: MOVE T2,1(ALTP)
42900 CAME ALTP,ENDD
43000 TRNE T2,1
43100 JRST ENDLIN ;DONE WITH THIS LINE
43200 REINWD: MOVEM T2,(T1)
43300 ADDI T1,1
43400 AOJA ALTP,REINS
43500
43600 ENDLIN: SETZM OCNT
43700 SUBI T1,LIBUF
43800 MOVEM T1,NCNT
43900 PUSHJ P,INSED ;INSERT LINE
44000 PUSHJ P,FINDN
44100 PUSHJ P,FILLB ;IN CASE OF OVERFLOW
44200 JRST REINXT
44300
44400 COPD1: SKIPN T1,SVJRL2 ;USE THIS IF SET
44500 MOVE T1,SVJRL ;ELSE THIS
44600 CORE T1, ;RESTORE TO PROPER SIZE
44700 ERROR ICN ;THIS SHOULD NEVER HAPPEN
44800 JRST COMND ;FINISH UP
44900
45000 ALTFIL: TLNE FL,TRANFL ;ANOTHER FILE IS NOT LEGAL IN TRANSFER
45100 NERROR ILC
45200 MOVEI T5,NAMDEV
45300 PUSHJ P,READNM
45400 NERROR ILC
45500 TRNE FL2,RSW ;THIS SWITCH NOT ALLOWED
45600 NERROR ILC
45700 MOVE T1,.JBREL ;SET THINGS UP
45800 MOVEM T1,SVJRL2
45900 ADDI T1,4000 ;ASK FOR 1 K FOR BUFFERS
46000 TLO FL,ISCOP ;TELL THE WORLD WHAT WE HAVE DONE
46100 CORE T1, ;IS IT THERE
46200 NERROR NEC
46300 MOVE T1,SVJRL2 ;POINT BUFFERS TO RIGHT PLACE
46400 MOVEM T1,.JBFF
46500 MOVEI T1,14 ;MODE 14
46600 MOVE T2,NAMDEV ;DEVICE
46700 MOVEI T3,ALTBF ;BUFFER
46800 OPEN ALTDV,T1
46900 NERROR DNA ;MAYBE ITS HEREDITARY
47000 PUSH P,NAMI+3 ;SAVE THIS BEFORE THE LOOKUP DESTROYS IT
47100 LOOKUP ALTDV,NAMI
47200 NERROR FNF
47300 INBUF ALTDV,2 ;GET BUFFER SPACE
47400 MOVE T1,ORGPPN ;SAVE OLD NAMES
47500 EXCH T1,(P) ;AND REPLACE BY NEW
47600 MOVEM T1,ORGPPN ;IN CASE WE HAVE TO BACK UP
47700 MOVE T1,NAMI
47800 PUSH P,ORGNAM
47900 MOVEM T1,ORGNAM
48000 HLLZ T1,NAMI+1
48100 PUSH P,ORGEXT
48200 MOVEM T1,ORGEXT
48300 MOVE T1,.JBREL
48400 SUBI T1,2*MXWPL+2 ;SET UP THE VARIOUS POINTERS
48500 PUSH P,FILPT ;SEE STPT FOR MORE INFO
48600 MOVEM T1,FILPT
48700 MOVEI T1,1
48800 PUSH P,CPGL
48900 MOVEM T1,CPGL
49000 MOVE T1,[<ASCII /00000/>!1]
49100 PUSH P,CLN
49200 MOVEM T1,CLN
49300 MOVE T1,.JBFF
49400 SETZM (T1)
49500 ADDI T1,1
49600 PUSH P,BUFP
49700 MOVEM T1,BUFP
49800 MOVE T1,.JBREL
49900 SUB T1,BUFP
50000 MOVE T2,T1
50100 SUBI T2,MXWPL+1
50200 PUSH P,MAXWC
50300 MOVEM T2,MAXWC
50400 ASH T1,-1
50500 PUSH P,HLFWC
50600 MOVEM T1,HLFWC
50700 MOVEI T1,1
50800 PUSH P,CPG
50900 PUSH P,INPG
51000 MOVEM T1,CPG
51100 MOVEM T1,INPG
51200 PUSH P,PNTR
51300 MOVE PNTR,BUFP
51400 PUSH P,SVWD
51500 SETZM SVWD
51600 PUSH P,OLDLIN
51700 SETZM OLDLIN
51800 PUSH P,WC
51900 SETZM WC
52000 MOVSI T1,1
52100 PUSH P,BGPG
52200 MOVEM T1,BGPG
52300 MOVE T1,FL ;SAVE SELECTED FLAGS
52400 AND T1,[XWD TECOF+FSTOPF,READOF!BOF!EOF!EOF2!BGSN]
52500 PUSH P,T1
52600 TRZ FL,EOF!EOF2
52700 TRO FL,READOF!BOF
52800 TLZ FL,TECOF
52900 TLO FL,FSTOPF
53000 MOVEM P,COPDL ;SAVE PDL FOR LATER
53100 TLO FL,COPFIL ;WE ARE USING OTHER FILE POINTERS
53200 PUSHJ P,FILLBF
53300 TRNN FL2,SSW
53400 JRST COPY1
53500 TRNN FL,TERMF ;MUST END HERE
53600 NERROR ILC
53700 TLO FL,SRCOP ;SET THINGS UP
53800 JRST COMND ;AND GO GET COMMANDS
53900
54000 DSCOP: TLZ FL,SRCOP ;TURN IT OFF
54100 TTCALL 3,[ASCIZ /SOURCE LINES=/]
54200 SETZM LOLN ;THIS MAY HAVE GOTTEN RESET
54300 SETZM SAVCHR ;CLEAR THINGS OUT
54400 SETZM TIBUF+2 ;CLEAR REST OF INPUT
54500 JRST COPY1A ;GO GET REST OF COMMAND STRING
54600
54700 RSCOP: POP P,T2
54800 MOVE P,COPDL ;GET PDL BACK
54900 POP P,T1
55000 TRZ FL,READOF!BOF!EOF!EOF2!BGSN ;RESTORE SELECTED FLAGS
55100 TLZ FL,TECOF!FSTOPF
55200 IOR FL,T1
55300 POP P,BGPG
55400 POP P,WC
55500 POP P,OLDLIN
55600 POP P,SVWD
55700 POP P,PNTR
55800 POP P,INPG
55900 POP P,CPG
56000 POP P,HLFWC
56100 POP P,MAXWC
56200 POP P,BUFP
56300 POP P,CLN
56400 POP P,CPGL
56500 POP P,FILPT
56600 POP P,ORGEXT ;GET NAMES BACK
56700 POP P,ORGNAM
56800 POP P,ORGPPN
56900 JRST (T2) ;NOW RETURN
57000
57100 COPGET: SOSG ALTBF+2 ;GET A WORD FROM COPY FILE
57200 JRST GETDO.
57300 GTWD1.: ILDB T3,ALTBF+1
57400 JUMPE T3,COPGET
57500 POPJ P,
57600 GETDO.: INPUT ALTDV,0
57700 STATO ALTDV,760000
57800 JRST GTWD1.
57900 STATZ ALTDV,740000
58000 ERROR DIE
58100 TRO FL,EOF
58200 MOVEI T3,0
58300 POPJ P,
58400
58500
58600 CKTEC2: SETSTS ALTDV,0
58700 MOVSI T3,(<POINT 7,0>)
58800 HLLM T3,ALTBF+1
58900 MOVE T3,ALTBF+2
59000 IMULI T3,5
59100 AOS T3
59200 MOVEM T3,ALTBF+2
59300 JRST RDTECO
59400
00100 SUBTTL SUBSTITUTE COMMAND (REPLACES THINGS)
00200 ;ALSO KNOWN AS SUBSTITUTE
00300 SUBST: TLZ FL,ASSMF ;DO NOT ASSUME ANYTHING YET
00400 TRNE FL,READOF
00500 NERROR ILC
00600 MOVSI T1,37777 ;SET COUNT LARGE
00700 MOVEM T1,RPCNT
00800 MOVE T1,[POINT 7,R1BUF]
00900 MOVEI T3,R1PNT
01000 PUSHJ P,SSTRNG ;THIS CODE IS JUST LIKE SEARCH
01100 JRST [SKIPE R2PNT ;BOTH STRINGS MUST HAVE BEEN GIVEN
01200 SKIPN R1PNT
01300 NERROR NSG ;ELSE THERE HAS BEEN AN ERROR
01400 CAIN C,12 ;CHECK FOR JUST A CRRET
01500 JRST ASMD1. ;AND DO A CONTINUE
01600 JRST NOSTR] ;THERE IS NO STRING
01700 MOVE T1,[POINT 7,R2BUF] ;GET STRING TO REPLACE BY
01800 MOVEI T3,R2PNT
01900 PUSHJ P,SSTRNG
02000 JRST [CAIN C,12
02100 JRST [PUSH P,[.] ;SET UP RETURN
02200 JRST RETSTR] ;AND READ MORE (FISRT NULL)
02300 MOVEM T1,R2PNT ;NULL STRING MEANS DELETE
02400 MOVEI T2,0 ;SO SET A REAL NULL STRING
02500 IDPB T2,T1
02600 JRST .+1]
02700 SUBI T3,R2PNT ;GENERATE NUMBER OF REPLACEMENT STRINGS
02800 MOVEM T3,RSTRCT ;AND SAVE FOR LATER
02900 NOSTR: TLZ FL,NOPRN!DECID!EXCTS1 ;CLEAR FLAGS
03000 PUSHJ P,SCAN ;AND START LOOKING FOR MORE JUNK
03100 TRNN FL,TERMF ;NOTHING
03200 CAIN C,"," ;OR JUST A COMMA
03300 JRST ASMDT. ;THEN SEARCH FROM HERE TO ETERNITY
03400 CAIE C,"!" ;HE ONLY WANTS TO GIVE A STOPPING POINT
03500 CAIN C,":"
03600 JRST ASMDT.
03700 PUSHJ P,GET2 ;GO GET A RANGE
03800 REP4: MOVE T1,HILN ;SAVE FOR POSSIBLE CONTINUE
03900 MOVEM T1,RPHILN
04000 MOVE T1,HIPG
04100 MOVEM T1,RPHIPG
04200 CAIE C,"," ;IS THERE MORE?
04300 JRST REP1 ;NO
04400 PUSHJ P,SCAN ;SEE WHAT IT IS
04500 TRNN FL,IDF ;POSSIBLY AN IDENT
04600 JRST REP2 ;NO MAYBE A NUMBER OF TIMES
04700 MOVS T1,ACCUM
04800 CAIN T1,(SIXBIT/N /)
04900 TLO FL,NOPRN ;SET FOR NO PRINTING
05000 CAIN T1,(SIXBIT/D /)
05100 TLO FL,DECID ;HE WANTS TO BE ABLE TO DECIDE
05200 TLNN FL,DECID!NOPRN ;IF NEITHER
05300 JRST REP3 ;THEN TRY FOR E SWITCH
05400 PUSHJ P,SCAN ;SEE IF THERE IS MORE
05500 CAIE C,","
05600 JRST REP1 ;END OF LINE
05700 PUSHJ P,SCAN ;LOOK FOR STILL MORE
05800 TRNN FL,IDF
05900 JRST REP2
06000 MOVS T1,ACCUM
06100 REP3: CAIE T1,(SIXBIT/E /) ;IS IT THE EXACT SEARCH SWITCH
06200 NERROR ILC ;NO, LOSAGE
06300 TLO FL,EXCTS1
06400 PUSHJ P,SCAN ;ONE LAST TRY
06500 CAIE C,","
06600 JRST REP1 ;GO CHECK TERMINATOR
06700 PUSHJ P,SCAN ;ONLY ONE THING LEFT
06800 REP2: TRNN FL,NUMF
06900 NERROR ILC ;BUT IT WAS NOT
07000 MOVEM T2,RPCNT ;SAVE IT AWAY
07100 PUSHJ P,SCAN
07200 REP1: TRNN FL,TERMF ;ALLS WELL THAT ENDS WELL
07300 NERROR ILC ;BUT NOT THIS ONE
07400 REP1A: MOVEI T1,R1PNT ;GET THE SEARCH CODE
07500 PUSHJ P,CODSR
07600 MOVE T1,RPCNT ;WHATEVER IT IS, GET IT
07700 MOVEM T1,SAVCNT ;STASH IT AWAY FOR LATER
07800 MOVE T1,LOPG
07900 MOVEM T1,DPG
08000 MOVEM T1,RPPG ;FOR PRINT OUTS
08100 MOVE SINDEX,LOLN
08200 PUSHJ P,FIND ;GET THAT LIN
08300 TRZ FL,LINSN ;NOTHING YET
08400 ONREP: PUSHJ P,ONMOV ;CHECK FOR STILL IN RANGE
08500 JRST ENDREP ;FINALLY
08600 TLZE FL,ASSMF ;SHOULD WE START WITH .+1
08700 JRST [CAME T1,LOLN ;IS IT THE ONE WE ASKED FOR
08800 JRST .+1 ;NO, USE IT
08900 AOS SVCNT ;JUST IN CASE A ! TYPE OF RANGE
09000 JRST RPNXT]
09100 TRO FL,LINSN ;THIS LINE IS GOOD ENOUGH
09200 CAMN T1,PGMK
09300 JRST RPPAG ;GO TAKE CARE OF PAGE MARKS
09400 MOVEI T2,R1PNT ;DO THE SEARCH
09500 PUSHJ P,COMSRC
09600 JRST RPNXT
09700 SKIPGE T3 ;PROTECT AGAINST '%'/ KILLING TAB
09800 IBP ALTP
09900 PUSH P,T3 ;SAVE COUNT OF HOW FAR INTO LINE
10000 MOVE T3,(PNTR) ;SET UP CURRENT LINE
10100 MOVEM T3,CLN
10200 MOVE T3,CPG
10300 MOVEM T3,CPGL
10400 MOVE T2,[XWD LIBUF,LIBUF+1] ;CLEAR IT OUT
10500 SETZM LIBUF
10600 BLT T2,LIBUF+MXWPL+1 ;WE WILL DO REPLACE HERE
10700 MOVE T2,PNTR ;GET THE POINTER TO THE LINE
10800 MOVE T3,(T2) ;PICK UP THE FIRST WORD
10900 MOVEI T4,LIBUF ;THE PLACE TO PUT IT
11000 JRST SALT3A ;TRANSFER
11100
11200 SALT2A: SKIPE T3,(T2)
11300 TRNE T3,1 ;IS IT THE END OF THE LINE
11400 JRST SALT1A
11500 SALT3A: MOVEM T3,(T4) ;PUT IT AWAY
11600 ADDI T4,1
11700 AOJA T2,SALT2A
11800
11900 SALT1A: SUBI T4,LIBUF ;GET SIZE LINE USED TO BE
12000 MOVEM T4,OCNT
12100 POP P,CCNT ;GET THE NUMBER OF CHRS INTO LINE
12200 SKIPGE CCNT ;MUST BE 0
12300 SETZM CCNT
12400 SUBI ALTP,(PNTR) ;CONVERT POINTER TO LIBUF
12500 ADD ALTP,[XWD 70000,LIBUF] ;AND BACK UP ONE
12600 NXTRPL: LDB T1,[POINT 4,-1(T1),12] ;GET STRING NUMBER
12700 CAMLE T1,RSTRCT ;IS IT LARGER
12800 MOVE T1,RSTRCT ;THEN USE LAST
12900 MOVE T1,R2PNT(T1)
13000 MOVSI T4,70000 ;DECREMENT POINTER
13100 ADDM T4,SRCALP
13200 REPSTR: ILDB C,T1 ;GET THE NEXT CHR
13300 JUMPE C,ENDRP ;THE END OF THE REPLACE STRING
13400 CAIN C,"" ;DOES HE WANT ONE OF THE PARTIAL THINGS
13500 JRST PARSTR ;YES, GO HANDLE THAT
13600 CAIN C," " ;CHECK FOR QUOTING NEXT CHR
13700 JRST INSQT
13800 PUTSTR: IDPB C,ALTP ;PUT IN THE REPLACEMENT
13900 AOS C,CCNT ;ADVANCE COUNT
14000 CAIL C,MXWPL*5 ;CHECK AGAINST MAX
14100 NERROR LTL ;AND LOSE
14200 JRST REPSTR
14300
14400 ENDRP: MOVE T3,CCNT ;GET COUNT SO SEARCH CAN GO ON
14500 PUSH P,ALTP ;SAVE REPLACE POINTER
14600 PUSH P,SRCALP ;AND THE END OF INPUT POINTER
14700 MOVE ALTP,SRCALP ;CONTINUE FROM HERE
14800 ILDB T1,SRCALP ;SEE WHAT CHAR WE STOPPED ON
14900 CAIE T1,12 ;HAVE WE GONE TOO FAR?
15000 PUSHJ P,COMSRT ;THIS WILL CONTINUE
15100 JRST FINLIN ;ALL DONE WITH MATCHES, FINISH UP
15200 CAIL T3,MXWPL*5 ;ARE THERE TOO MANY?
15300 NERROR LTL
15400 POP P,T2
15500 DOMOV: ILDB C,T2 ;MOVE THE CHRS THAT DID NOT MATCH
15600 CAMN T2,ALTP ;HAVE WE GOTTEN TO THE NEXT MATCH
15700 JRST DONMOV ;YES
15800 IDPB C,(P) ;THE BYTE POINTER IS STILL IN THE STACK
15900 JRST DOMOV
16000
16100 DONMOV: MOVEM T3,CCNT ;PUT THE COUNT BACK IN CORE
16200 POP P,ALTP ;THIS IS NOW THE DEPOSIT POINTER
16300 JRST NXTRPL ;GO DO A REPLACE
16400
16500 FINLIN: POP P,SRCALP ;GET SET TO MOVE TO END
16600 POP P,ALTP
16700 ILDB C,2(P) ;WE JUST HAPPEN TO KNOW ITS STILL THERE
16800 CAIE C,12 ;IF SO WE HAVE EATEN A RETURN
16900 JRST ENDFIN ;ALL IS OK
17000 MOVEI C,15
17100 SKIPA ;SO PUT IT IN
17200 ENDFIN: ILDB C,SRCALP
17300 IDPB C,ALTP
17400 AOS CS,CCNT
17500 CAIL CS,MXWPL*5
17600 NERROR LTL
17700 CAIE C,12
17800 JRST ENDFIN ;DONE WHEN WE SEE THE LINE FEED
17900 MOVEI T1,0 ;ZERO OUT REST OF THIS LINE
18000 DOZER: TLNN ALTP,760000 ;POINTER AT END OF LINE?
18100 JRST ZEROD
18200 IDPB T1,ALTP
18300 JRST DOZER
18400
18500 ZEROD: MOVEI ALTP,1(ALTP) ;GET COUNT
18600 SUBI ALTP,LIBUF
18700 MOVEM ALTP,NCNT
18800 TLNE FL,NOPRN ;DID HE WANT PRINTING SUPRESSED
18900 JRST NOPLIN
19000 MOVE T2,CPG ;GET THIS PAGE
19100 CAMN T2,RPPG ;IS IT ONE WE STARTED ON
19200 JRST NOPPRN ;YES, DO NOT PRINT 'PAGE '
19300 MOVEM T2,RPPG ;SAVE FOR NEXT TIME
19400 PUSHJ P,PGPRN
19500 NOPPRN: MOVEI T1,LIBUF ;PRINT THE LINE
19600 PUSHJ P,OUTLIN
19700 TLNN FL,DECID ;DOES HE WANT THE OPTION OF SAYING NO
19800 JRST NOPLIN ;NO, INSERT IT
19900 TTCALL 0,T1
20000 CLRBFI
20100 ANDI T1,177
20200 TTCALL 3,ASCRLF
20300 CAIN T1,177 ;DID HE SAY RUBOUT(DO NOT INSERT)?
20400 JRST RPNXT1 ;YES, JUST IGNORE THIS LINE
20500 CAIE T1,"e" ;EITHER CASE
20600 CAIN T1,"E" ;DOES HE WANT OUT
20700 JRST ENDREP ;YES, QUIT
20800 NOPLIN: PUSHJ P,INSED ;ANYTHING ELSE IS OK
20900 PUSHJ P,FINDN ;GET NEXT
21000 PUSHJ P,FILLB ;IN CASE IT GOT LONGER
21100 SOSG RPCNT ;SEE IF OUT OF COUNT
21200 JRST SUBDUN
21300 MOVE T1,(PNTR) ;GET POINTER BACK
21400 JRST ONREP
21500 ASMD1.: TROA FL,CNTF ;MARK AS KEEP END OF RANGE
21600 ASMDT.: TRZ FL,CNTF ;JUST IN CASE
21700 TLO FL,ASSMF ;WE ASSUME .+1
21800 MOVE T1,CLN
21900 MOVEM T1,LOLN ;SET FOR HERE TO ETERNITY
22000 MOVEM T1,HILN
22100 MOVE T1,CPGL
22200 MOVEM T1,LOPG
22300 TRZE FL,CNTF ;KEEP END?
22400 JRST NOSPC.
22500 CAIE C,":" ;IF A : OR A !
22600 CAIN C,"!"
22700 JRST HAFFSP ;GET THE SECOND HALF (.+1 TO GIVEN)
22800 MOVSI T1,377777 ;GET A LARGE PAGE
22900 MOVEM T1,HIPG
23000 JRST REP4 ;ONWARD
23100
23200 HAFFSP: MOVEM T1,HIPG ;SET TO AS /.
23300 PUSHJ P,GET2HF ;GET THE SECOND HALF
23400 JRST REP4 ;AND GO
23500
23600 NOSPC.: MOVE T1,RPHIPG
23700 MOVEM T1,HIPG
23800 MOVE T1,RPHILN
23900 MOVEM T1,HILN
24000 JRST REP1A
24100
24200 INSQT: ILDB C,T1 ;GET NEXT CHR
24300 JUMPN C,PUTSTR ;MUST NOT BE 0
24400 NERROR IRS ;THIS STRING IS ILLEGAL
24500
24600 PARSTR: MOVEI CS,0 ;FIND OUT THE NUMBER
24700 PARST1: ILDB C,T1 ;GET A CHR
24800 CAIN C,"" ;CHECK FOR END
24900 JRST ENDNUM
25000 CAIL C,"0" ;MUST BE A DIGIT
25100 CAILE C,"9"
25200 NERROR IRS
25300 IMULI CS,^D10 ;CONVERT
25400 ADDI CS,-"0"(C)
25500 JRST PARST1
25600
25700 ENDNUM: CAILE CS,0
25800 CAMLE CS,ARBCNT ;IS IT IN RANGE
25900 NERROR IRS ;NO SUCH PARTIAL STRING
26000 MOVE T4,[POINT 7,ARBBUF] ;START LOOKING FOR IT
26100 SOJLE CS,FNDRST ;STARTS WITH STRING 1
26200 NXTST: ILDB C,T4
26300 JUMPN C,NXTST ;0 IS END OF A PARTIAL STRING
26400 SOJG CS,NXTST ;LOOK FOR CORRECT STRING
26500 FNDRST: ILDB C,T4 ;NOW INSERT THAT STRING
26600 JUMPE C,REPSTR ;GO FINISH THE REPLACEMENT STRING
26700 IDPB C,ALTP
26800 AOS C,CCNT
26900 CAIL C,MXWPL*5
27000 NERROR LTL
27100 JRST FNDRST
27200
27300 RPNXT1: SOSG RPCNT
27400 JRST SUBDUN
27500 RPNXT: PUSHJ P,FINDN
27600 JRST ONREP ;CONTINUE LOOKING AT LINES
27700
27800 ENDREP: TRZN FL,LINSN ;WERE THERE ANY?
27900 NERROR NLN
28000 SUBDUN: MOVE T1,SAVCNT ;PICK UP THE ORIGINAL VALUE
28100 SUB T1,RPCNT ;LESS THE DECREMENTED VALUE
28200 MOVEM T1,SAVCNT ;SAVE IT IN CASE HE ASKS FOR IT
28300 JRST COMND
28400
28500 RPPAG: AOS CPG ;JUST ADVANCE PAGE COUNTER
28600 JRST RPNXT
00100 SUBTTL XPAND COMMAND
00200
00300 FAKBUF: -1 ;FAKE BUFFER HEADER FOR EXPAND STRING
00400 POINT 7,LIBUF ;THE IMPORTANT PART
00500 MXWPL*6 ;END OF THE FAKE HEADER
00600
00700 XPAND: PUSHJ P,RDTXT ;GET SET UP FOR A STRING INPUT
00800 PUSHJ P,RDL1 ;GET THE LINE
00900 JRST XPSAV ;ALTMODE FOUND MEANS WE HAVE A STRING
01000 CAIN T2,5*MXWPL-2 ;MUST NOT BE A TERMINATOR
01100 JRST [OUTSTR [ASCIZ "
01200 *ILLEGAL COMMAND*
01300 "]
01400 JRST COMND]
01500 MOVE SINDEX,[XWD TIBUF,TEMP1] ;SAVE INPUT STUFF
01600 BLT SINDEX,TEMP3 ;HANDY PLACE
01700 MOVE SINDEX,[XWD FAKBUF,TIBUF] ;FAKE OUT INPUT ROUTINE
01800 BLT SINDEX,TIBUF+2 ;MAKE IT REREAD
01900 PUSHJ P,GET2S ;DIG IT OUT
02000 MOVS SINDEX,[XWD TIBUF,TEMP1] ;REUSE LITERAL
02100 BLT SINDEX,TIBUF+2 ;RESET INPUT POINTER
02200 SKIPA
02300 XPMOR: PUSHJ P,GET2S ;THE RANGE
02400 TRNN FL,TERMF
02500 NERROR ILC
02600 TRZ FL,LINSN
02700 MOVE T1,LOPG
02800 MOVEM T1,DPG
02900 MOVE SINDEX,LOLN
03000 PUSHJ P,FIND
03100 XPND1: PUSHJ P,ONMOV ;STILL IN RANGE?
03200 JRST EXPEND
03300 TRO FL,LINSN
03400 CAMN T1,PGMK ;IGNORE THESE
03500 JRST XPAGE
03600 MOVEM T1,CLN
03700 MOVE T1,CPG
03800 MOVEM T1,CPGL ;SET LINE AND PAGE
03900 PUSHJ P,XPGUTS ;GO DO THE ACTUAL WORK
04000 JRST XPND1
04100 XPAGE: AOS T2,CPG
04200 MOVEM T2,CPGL
04300 PUSHJ P,PGPRN ;SEE ALTER COMMAND
04400 MOVE T1,[<ASCII /00000/>!1]
04500 MOVEM T1,CLN
04600 JRST EXPND2
04700
04800 EXPEND: TRNN FL,LINSN
04900 NERROR NLN
05000 JRST COMND
05100
05200 XPSAV: TRO FL2,ALTFLG ;REMEMBER TO USE THE STRING
05300 SUBI T2,5*MXWPL-2 ;GET NEGATIVE LENGTH
05400 JUMPE T2,XPMOR ;DEFAULT TO LAST STRING
05500 MOVN T2,T2 ;MAKE IT POSITIVE
05600 IDIVI T2,5 ;HOW MANY WORDS?
05700 MOVE SINDEX,[XWD LIBUF,XPSTR] ;SAVE IT
05800 BLT SINDEX,XPSTR(T2) ;NOTE THAT IT ENDS IN ZERO
05900 MOVEM T2,XPLEN ;JUST IN CASE
06000 JRST XPMOR ;GO GET THE REST OF THE COMMAND
06100
06200 ;THE CORE OF THE EXPANSION PROCESS. CALLED BY AN "F" COMMAND OPTION AS WELL.
06300 XPGUTS: PUSHJ P,RDTXT ;CLEAR FOR INPUT
06400 SETZM OCNT ;GET READY TO CHOP OFF CR-LF
06500 HRR T1,PNTR ;POINT TO THE START OF THIS LINE
06600 SKIPA
06700 XP1: PUSHJ P,OCHR ;PRINT THAT CHAR.
06800 ILDB C,T1 ;GET A CHR
06900 CAIE C,15 ;IS IT THE CR RET?
07000 SOJA T2,XP1 ;NO, CONTINUE
07100 ADD T1,[70000,,0] ;SO WILL REWRITE OVER CR-LF
07200 HRRZ SINDEX,T1 ;SAVE POINTER TO END OF LINE
07300 MOVE T3,(T1) ;PUT THE TAIL IN THE BUFFER
07400 MOVEM T3,LIBUF ;SAVE IT IN LIBUF FOR REINSERTION
07500 HRRI T1,LIBUF ;RESET POINTER TOWARDS LIBUF
07600
07700 XP3: HLRZ T4,T1
07800 CAIN T4,(POINT 7,,27)
07900 AOS OCNT ;ZAP 2 WORDS
08000 AOS OCNT ;ZAP AT LEAST ONE WORD
08100 ;NOW T1 POINTS TO LIBUF, READY FOR THE FREE STRING
08200 TRNN FL2,ALTFLG ;IF ANY
08300 JRST XP5 ;NO FREE STRING
08400 MOVE T3,[POINT 7,XPSTR]
08500 XP4: ILDB C,T3 ;MOVE THE FREE STRING
08600 CAIN C, ;IS IT THE END?
08700 JRST XP5 ;YES
08800 IDPB C,T1 ;PUT IT INTO LIBUF
08900 PUSHJ P,OCHR ;AND TYPE IT
09000 SOJA T2,XP4 ;NEXT
09100
09200 XP5: PUSHJ P,TTYOUT ;FORCE TYPEOUT NOW
09300 PUSHJ P,RDL1 ;GET THE INSERT
09400 JRST LEVINS ;ABORT, ABORT, ABORT SAW ALTMODE
09500 HRRZ PNTR,SINDEX ;RESET TO TRUNCATE
09600 MOVEM T1,NCNT ;THE NEW COUNT (BY MAGIC)
09700 PUSHJ P,INSED ;PUT IN CHANGED LINE
09800 EXPND2: PUSHJ P,FINDN
09900 PUSHJ P,FILLB ;IN CASE OF OVERFLOW
10000 MOVE T1,(PNTR) ;GET BACK NEXT LINE
10100 POPJ P, ;RETURN
00100 SUBTTL JOIN COMMAND
00200
00300 JOIN: SETZM HILN ;GET ONLY ONE LINE
00400 TRNE FL,READOF ;NOT IN READ ONLY
00500 NERROR ILC
00600 PUSHJ P,GET1S
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 MOVE T2,PNTR ;GET THE POINTER TO THE LINE
02100 MOVE T3,(T2) ;PICK UP THE FIRST WORD
02200 MOVEI T4,LIBUF ;THE PLACE TO PUT IT
02300 JRST SALT3B ;TRANSFER
02400
02500 SALT2B: SKIPE T3,(T2)
02600 TRNE T3,1 ;IS IT THE END OF THE LINE
02700 JRST SALT1B
02800 SALT3B: MOVEM T3,(T4) ;PUT IT AWAY
02900 ADDI T4,1
03000 AOJA T2,SALT2B
03100
03200 SALT1B: MOVEI T1,(T4)
03300 SUBI T1,LIBUF
03400 MOVEM T1,OCNT
03500 IMULI T1,5 ;GET COUNT OF CHRS
03600 SUBI T1,6 ;WE WILL HAVE TO FIND THE TRUE END
03700 SUBI T4,2
03800 HRLI T4,(<POINT 7,0,27>) ;SET UP POINTER
03900 FEND1: ILDB T2,T4
04000 CAIE T2,15
04100 AOJA T1,FEND1
04200 PUSH P,T1
04300 PUSHJ P,FINDN ;GET THE LINE TO JOIN IT TO
04400 CAME T1,PGMK
04500 SKIPN T1
04600 NERROR NNN ;NO LINE THERE TO CONNECT TO
04700 POP P,T2 ;COUNT
04800 MOVEI T1,1(PNTR)
04900 HRLI T1,(<POINT 7,0,6>) ;SET TO POINT THERE
05000 ADD T4,[XWD 70000,0]
05100 TRN1.: ILDB T3,T1
05200 IDPB T3,T4
05300 ADDI T2,1
05400 CAIL T2,MXWPL*5+6
05500 NERROR LTL
05600 CAIE T3,12
05700 JRST TRN1.
05800 SUBI T1,-1(PNTR)
05900 PUSH P,OCNT
06000 HRRZM T1,OCNT ;SIZE OF OLD SECOND LINE
06100 SETZM NCNT
06200 PUSHJ P,INSED
06300 PUSHJ P,FINDB ;BACK UP
06400 POP P,OCNT ;GET ITS SIZE
06500 SUBI T4,LIBUF-1
06600 HRRZM T4,NCNT
06700 PUSHJ P,INSED
06800 JRST COMND
00100 SUBTTL THE AREA FOR LITERALS AND INIT OF LOWSEG
00200
00300 XLIST
00400 LIT
00500 LIST
00600
00700
00800 RPGR%: SIXBIT /SYS/
00900 SIXBIT /COMPIL/
01000 BYPPI%: BYTE (7)15,15,15,15,15 ;MAKE SURE BUFFER TERMINATES
01100 PGHS: BYTE (7)14,11,11,11,11
01200 ASCII / /
01300 ASCII / /
01400 BYTE (7)40,40,40,40,15
01500 ASCIZ /PAGE /
00100 SUBTTL IMPURE AREA
00200
00300 RELOC 0
00400
00500 LOWBEG: BLOCK 0 ;START CLEARING HERE
00600 BLOCKS<DATEX,LPTFFS>
00700 TOBUFF: BLOCK 30
00800 BLOCKS <SVWD2,TMPT1,BUFHD,BUFP>
00900 BLOCKS<EDNAM,CORTOP,FILPT,MAXWC,HLFWC,CLN,CURINS>
01000 BLOCKS<CPG,CPGL,IPG,INPG,SVWD,OLDLIN,CASEBT,WC,BGPG,ACCUM>
01100 BLOCKS<SVT1E,SVERN,SAVCHR,SVWD3,REINC,INCST,ALTCNT,LOGPG>
01200 BLOCKS<LSTCNT,SVCCNT,LASDEL>
01300 BLOCKS<TTYBUF,DPG,HILN,HIPG,LOLN,LOPG>
01400 BLOCKS<ORGDEV,ORGNAM,ORGEXT,ORGPRO,ORGPPN>
01500 BLOCKS<SVINC,SVCNT,OCNT,NCNT,SRCALP,SVALTP,TEMPP,SVPT,BUFSAV>
01600 BLOCKS<SAVCNT,COMNDS,OVRDRW>
01700 SRBUF: BLOCK SRBLG/5+2
01800 SRPNT: BLOCK SRNUM
01900 CODEBF: BLOCK 4*SRNUM+2
02000 R1BUF: BLOCK SRBLG/5+2
02100 R2BUF: BLOCK SRBLG/5+2
02200 R1PNT: BLOCK SRNUM
02300 R2PNT: BLOCK SRNUM
02400 ALTBF: BLOCK 3
02500 ARBBUF: BLOCK MXWPL*2+1
02600 BLOCKS<ARBCNT,SRHIPG,SRHILN,SRCNT,SRPG,ALTINC>
02700 BLOCKS<BOTLIN,PGDELS,STARTD,ENDD,TRANST,PGINSD>
02800 BLOCKS<DESTLN,DESTPG,FINCR,SINCR,SVLNUM,LSTPG,SVJRL>
02900 BLOCKS<SVJRL2,COPDL,HIGH1,NLIN1,NLIN2,DESTN,LSTLN,RPPG>
03000 BLOCKS<RPCNT,RPHILN,RPHIPG,CCNT,RSTRCT>
03100 LOBUF: BLOCK 3
03200 TIBUF: BLOCK 3 ;TTY INPUT
03300 TOBUF: BLOCK 3 ;TTY OUTPUT
03400 OBUF: BLOCK 3 ;DISK OUTPUT
03500 IBUF: BLOCK 3 ;DISK INPUT
03600 NAMDEV: BLOCK 1
03700 NAMI: BLOCK 4 ;INPUT NAME
03800 NAMO: BLOCK 4 ;OUTPUT NAME
03900 PDL: BLOCK 40 ;PUSHDOWN LIST
04000 RPGR: BLOCK 1 ;SIXBIT /SYS/
04100 BLOCK 1 ;SIXBIT /COMPIL/
04200 BLOCK 4
04300 TMPBUF: BLOCK 20
04400 STRSBN: BLOCK 2 ;PLACE FOR ASCII NAME OF STRUCTURE
04500 STRNAM: BLOCK 12
04600 BSTSIZ: BLOCK 1
04700 BSTSTR: BLOCK 1
04800 BLOCKS <TEMP1,TEMP2,TEMP3>
04900 INCR: BLOCK 1
05000 TERMN1: BLOCK 1
05100 TERMN2: BLOCK 1
05200 XPLEN: BLOCK 1
05300 XPSTR: BLOCK MXWPL+2 ;DEFAULT EXPAND STRING
05400 LIBUF: BLOCK MXWPL+2 ;LINE INPUT BUFFER
05500 BYPPI: BLOCK 1 ;BYTE (7) 15,15,15,15,15 ;MAKE SURE BUFFER TERMINATES
05600 LIBUF2: BLOCK MXWPL+2
05700 LPTBUF: BLOCK 2*203+1
05800 PGHD: BLOCK 10
05900 XLOOK: BLOCK 17 ;EXTENDED LOOKUP AREA
06000 ERRHD: BLOCK 1
06100 BLOCK 1 ;JRST DOUUO
06200 LOWEND: BLOCK 1 ;STOP CLEARING HERE
06300
06400 NOSYM
06500 END STPT