Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50374/sos.b03
There are no other files named sos.b03 in the archive.
00100 TITLE SOS - SON OF STOPGAP %23(220)
00150 SUBTTL WM.FRANKLIN/WJF 27-JAN-76
00200
00300 ;*** COPYRIGHT 1973,1974 DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ***
00310
00320 ;*** MODIFICATIONS COPYRIGHT (C) 1975,1976, THE BROOKINGS INSTITUTION, WASHINGTON, D.C.
00400
00500 SUBTTL DEFINITIONS
00600
00700 WHOSOS==0 ;LAST EDITED BY TAH
00800 VERSOS==23
00900 PATSOS==0 ;PATCH LEVEL
01000 MODSOS==220 ;EDIT LEVEL
01001
01002 SSCCVERSION==3 ;CURRENT SOS VERSION
01003 SSCCSWITCH==74 ;HIGHEST SSCC SWITCH
01004
01005 ; ASSEMBLY PARAMETERES
01006
01007 JUSTSW==0 ;NO JUSTIFY
01008 CRYPSW==1 ;FOR ENCRYPTION
01009 SRNUM==^D10 ;NUMBER OF PARALLEL SEARCH STRINGS
01010 PPNTSW==0 ;NO PRETTY PRINTING
01011 EXTEND==0 ;NO CONTEXT LINE SEARCH - SEE %SS055
01012
01013 %SS001==1 ;ADD "B" & "BP" COMMANDS
01014 ; %SS002-%SS004 OBSOLETE
01015 %SS005==1 ;IMPROVEMENTS TO ALTER COMMAND
01016 %SS006==1 ;IMPROVEMENTS TO FILE HANDLING
01017 IFNDEF FTIMPCPY, <FTIMPCPY==1>;"IMPLIED COPY FEATURE" PRESENT
01018 ; %SS007 OBSOLETE
01019 %SS010==1 ;ONLY APPLY LOWER/UPPER SWITCH TO _C128 CHARS
01020 ; %SS011 OBSOLETE
01021 %SS012==1 ;IMPROVEMENTS TO @-FILE HANDLING
01022 ; %SS013 OBSOLETE
01023 %SS014==1 ;IMPROVEMENTS TO RANGE & LINE SYNTAX (./. DEFAULT)
01024 ; %SS015-%SS016 OBSOLETE
01025 %SS017==1 ;REMEMBER TEMP INCR FOLLOWING I & R CMDS
01026 %SS020==1 ;PRINT LINES DELETED MESSAGE FOR T CMD; BEFORE
01027 ; INSERTING FOR R CMD
01028 %SS021==1 ;SUPPRESS <HT> WHEN TYPING A NULL LINE
01029 %SS022==0 ;MAKE 'Q' EQUIVALENT TO 'EQ' (NOT IMPLEMENTED)
01030 %SS023==1 ;ON ENTRY, DON'T TYPE THE FILE SPEC IF TYPED
01031 ;BY THE USER IN RESPONSE TO "FILE: "
01032 %SS024==1 ;TYPE A SHORTER 'SAVING' MESSAGE IF EXPERT
01033 %SS025==1 ;MAKE THE _C128 CHARACTER BE A PARAMETER
01034 IFNDEF DFC128,<DFC128=="?"> ;DEFAULT _C128 CHAR IS "?"
01035 %SS026==1 ;FOR N, IF START OF RANGE IS NOT THE
01036 ; START OF THE PAGE AND NOT STARTING LINE #
01037 ; IS GIVEN, MAKE START OF RANGE BE STARTING LINE #
01038 %SS027==1 ;USE 'INCR' AS DEFAULT INCREMENT ALWAYS, USE
01039 ; 'START' AS DEFAULT STARTING LINE # (NEW PAGE)
01040 %SS030==1 ;DEFAULT 'COPY-FROM-FILE' FILE SPEC TO BE
01041 ; THE PREVIOUS COPY FILE SPEC
01042 %SS031==1 ;IMPROVEMENTS IN T & C COMMAND
01043 %SS032==1 ;FOR SUCCESSIVE "P<CR>" CMDS, DON'T RETYPE
01044 ; CURRENT LINE
01045 %SS033==1 ;MAKE "." COMMAND MORE FLEXIBLE
01046 %SS034==1 ;MAKE 'W' IN @-FILE MODE WORK
01047 %SS035==1 ;PERFORMANCE IMPROVEMENTS
01048 %SS036==1 ;ADD 'CREATE' FEATURE
01049 %SS037==1 ;"DECIDE" OPTION IMPROVEMENTS - CONFIRMATION MSG
01050 %SS040==1 ;"EXACT" OPTION FOR A & X COMMANDS
01051 %SS041==1 ;"/DECIDE" SWITCH IMPROVEMENTS
01052 %SS042==1 ;COMMAND MODIFIERS IN ANY ORDER - P,F,A,S,X,LINE SEARCH
01053 %SS043==1 ;IMPROVEMENTS TO F,S,LINE SEARCH DEFAULT RANGE & COUNT
01054 IFNDEF DEFCRL, <DEFCRL==1> ;RANGE DEFAULTS TO CURRENT LINE WHEN STRING GIVEN
01055 %SS044==1 ;ADDITIONAL PATTERN MATCHING FUNCTIONS
01056 %SS045==1 ; ";" COMMENT LINE AS SOS COMMAND
01057 %SS046==1 ;"EX", "ET", "EN" EXIT OPTIONS, /TEXT SWITCH
01058 %SS047==1 ;BASIC LANGUAGE SUPPORT
01059 %SS050==1 ;ADD /CORE SWITCH, TO SPECIFY IN-CORE BUFFER SIZE
01060 IFNDEF DEFCOR, <DEFCOR==3*^D1024/2> ;DEFAULT BUFFER SIZE IS 1.5K
01061 %SS051==1 ;^C TRAP IMPROVEMENTS
01062 %SS052==1 ;COMPRESSED-FILE OPTION
01063 IFNDEF DEFBLK, <DEFBLK==0> ;DEFAULT: 0=LINE BLOCK, -1=COMPRESS
01064 %SS053==1 ;CONSISTENT RANGE DEF'N FOR D,R,T,C,K
01065 %SS054==1 ;CANNOT INSERT LINE #0
01066 %SS055==1 ;EXTENDED FIND(F) FUNCTIONS
01067 %SS056==1 ;COMMON ROUTINES FOR SPACE-SAVING
01068 %SS057==1 ;STANFORD CASE-INVERSION COMMANDS
01069 %SS060==1 ;"?\" AS <RUBOUT> C128 TYPE-IN CHARS
01070 %SS061==1 ;SET TEMPORARY "DSKFUL PAUSE" IN LIEU OF QUOTA CHECKING
01071 %SS062==1 ;CONFIMATION ON "ED" EXIT
01072 %SS063==1 ;MAKE "P ,S" WORK WHEN /NONUMBER SET
01073 %SS064==1 ;BETTER P/M HANDLING FOR TECO FILES
01074 %SS065==1 ;FORCE /UPPER IF "TTY LC" SET BUT NOT "M37"
01075 %SS066==1 ;U OF I-TYPE SAIL INTERFACE
01076 IFN %SS066, <CCLSW==1> ;SAIL NEEDS CCL SUPPORT
01077 %SS067==1 ;ASSEMBLY SWITCH FOR DEFAULT /BAK SETTING
01078 IFNDEF DEFBAK, <DEFBAK==-1> ;-1=/BAK, 0=/NOBAK, +1=/OLD
01079 %SS070==1 ;"FIND NOT" FACILITY
01080 %SS071==%SS006 ;SET .RBEST TO OPTIMIZE FILE ALLOCATION
01081 %SS072==1 ;SYMBOLIC RANGE DEFINITIONS ("BF"/"EF")
01082 %SS073==1 ;"=COLUMN" TO PRINT COLUMN MASK
01083 %SS074==1 ;"ILLEGAL WHEN READONLY" ERROR
01100
01200 ; EDITOR FOR THE DISK -- WORKS BY RECOPYING FILES USED
01300
01400 MLON ;MULTI-LINE THINGIES
01500 SALL ;SUPPRESS MACRO XPANSIONS
01600 ;;;; .HWFRMT ;READABLE LISTING ;** FIX **
01700
01800 IFNDEF LSTSW,<LSTSW==1 ;FOR L COMMAND>
01900 IFNDEF JUSTSW,<JUSTSW==0 ;FOR TEXT JUSTIFICATION>
02000 IFNDEF RENTSW,<RENTSW==1 ;FOR RE-ENTRANT VERSION>
02100 IFNDEF CCLSW,<CCLSW==1 ;FOR CCL FEATURES>
02200 IFNDEF TEMPC,<TEMPC==1 ;FOR TEMPCORE FEATURE>
02300 IFNDEF CRYPSW,<CRYPSW==0 ;FOR ENCRYPTED FILES>
02400 IFNDEF EXTEND,<EXTEND==1 ;FOR EXTENDED FEATURES>
02500 IFNDEF PPNTSW,<PPNTSW==0 ;FOR PRETTY PRINT FEATURES>
02600
02700 IFN RENTSW,< TWOSEG
02800 RELOC 400000 >
02900
03000 INTERN .JBVER
03100 .JBVER==137
03200 LOC .JBVER
03300 BYTE (3)WHOSOS (9)VERSOS (6)PATSOS (18)MODSOS
03400 RELOC
03500
03600 OPDEF OCRLF [OUTSTR [BYTE (7)15,12]]
03700 OPDEF ONECHO [SETSTS TTY,1]
03800 OPDEF OFFECHO [SETSTS TTY,201]
03900
04000 ;I/O CHANNELS
04100
04200 TTY==1 ;CHL FOR TTY
04300 IN==2
04400 OUT==3
04500 LPT==4
04600 ALTDV==5 ;THE OTHER INPUT DEVICE (COPY AND TRANSFER)
04700 IND==6 ;INDIRECT CHL FOR "@" CMD
04800 OPT==7 ;CHL FOR OPTION FILE
04900
05000 ;ACS USED
05100
05200 JF=0 ;TEMP FLAGS FOR JUSTIFY & PRETTY PRINT
05300 T1=1 ;TEMP REGISTERS
05400 T2=2
05500 T3=3
05600 T4=4
05700 T5=5
05800
05900 FL=10 ;FLAG REGISTER
06000 FL2=11
06100 ALTP=12 ;POINTER FOR ALTER MODE
06200 CS=13 ;CHARACTER TABLE BITS
06300 SINDEX=14 ;LINE TO FIND, USED ALSO BY THE VARIOUS ROUTINES
06400 PNTR=15 ;POINTS AT CURRENT PLACE IN BUFFER
06500 C=16 ;CHARACTER RETURNED HERE BY GNCH
06600 P=17 ;PUSHDOWN LIST
06700
06800 ;FLAGS (RIGHT HALF)
06900
07000 BOF==1 ;NOW ON FIRST RECORD OF FILE
07100 EOF==2 ;HAVE READ END OF FILE BUT NOT NECESSARILY BUT IN BUFFER
07200 EOF2==4 ;LAST WORD OF FILE IS IN CURRENT BUFFER
07300 ADDL==10 ;USED IN COMMAND SCANNING--LINE NUMBER + INC
07400 SUBL==20 ;LINE NUMBER - INC
07500 IDF==40 ;SCAN HAS SEEN AN IDENTIFIER
07600 NUMF==100 ;SCAN HAS SEEN A NUMBER
07700 TERMF==200 ;SCAN SAW A TERMINATOR (LF OR ALTMODE)
07800 LINSN==400 ;THE COMMAND INPUT ROUTINES SAW A LINE NUMBER
07900 PGSN==1000 ;THEY SAW A PAGE NUMBER
08000 NEWFL==2000 ;NEW FILE NAME SEEN BY END CODE
08100 ORDF==4000 ;LINES OUT OF ORDER (USED BY NUMBER)
08200 BGSN==10000 ;BIGGEST PAGE HAS BEEN SEEN
08300 M37F==20000 ;THIS IS A MODEL 37
08400 CNTF==40000 ;COMMAND USING !
08500 DPYF==100000 ;THIS IS A DISPLAY
08600 READOF==200000 ;THIS FILE IS BEING USED IN READ ONLY MODE
08700 EXTOG==400000 ;ON FOR SHORT ERROR MESSAGES
08800
08900 ;SPECIAL FLAGS FOR PARSE CODE
09000
09100 F.LAHD==1 ;LOOK-AHEAD FLAG
09200 F.PER==2 ;PERIOD SEEN
09300 F.SLSH==4 ;SLASH SEEN
09400 F.CDSN==10 ;CODE SEEN
09500 F.PPN==20 ;PPN SEEN
09600 F.COLN==400 ;COLON SEEN
09700 F.EQL==1000 ;EQUAL SIGN SEEN
09800 F.ANY==2000 ;ANY ATOM SEEN BEFORE EOL
09810 IFN %SS006, <
09820 F.PROT==4000 ;PROTECTION SEEN
09830 >; END OF IFN %SS006
09900
10000 P.FLGS==F.LAHD!F.PER!F.SLSH!F.CDSN!F.PPN!F.COLN!F.EQL!F.ANY!IFN %SS006,<F.PROT>
10100
10200 IFNDEF CODMAX, <CODMAX==^D20> ;MAX CHARS IN CODE
10300 IFNDEF SFDLVL, <SFDLVL==6> ;MAX SFD LVL
10400
10500 D==PNTR
10600 S1==PNTR ;SPECIAL ACS
10700 S2==SINDEX
00100 ;FLAGS (LEFT HALF)
00200
00300 NEGF==1 ;SEARCH HAS SEEN A
00400 DEMCHR==2 ;SEARCH MUST SEE ANOTHER CHARACTER
00500 ASSMF==4 ;SEARCH HAS ASSUMED SEARCH CONTINUATION
00600 ALTSRF==10 ;HE WANTS TO DO A SEARCH AND EDIT
00700 NUMSRF==20 ;HE ONLY WANTS NUMBERS OF LINES FOUND
00800 ARBITG==40 ;WE ARE DOING CURRENTLY, DO NOT ALLOW ANOTHER
00900 EXCTSR==100 ;WANTS TO SEARCH EXACTLY (NOT IGNORE CASE)
01000 COPFIL==200 ;WE ARE COPYING FROM ANOTHER FILE
01100 ISCOP==400 ;WE ARE DOING A COPY
01200 NOPRN==1000 ;DO NOT PRINT WHILE DOING SUBSTITUTE
01300 DECID==2000 ;ALLOW USER TO DECIDE IF LINE IS OK
01400 EXCTS1==4000 ;ANOTHER EXACT SEARCH FLAG FOR SUBS
01500 QMODF==10000 ;DO NOT TREAT ? AS A SPECIAL CASE ON INPUT
01600 GCOM==20000 ;DOING A G COMMAND INSTEAD OF E
01700 SRCOP==40000 ;DOING A SEARCH OF SECOND FILE
01800 TRANFL==100000 ;THIS IS A TRANSFER COMMAND WHICH HAS DELETED LINES
01900 TECOF==200000 ;THIS IS A TECO FILE
02000 FSTOPF==400000 ;THIS IS THE FIRST READ OP ON THIS FILE
02100
02200 ;FLAGS IN FL2 (RIGHT)
02300
02400 STARF==1 ;WE HAVE SEEN A * FOR THE LAST LINE
02500 RUBF==2 ;WE ARE DOING RUBOUT IN INTRA-LINE EDIT
02600 ALTDUP==4 ;DUPLEX CHARACTERS IN ALTER MODE
02700 RUBF2==10 ;DOING DELETE TYPE RUBOUT IN ALTER MODE
02800 SVIT==20 ;WE ARE DOING A "W" COMMAND (SAVE WORLD)
02900 NONUMF==40 ;SUPPRESS LINE NOS FOR P,R,I CMDS
03000 ACONST==100 ;ADD CONSTANT FOR R COMMAND
03100 MONOF==200 ;MONOTONIC RENUMBERING - NO REST AT P.M.
03190 IFE %SS005, <
03200 ;UNUSED (400)
03210 >; END OF IFE %SS005
03220 IFN %SS005, <
03230 ALTBOL==400 ;BEGINNING OF LINE FOR ALTER MODE
03240 >; END OF IFN %SS005
03300 SUPN==1000 ;SUPPRESS LISTING OF LINE NUMBERS
03390 IFE %SS040, <
03400 ;UNUSED (2000)
03410 >; END OF IFE %SS040
03420 IFN %SS040, <
03430 DOEXCT==2000 ;DO EXACT CHARACTER MATCHING
03440 >; END OF IFN %SS040
03490 IFE %SS051, <
03500 ;UNUSED (4000)
03510 >; END OF IFE %SS051
03520 IFN %SS051, <
03530 CMDWAT==4000 ;WAITING FOR NEXT COMMAND
03540 >; END OF IFN %SS051
03600 QSEPF==10000 ;TREAT . % $ AS SEPARATORS
03700 COMFLF==20000 ;READ COMMANDS FROM FILE
03710 IFN %SS057, <
03720 INVFL==40000 ;CASE INVERSION IN EFFECT
03730 INVFRC==100000 ;FORCE TO LOWER CASE
03740 INVUP==200000 ;FORCE TO UPPER CASE
03750 INVFGS==INVFL!INVFRC!INVUP ;ALL CASE INVERSION FLAGS
03760 >; END OF IFN %SS057
03770 IFN %SS063, <
03780 SPNRQT==400000 ;"P ,S" TYPED
03790 >; END OF IFN %SS063
03800
03900 ;FLAGS IN FL2 (LEFT)
04000
04100 PDECID==1 ;PERM DECIDE MODE FOR S
04200 UARWF==2 ;UP ARROW (^) SEEN FOR FIRST LINE
04290 IFE %SS064, <
04300 ;UNUSED (4)
04310 >; END OF IFE %SS064
04320 IFN %SS064, <
04330 PMINSF==4 ;P/M INSERTED INTO A TECO FILE
04340 >; END OF IFN %SS064
04400 NORENT==10 ;DON'T ALLOW REENTER
04500 RENTF==20 ;REENTER COMMAND TYPED
04600 BELLF==40 ;ALLOW <BELL><BELL>
04700 BELLSN==100 ;<BELL> SEEN
04800 AUTOF==200 ;AUTO SAVE IN PROGRESS
04900 DSKCK==400 ;CHECK DISK QUOTAS
05000 SLPSW==1000 ;SLEEPING UNTIL DISK SPACE APPEARS
05100 DOENDF==2000 ;E CMD REQUESTED
05200 INOPTF==4000 ;READING OPTION FILE
05300 INPARS==10000 ;DOING INITIAL PARSE
05400 PCHGF==20000 ;FILE HAS CHANGED THIS PASS
05500 FCHGF==40000 ;FILE HAS CHANGED THIS EDIT
05600 CCHGF==100000 ;THIS COMMAND HAS CHANGED THE FILE
05700 FSEQF==200000 ;ORIGINAL FILE HAD SEQ #'S
05710 IFN %SS070, <
05720 FNDNOT==400000 ;"FIND NOT" REQUESTED
05730 >; END OF IFN %SS070
05800
05900 ALLCHG==PCHGF!FCHGF!CCHGF ;ALL FLAGS AFFECTING FILE CHANGE
06000
06100 ;FLAGS FOR JF (RIGHT)
06200
06300 JFFLG==1 ;J DOES FILL ONLY
06400 JRFLG==2 ;J DOES RIGHT JUSTIFY
06500 JCFLG==4 ;J DOES CENTERING
06600 JBLF==10 ;J SEES A BLANK
06700 JLFLG==20 ;J DOES LEFT JUSTIFY
06800 JPER==40 ;J SEES A PERIOD OR SOMETHING LIKE IT
06900 JWFLG==100 ;J DOES FILL WORDS ONLY
07000 EJECT==200 ;EJECT AFTER PAGES
07100 WAIT==400 ;WAIT FOR CR AFTER PAGES
07200 PGNOS==1000 ;PAGE NUMBERS AT BOTTOM
00100 OPDEF ERROR [1B8] ;ERROR UUOS FATAL ERROR
00200 OPDEF NERROR [2B8] ;NON-FATAL ERROR
00300 OPDEF RERROR [3B8] ;PRINT MESSAGE AND RETURN
00400 OPDEF XLOOK [4B8] ;EXTENDED LOOKUP
00500 OPDEF XENTR [5B8] ;EXTENDED ENTER
00600 OPDEF XRENM [6B8] ;EXTENDED RENAME
00700 MAXUUO==6
00800
00900 ;ERROR NUMBERS
01000
01100 ICN==1 ;INTERNAL EDITRO CONFUSION
01200 DIE==2 ;DEVICE INPUT ERROR
01300 DDE==3 ;DEVICE OUTPUT ERROR
01400 ILC==4 ;ILLEGAL COMMAND
01500 ILUUO==5 ;PROTECTION. SOMEONE EXECUTED AN ILLEGAL UUO
01600 LTL==6 ;LINE IS TOO LOGNNG
01700 NLN==7 ;NULL COMAND RANGE
01800 NSP==10 ;NO SUCH PAGE (DELETE)
01900 ORDER==11 ;LINES OUT OF ORDER
02000 UNA==12 ;LPT NOT AVAILABLE FOR L COMMAND
02100 ILR==13 ;ILLEGAL REPLACEMENT WITH INSERT
02200 WAR==14 ;WRAP AROUND IN RENUMBERING
02300 TMS==15 ;TOO MANY SEARCH STRINGS GIVEN
02400 STL==16 ;TOO MANY TOTAL STRING CHRS
02500 ISS==17 ;ILLEGAL SEARCH STRING
02600 ILFMT==20 ;ILLEGAL LINE FORMAT DETECTED
02700 NSG==21 ;NO STRING GIVEN
02800 FNF==22 ;FILE NOT FOUND (COPY)
02900 DNA==23 ;DISK NOT AVAILABLE (COPY)
03000 NEC==24 ;NOT ENOUGH CORE (COPY)
03100 IRS==25 ;ILLEGAL REPLACEMENT STRING
03200 STC==26 ;SEARCH STRING TOO COMPLEX (GOT PDLOV)
03300 ITD==27 ;ILLEGAL TRANSFER DESTINATION (PLACE NO LONGER THERE)
03400 NNN==30 ;NO NEXT LINE (FROM JOIN TYPE COMMANDS)
03500 SRF==31 ;SEARCH FAIL (F AND S COMMANDS)
03600 CMERR==32 ;ERROR IN COMMAND FILE
03700 CMEND==33 ;EOF SEEN IN COMMAND FILE
03800 MAR==34 ;RMAR MUST BE GREATER THAN LMAR AND PMAR
03900 BBF==35 ;FUNNY STUFF IN "BASIC" MODE (FATAL)
03910 IFN %SS026, <
03920 ISLN==36 ;ILLEGAL STARTING LINE NUMBER (N)
03930 >; END OF IFN %SS026
03940 IFN %SS074, <
03950 IRO==36+%SS026 ;ILLEGAL WHEN READONLY
03960 >; END OF IFN %SS074
04000
04100 IFNDEF SRBLG, <SRBLG==^D200> ;NUMBER OF CHRS ALLOWED IN SEARCH STRING
04200 IFNDEF SRNUM, <SRNUM==6> ;NUMBER OF SEARCH STRINGS ALLOWED
04210 IFG SRNUM-17, < ;** FIX **
04220 PRINTX ? TOO MANY SEARCH STRINGS, 17 ASSUMED
04230 SRNUM==17> ;** FIX **
04300 IFNDEF PDLSIZ, <PDLSIZ==200> ;PUSHDOWN LIST SIZE
04400 IFNDEF MXWPL, <MXWPL==^D100> ;MAX NUMBER OF WORDS PER LINE
04500 IFNDEF MINDSK, <MINDSK==^D5> ;MINIMUM DISK SPACE TO TRY OUTPUT
04600 IFNDEF OVRDRW, <OVRDRW==^D100> ;OVER DRAW ALLOWANCE
04700 IFN EXTEND,< IFNDEF LSNUM, <LSNUM==3> ;NUMBER OF NESTED LINE SEARCHES ALLOWED>
04800 IFNDEF %LPP, <%LPP==^D53> ;LINES/PAGE FOR "L" CMD
04900 IFNDEF PGSZ, <PGSZ==^D55> ;LINES / PAGE
05000 IFNDEF FULLPG, <FULLPG==^D65> ;LINES TO NEXT PAGE
05100
05200 .TOLCT==1003 ;LOWER CASE TTY
05210 .TOSOP==2 ;TRMOP. - SKIP IF OUTPUT IN PROGRESS ;** FIX **
05220 IFN %SS073, <
05230 .TOWID==1012 ;TRMOP. - TERMINAL HORIZONTAL WIDTH
05240 >; END OF IFN %SS073
05300 .GTPRG==3 ;PROGRAM NAME
05400 .GTLDV==16 ;LEVEL D TABLE
05500 %LDSTP==12 ;DEFAULT PROTECTION
05505
05510 IFN %SS006, <
05515 ;OFFSETS FOR EXTENDED LOOKUP PARMS
05520 .RBPPN==1 ; PPN
05525 .RBNAM==2 ; FILE NAME
05530 .RBEXT==3 ; EXTENSION
05535 .RBPRV==4 ; PRIVILEGES, ET AL
05540 .RBSIZ==5 ; ACTUAL FILE SIZE (WORDS WRITTEN)
05545 .RBEST==10 ; ESTIMATED FILE SIZE
05550 .RBDEV==16 ; ACTUAL DEVICE USED
05555 EXTOFF==2 ;OFFSET BETWEEN SHORT & EXTENDED ARGS
05560 >; END OF IFN %SS006
05600
05700 ;
05800 ; SPECIAL PATTERN MATCHING CHARACTER ASSIGNMENTS
05900 ;
06000
06100 IFNDEF .PTSEP, <.PTSEP==174> ;ANY SEPARATOR
06200 IFNDEF .PTANY, <.PTANY==024> ;ANY CHARACTER
06300 IFNDEF .PTNOT, <.PTNOT==005> ;'NOT' NEXT CHARACTER
06400 IFNDEF .PTQOT, <.PTQOT==036> ;'QUOTE' NEXT CHARACTER
06500 IFNDEF .PTINF, <.PTINF==016> ;'ANY NUMBER OF' NEXT CHARACTER
06600 IFNDEF .PTDLM, <.PTDLM==017> ;STRING IDENTIFIER DELIMITER
06700 IFNDEF .PTNXS, <.PTNXS==002> ;NEXT STRING IDENTIFIER
06800 IFN %SS044, <
06900 IFNDEF .PTLTR, <.PTLTR==001> ;ANY LETTER
07000 IFNDEF .PTLCL, <.PTLCL==027> ;ANY LOWER-CASE LETTER
07100 IFNDEF .PTUCL, <.PTUCL==006> ;ANY UPPER-CASE LETTER
07200 IFNDEF .PTDGT, <.PTDGT==020> ;ANY DECIMAL DIGIT
07300 IFNDEF .PTEOL, <.PTEOL==035> ;END OF LINE
07400 IFNDEF .PTSPC, <.PTSPC==034> ;SPACE -OR- TAB
07500 IFNDEF .PT1MR, <.PT1MR==026> ;'ONE OR MORE OF' NEXT CHARACTER
07600 IFNDEF .PTALM, <.PTALM==030> ;ANY LETTER OR DECIMAL DIGIT
07700 >; END OF IFN %SS044
07800
07900 SUBTTL RPG LOADER
00100 CREFIT: OCRLF ;INFORM USER IS ALL OK
00200 MOVE T4,[1,,RPGR]
00300 SKIPN T1,RUNDEV ;ANY SPECIFIED
00400 JRST TENTFOLD
00500 MOVEM T1,RPGR ;STASH DEVICE NAME
00600 HRRZS T4 ;REMOVE RUN INCREMENT
00700 HRROI T1,RUNEXT
00800 POP T1,RPGR+2
00900 POP T1,RPGR+1
01000 SKIPE T1,RUNPTH ;ANY PATH INFO?
01100 SKIPN RUNPTH+1 ;YES - JUST PPN?
01200 JRST CRFIT1 ;JUST STORE PPN AND EXIT
01300 MOVE T1,[RUNPTH,,PTHADR+2]
01400 BLT T1,PTHADR+2+SFDLVL
01500 SETZM PTHADR
01600 SETZM PTHADR+1
01700 MOVEI T1,PTHADR
01800 CRFIT1: MOVEM T1,RPGR+4 ;STASH PATH PNTR
01900 TENTFOLD:
02000 RUN T4,
02100 HALT . ;SAY DON'T RETURN
02200
02300 SUBTTL CHARACTER TABLES
00100
00200
00300
00400 ;A CHARACTER TABLE FOR USE ON TYPE IN AND TYPE OUT
00500
00600 ;FLAGS USED IN CHARACTER TABLE
00700
00800 OPF==10 ;THIS IS A SPECIAL CHARACTER
00900 SNUMF==4 ;THIS IS PART OF A NUMBER
01000 LETF==2 ;THIS IS A LETTER
01100 TERM==1 ;THIS IS A TERMINATOR
01200 M37==400000 ;THIS CHR IS PRINTED AS ITSELF ON MODEL 37
01300 NSEPF==200000 ;THIS IS NOT A SEPERATOR (USED ON $,%,AND.)
01400 DEFINE CHRS (FLAGS,PALT,INALT,RH)
01500 <BYTE (4) FLAGS (7) PALT,INALT(18)RH>
01600
01700 CTBL: 0
01800 CHRS OPF,"!",1,1
01900 CHRS OPF,42,2,2
02000 CHRS OPF,"#",3,3
02100 CHRS OPF,"$",4,4
02200 CHRS OPF,"%",5,5
02300 CHRS OPF,"&",6,6
02400 CHRS OPF,"'",7,7
02500 CHRS OPF,"(",10,10
02600 0
02700 CHRS OPF!TERM,0,12,12
02800 CHRS OPF,0,13,13
02900 CHRS OPF,0,14,14
03000 0
03100 CHRS OPF,")",16,16
03200 CHRS OPF,"*",17,17
03300 CHRS OPF,"+",20,20
03400 CHRS OPF,54,21,21
03500 CHRS OPF,"-",22,22
03600 CHRS OPF,".",23,23
03700 CHRS OPF,"/",24,24
03800 CHRS OPF,"0",25,25
03900 CHRS OPF,"1",26,26
04000 CHRS OPF,"2",27,27
04100 CHRS OPF,"9",30,30
04200 CHRS OPF,"6",31,31
04300 CHRS OPF,"4",32,32
04400 CHRS OPF,"=",33,33
04500 CHRS OPF,74,34,34
04600 CHRS OPF,76,35,35
04700 CHRS OPF,"7",36,36
04800 CHRS OPF,"8",37,37
04900 0
05000 CHRS OPF,0,1,"!"
05100 CHRS OPF,0,2,42
05200 CHRS OPF,0,3,"#"
05300 CHRS OPF,0,4,"$"+NSEPF
05400 CHRS OPF,0,5,"%"+NSEPF
05500 CHRS OPF,0,6,"&"
05590 IFE %SS025, <
05600 CHRS OPF,"'","'","'"
05610 >; END OF IFE %SS025
05620 IFN %SS025, <
05630 CHRS OPF,0,7,"'"
05640 >; END OF IFN %SS025
05700 CHRS OPF,0,10,"("
05800 CHRS OPF,0,16,")"
05900 CHRS OPF,0,17,"*"
06000 CHRS OPF,0,20,"+"
06100 CHRS OPF,0,21,54
06200 CHRS OPF,0,22,"-"
06300 CHRS OPF,0,23,"."+NSEPF
06400 CHRS OPF,0,24,"/"
06500 CHRS SNUMF,0,25,20
06600 CHRS SNUMF,0,26,21
06700 CHRS SNUMF,0,27,22
06800 CHRS SNUMF,0,176,23
06900 CHRS SNUMF,0,32,24
07000 CHRS SNUMF,0,"5",25
07100 CHRS SNUMF,0,31,26
07200 CHRS SNUMF,0,36,27
07300 CHRS SNUMF,0,37,30
07400 CHRS SNUMF,0,30,31
07500 CHRS OPF,0,174,":"
07600 CHRS OPF,0,73,73
07700 CHRS OPF,0,34,74
07800 CHRS OPF,0,33,"="
07900 CHRS OPF,0,35,76
07990 IFE %SS025, <
08000 CHRS OPF,0,37,"?"
08010 >; EMD OF IFE %SS025
08020 IFN %SS025, <
08030 CHRS OPF,0,7,"?"
08040 >; END OF IFN %SS025
08100 CHRS OPF,0,140,"@"
08200 XXZ=101
08300 REPEAT ^D26,<CHRS LETF,0,XXZ+40,XXZ-40
08400 XXZ=XXZ+1>
08500 CHRS OPF,0,173,"["
08590 IFE %SS060, <
08600 CHRS OPF,0,"\","\"
08610 >; END OF IFE %SS060
08620 IFN %SS060, <
08630 CHRS OPF,0,177,"\"
08640 >; END OF IFN %SS060
08700 CHRS OPF,0,175,"]"
08800 CHRS OPF,0,"^","^"
08900 CHRS OPF,0,"_","_"
09000 CHRS OPF,100,140,140
09100 XXZ=141
09200 REPEAT ^D26,<CHRS LETF,XXZ-40,XXZ,XXZ-100
09300 XXZ=XXZ+1>
09400 CHRS OPF,"[",173,173+M37
09500 CHRS OPF,":",174,174+M37
09600 CHRS OPF,"]",175,175+M37
09700 CHRS OPF,"3",176,176
09800 CHRS OPF,"\",177,177
09900 CHRS OPF,0,0,200
10000
10100 SUBTTL SCANNER
00100 GNCH: SKIPN C,LIMBO ;USE SAVED CHAR IF ANY
00200 PUSHJ P,@CHIN ;ELSE GET FRESH CHAR
00300 SETZM LIMBO ;AND CLEAR LIMBO
00400 CAMN C,ESC ;CHECK ESCAPE CHAR
00500 MOVEI C,200 ;CONFUSE WITH LEFT CURLY BRACKET
00600 TLNE FL,QMODF ;SHOULD WE TREAT ' SPECIALLY
00700 JRST GNCH1Y ;NO:
00790 IFE %SS025, <
00800 CAIN C,"'" ;YES: SHOULD WE USE ALT CHR SET?
00810 >; END OF IFE %SS025
00820 IFN %SS025, <
00830 CAMN C,CHR128 ;TEST FOR _C128 ESCAPE CHAR
00840 >; END OF IFN %SS025
00900 JRST GNCHA ;YES:
01000 GNCH1Y: TDNN FL2,[INOPTF,,COMFLF]
01100 TLNN FL2,BELLF ;ALLOWED?
01200 JRST GNCHB ;NO: JUST GET BITS
01300 CAIN C,7 ;YES: SEE IF BELL
01400 JRST [TLO FL2,BELLSN ;SAY WE SAW ONE
01500 JRST GNCHA] ;AND LOOK AT NEXT
01600 GNCHB: JUMPE C,GNCH ;IGNORE NULLS
01700 MOVE CS,CTBL(C) ;GET CHARACTER TABLE BITS
01710 IFN %SS010, <
01720 TLNE FL,QMODF ;TEST FOR _C64
01730 POPJ P, ; YES, RETURN (NO CASE TRANSLATION)
01740 >; END OF IFN %SS010
01800 TLNE CS,LETF_16 ;CHECK TO SEE IF A LETTER
01900 TDC C,CASEBT ;USE UPPER/LOWER INFO
02000 POPJ P, ;AND RETURN
02100
02200 GNCHA: PUSHJ P,@CHIN ;GET NEXT CHAR
02300 JUMPE C,GNCHA ;SKIP NULLS
02400 TLZE FL2,BELLSN ;WAS 1ST BELL SEEN
02500 JRST [CAIN C,7 ;YES: CHECK FOR 2ND
02600 JRST [OCRLF ;2ND SEEN - PUNT
02700 CLRBFI
02800 JRST COMND]
02900 MOVEM C,LIMBO ;SAVE CHAR
03000 MOVEI C,7 ;RETURN A BELL
03100 JRST GNCHB]
03110 IFN %SS025, <
03120 CAMN C,CHR128 ;TEST FOR _C128 ESCAPE CHARACTER
03130 JRST GNCHB ; YES, ALWAYS TRANSLATES TO [SELF]
03140 >; END OF IFN %SS025
03200 SKIPE CTBL(C) ;NO CHANGE FOR NULL,SPACE,TAB,CRET
03300 MOVS C,CTBL(C) ;GET ALTERNATE CHR FROM CHR TABLE
03400 ANDI C,177 ;ONLY THE CHR BITS
03500 JRST GNCHB ;GO CHECK THINGS
03600
03700 ;HERE TO INPUT FROM TTY
03800
03900 TTYCH: SOSG TTIBH+2 ;SEE IF MORE CHARS
04000 PUSHJ P,TTYINP ;NO: GO FETCH SOME MORE
04100 ILDB C,TTIBH+1 ;YES: GET ONE
04200 JUMPE C,TTYCH ;SKIP OVER NULLS
04300 POPJ P, ;RETURN
04400
04500 TTYINP: IN TTY,0 ;INPUT UUO
04600 POPJ P, ;ALL OK
04700 STATO TTY,20000 ;SEE IF EOF?
04800 JRST TTYERR ;NO -- ERROR?
04900 TTINP1: RELEAS TTY,0 ;EOF -- RE-INIT TTY
05000 OPEN TTY,TTDEVI
05100 ERROR ICN
05200 MOVEI C,TTIBUF ;SET UP INPUT BUFFER
05300 EXCH C,.JBFF##
05400 INBUF TTY,1
05500 MOVEM C,.JBFF## ;RESTORE JOBFF
05600 JRST TTYINP ;NOW TRY INPUT AGAIN
05700
05800 TTYERR: SETSTS TTY,1 ;CLR ERRORS
05900 CLRBFI
06000 ;;*FIX* OCRLF
06100 OUTSTR [ASCIZ "
06125 % TTY input error -- Retype line
06150 "] ;** FIX **
06200 ;;*FIX* OCRLF
06300 JRST TTINP1
00100 ;SUBROUTINE TO SCAN NEXT ATOM
00200 ;CALL:
00300 ; PUSHJ P,SCAN
00400 ; <RETURN HERE>
00500 ;C(ACCUM) := SIXBIT ATOM
00600 ;C(T1) := ASCII SEQ NUMBER FORM
00700 ;C(T2) := DECIMAL INTEGER
00800 ;C(C) := BREAK CHAR OR SPACE IF IDENT.
00900
01000 SCAN: TRZ FL,TERMF!NUMF!IDF ;RESET FLAGS
01100 SKIPE CS,SAVCHR ;CHECK TO SEE IF WE LEFT ONE LAST TIME
01200 JRST SL1 ;YES, IT MUST BE A DELIMITER
01300 SKIPN C,SAVC ;BACK UP A CHARACTER?
01400 JRST SL10 ;NO
01490 IFE %SS010, <
01500 PUSHJ P,GNCHB ;YES, GET BITS
01510 >; END OF IFE %SS010
01520 IFN %SS010, <
01530 MOVE CS,CTBL(C) ;RESTORE CHARACTER FLAGS
01540 >; END OF IFN %SS010
01600 TLNN FL2,INPARS ;HANDLE SPECIAL IF IN PARSE
01700 JRST SL11 ;NOT IN INITIAL PARSE
01710 IFN %SS006, <
01720 TLNE CS,TERM_16 ;TEST FOR TERMINATOR
01730 TRO FL,TERMF ; YES, SET A FLAG
01740 >; END OF IFN %SS006
01800 SETZM SAVC
01900 SETZM SAVCHR
02000 POPJ P, ;RETURN IF SPACE DELIM
02100 SL10: PUSHJ P,GNCH ;GET A CHR
02200 SL11: SETZM SAVC
02300 JUMPE CS,SL10 ;CHECK FOR TAB, SPACE, AND IGNORE
02400 JUMPL CS,SL1 ;SPECIAL CHARACTER?
02500 MOVE T3,[POINT 6,ACCUM] ;SET TO SAVE IDENT
02600 SETZM ACCUM
02700 TLNE CS,SNUMF_16 ;CHECK FOR NUMBER
02800 JRST SNUM1 ;AND GO RACING OFF TO NUMBER ROUTINE
02900 SL2P: TRO FL,IDF ;IT IS AN IDENT
03000 SL2: TLNE T3,770000 ;HAVE WE STORED ENOUGH?
03100 IDPB CS,T3 ;NO, STORE ANOTHER (RH OF CHR TABLE HAS SIXBIT)
03200 PUSHJ P,GNCH ;CONTINUE
03300 JUMPG CS,SL2 ;CHECK FOR ANOTHER NUMBER OR LETTER
03400 SOK1: MOVEM CS,SAVCHR ;SAVE THE CHARACTER (MUST BE A SPECIAL CHR)
03500 TLNE FL2,INPARS
03600 JRST [MOVEM C,SAVC ;SAVE HERE IF IN PARSE
03700 SETZB C,SAVCHR
03800 POPJ P,]
03900 MOVEI C,0 ;ZERO IN C FOR NUMBERS AND IDNETS
04000 POPJ P,
04100
04200 SL1: HRRZ C,CS ;FOR SPECIAL CHARACTERS, RETURN RH OF CTABLE
04300 TLNE CS,TERM_16 ;CHECK FOR TERMINATOR
04400 TRO FL,TERMF ;AND SET FLAG
04500 ANDI C,377 ;GET RID OF EXTRA BITS
04600 SETZM SAVCHR ;ZERO SAVCHR FOR LATER
04700 CAIE C,"." ;CHECK FOR .
04800 POPJ P, ;NO RETURN
04900 MOVE T1,CLN ;SET UP FOR CURRENT LINE AND PAGE
05000 MOVE T2,CPGL
05100 TRO FL,NUMF ;CALL IT A NUMBER
05200 POPJ P,
05300
05400 IFN %SS042, <
05500
05600 ;
05700 ; SUBROUTINE TO SCAN STATEMENT MODIFIERS (IN ANY ORDER)
05800 ;
05900
06000 SCNMOD: SETZM USDOPT ;SHOW NO OPTIONS USED
06100 SCNM00: TRNN FL,TERMF ;TEST FOR TERMINATOR
06200 CAIE C,"," ;TEST FOR COMMA
06300 POPJ P, ; RETURN IF ANYTHING BUT A COMMA
06400 PUSHJ P,SCAN ;GET NEXT ATOM
06500 TRNE FL,NUMF ;TEST FOR A NUMBER
06600 JRST SCNM30 ; YES, JUMP
06700 TRNE SINDEX,-1 ;TEST FOR NULL IDENTIFIER LIST
06800 TRNE FL,TERMF ;TEST FOR A TERMINATOR
06900 NERROR ILC ; NO LIST -OR- TERMINATOR, SYNTAX ERROR
07000 SUBI C,40 ;CONVERT SPECIAL CHAR TO SIXBIT
07100 ROT C,-6 ; & LEFT ADJUST
07200 TRNN FL,IDF ;TEST FOR IDENTIFIER
07300 MOVEM C,ACCUM ; NO, STORE SIXBIT SPECIAL CHAR AS IDENT
07400 MOVEI T1,(SINDEX) ;COPY START OF ARG LIST
07500 SCNM10: SKIPN T2,(T1) ;TEST FOR NEXT ARGUMENT
07600 NERROR ILC ; NONE, NO MATCH MEANS SYNTAX ERROR
07700 IFN %SS055, <
07800 CAMN T2,[-1] ;TEST FOR -1
07900 JRST SCNM25 ; YES, ANY CHARACTER MATCHES
08000 >; END OF IFN %SS055
08100 CAMN T2,ACCUM ;TEST FOR SAME OPTION
08200 JRST SCNM20 ; YES, JUMP
08300 ADDI T1,2 ;INCR TO NEXT OPTION
08400 JRST SCNM10 ; & REPEAT
08500 SCNM20: MOVEI T3,(SINDEX) ;GET STARTING ADDRESS AGAIN
08600 SUB T3,T1 ;GET - ARGUMENT NUMBER
08700 ASH T3,-1 ; DITTO
08800 MOVSI T4,(1B0) ;GET A BIT
08900 LSH T4,(T3) ; & SHIFT ACCORDING TO ARGUMENT NUMBER
09000 TDNE T4,USDOPT ;TEST FOR PREVIOUS OPTION
09100 NERROR ILC ; YES, SYNTAX ERROR
09200 IORM T4,USDOPT ;STORE AS USED OPTION
09300 SCNM25: XCT 1(T1) ;PERFORM FUNCTION FOR CHOSEN OPTION
09400 PUSHJ P,SCAN ;SCAN NEXT ATOM
09500 JRST SCNM00 ; & REPEAT
09600 SCNM30: TLNN SINDEX,-1 ;TEST FOR NUMBERS PERMITTED
09700 NERROR ILC ; NO, SYNTAX ERROR
09800 MOVEI T4,1 ;GET A LOW:ORDER BIT
09900 TDNE T4,USDOPT ;TEST FOR NUMBER PREVIOUSLY GIVEN
10000 NERROR ILC ; YES, SYNTAX ERROR
10100 IORM T4,USDOPT ;SHOW NUMBER GIVEN
10200 HLRZ T1,SINDEX ;GET ADDRESS TO STORE NUMBER
10300 MOVEM T2,(T1) ;STORE THE NUMBER
10400 PUSHJ P,SCAN ;SCAN FOR NEXT ATOM
10500 JRST SCNM00 ; & REPEAT
10600 >; END OF IFN %SS042
00100 SNUM1: SETZB T1,T2 ;SET NUMBER ACCUMS TO 0
00200 SN1A: TLNE T3,770000 ;WILL STORE THE SIXBIT FOR FILE NAMES
00300 IDPB CS,T3 ;BUT ONLY IF LESS THAN 6
00400 SN1B: TLNE T1,(<177B7>) ;CHECK FOR 5 CHARS
00500 JRST SN1C ;5 ALREADY ;** FIX **
00600 LSH T1,7 ;ACCUMULATE ASCII IN T1
00700 IOR T1,C
00800 SN1C: IMULI T2,^D10 ;DECIMAL IN T2 ;** FIX **
00900 ADDI T2,-"0"(C)
01000 PUSHJ P,GNCH ;GET NEXT AND CONTINUE
01100 JUMPLE CS,SOK2 ;CHECK FOR END OF NUMBER
01200 TLNN CS,SNUMF_16 ;CHECK FOR NUMBER
01300 JRST SL2P ;MUST BE AN IDENT
01400 JRST SN1A ;CONTINUE SCANNING NUMBER
01500
01600 SOK2: TRO FL,NUMF ;IT WAS A NUMBER
01700 LSH T1,1 ;CONVERT TO LINE NUMBER
01800 IOR T1,[<ASCII /00000/>!1]
01900 JRST SOK1 ;SAVE DELIM AND RETURN
02000
02100 SUBTTL PLACE FINDING ROUTINES
00100
00200 ;FIND-- PAGE TO FIND IS IN DPG. NUMBER TO FIND IS IN SINDEX.
00300 ;LOADS T1 WITH THE LINE NUMBER FOUND
00400 ;IF NO EXACT MATCH WILL FIND NEXT HIGHER NUMBER OR A PAGE MARK.
00500
00600 FIND: MOVE T1,DPG ;GET THE DESIRED PAGE
00700 CAMLE T1,CPG ;IS IT GREATER THAN THE PAGE WE ARE ON
00800 JRST FWDPG ;YES, SEARCH FORWARD FOR PAGE
00900 CAML T1,CPG ;IS IT THE SAME AS THE CURRENT PAGE?
01000 JRST FEQPG ;YES, JUST SEARCH FOR LINE NUMER
01100 SUBI PNTR,1 ;BACK UP A LITTLE (IN CASE POINTED AT PAGE MARK)
01200 FIND1: PUSHJ P,CHKREN ;SEE IF REENTER
01300 JRST FNDONE ;YES: FINISH UP
01400 SKIPN T1,(PNTR) ;GET THE WORD, BUT WATCH FOR START OF BUFFER
01500 JRST FINDHD ;WILL HAVE TO FINISH COPY AND START OVER
01600 CAME T1,PGMK ;IS IT A PAGE MARK?
01700 SOJA PNTR,FIND1 ;CONTINUE SEARCHING
01800 SOS T1,CPG ;DECREASE THE PAGE WE ARE NOW ON
01900 CAME T1,DPG ;IS IT THE RIGHT ONE YET?
02000 SOJA PNTR,FIND1 ;NO, KEEP SEARCHING
02100 SUBI PNTR,1 ;BACK OVER PAGE MARK
02200 FIND2: PUSHJ P,CHKREN ;REENTER?
02300 JRST FNDONE ;YES:
02400 SKIPN T1,(PNTR) ;PICK UP WORD AND CHECK FOR START OF BUFFER
02500 JRST FINDHD ;HAVE TO DO IT THE HARD WAY
02600 TRNN T1,1 ;IS IT A SEQUENCE NUMBER?
02700 SOJA PNTR,FIND2 ;NO, CONTINUE SEARCH
02800 CAMN T1,PGMK ;IS IT PERHAPS A PAGE MARK?
02900 AOJA PNTR,FNDFW1 ;YES, GO FORWARD A LINE AND RETURN IT
03000 CAMGE SINDEX,T1 ;IS THE LINE WE WANT GREATER OR EQUAL TO THIS ONE
03100 SOJA PNTR,FIND2 ;NO, KEEP UP THE GOOD WORK
03200 CAMN SINDEX,T1 ;EXACT MATCH?
03300 POPJ P, ;YES, RETURN
03400 JRST FNDFW1 ;GO FORWARD A LINE TO GET NEXT LARGER
03500 FEQPG: SKIPN T1,(PNTR) ;CHECK THE WORD WE ARE POINTING AT
03600 JRST FNDFOO ;MUST BE POINTING AT END OF BUFFER OR BUFFER EMPTY
03700 CAMN T1,PGMK ;IS IT A PAGE MARK?
03800 SOJA PNTR,FIND2 ;MUST BE ONE AT END OF PAGE, SEARCH BACKWARDS
03900 FEQPG1: CAMGE SINDEX,T1 ;COMPARE TO LINE WE WANT
04000 JRST FIND2 ;WANT A SMALLER ONE, SEARCH BACK
04100 JRST FNDFW1 ;SEARCH FORWARD
04200
04300 FWDPG: PUSHJ P,CHKREN ;REENTER?
04400 JRST FNDONE ;YES:
04500 SKIPN T1,(PNTR) ;SEARCH FORWARD FOR PAGE
04600 JRST FNXRCP ;END OF BUFFER, GET A NEW ONE
04700 CAME T1,PGMK ;FOUND A PAGE MARK?
04800 AOJA PNTR,FWDPG ;NO, CONTINUE
04900 AOS T1,CPG ;ADVANCE CURRENT PAGE COUNT
05000 CAME T1,DPG ;AND SEE IF WE ARE THER YET
05100 AOJA PNTR,FWDPG ;NUTS, LOOK SOME MORE
05200 ADDI PNTR,1 ;ADVANCE BEYOND PAGE MARK
05300 FNDFW1:
05400 FIND3: PUSHJ P,CHKREN ;REENTER?
05500 JRST FNDONE ;YES:
05600 SKIPN T1,(PNTR) ;LOOK FOR LINE
05700 JRST FNXRC ;END OF RECORD, GET A NEW ONE
05800 TRNN T1,1
05900 AOJA PNTR,FIND3 ;NOT LINE NUMBER
06000 CAMN T1,PGMK ;PAGE MARK
06100 POPJ P, ;RETURN IT, IT IS BEST MATCH WE CAN FIND
06200 CAMLE SINDEX,T1 ;ARE WE THERE YET?
06300 AOJA PNTR,FIND3 ;NO, CONTINUE SEARCH
06400 POPJ P, ;YES, FINALLY
06500
06600 FNDFOO: CAMN PNTR,BUFP ;ARE WE POINTED TO START OF BUFFER
06700 JRST FDFOO1 ;YES, BUFFER MUST BE EMPTY
06800 SUBI PNTR,1 ;NO, MUST HAVE BEEN AT END OF BUFFER
06900 FDFOO2: SKIPN T1,(PNTR) ;GET WORD
07000 ERROR ICN ;MUST BE CONFUSED, THERE SHOULD BE A LINE NUMBER
07100 TRNN T1,1 ;SEARCH FOR LINE NUMBER
07200 SOJA PNTR,FDFOO2 ;KEEP LOOKING
07300 CAMN T1,PGMK ;IS IT A PAGE MARK
07400 AOJA PNTR,FNDFW1 ;YES, SEARCH FORWARD
07500 JRST FEQPG1 ;GO DO SOMETHING WITH IT
07600 FDFOO1: TRNE FL,EOF2 ;ARE WE AT END OF FILE?
07700 JRST FINDHD ;WILL HAVE TO TRY FROM START
07800 PUSHJ P,GETN ;GET THE NEXT BUFFER
07900 JRST FEQPG
08000
08100 ;HERE TO SAY WE HAVE BEEN INTERUPTED
08200
08300 FNDONE: JRST COMND ;JUST GO TO CMD LOOP FOR NOW
00100 FNXRCP: TRNE FL,EOF2 ;AR WE AT END OF FILE
00200 JRST FNX1 ;YES, JUST RESET BGPG AND LOOK AGAIN
00300 PUSHJ P,GETN ;GET THE NEXT BUFFER
00400 JRST FWDPG ;AND CONTINUE SEARCH
00500 FNX1: MOVE T1,CPG ;SET BGPG TO CURRENT PAGE
00600 MOVEM T1,BGPG
00700 TRO FL,BGSN ;RECORD THAT LARGEST PAGE SEEN
00800 MOVEI T1,0 ;RETURN 0 FOR EOF
00900 POPJ P,
01000
01100 FNXRC: TRNE FL,EOF2 ;ARE WE AT END OF FILE
01200 JRST FNX1 ;YES, GIVE HIM BACK THE 0
01300 PUSHJ P,GETN ;NO, GET THE NEXT BUFFER
01400 JRST FIND3 ;AND CONTINUE LOOKING FOR LINE
01500
01600 FINDHD: TRNE FL,BOF ;ARE WE AT THE START OF THE FILE
01700 JRST FNDFST ;YES, CAN NOT GO BACK JUST GIVE FIRST LINE OF FILE
01800 TLNE FL,COPFIL ;IS THIS A COPY?
01900 JRST FINDH4 ;YES: DON'T RELEAS IN & OUT
02000 TRNE FL,READOF ;ALSO HANDLE SPECIAL IF RO
02100 JRST FINDH
02200 PUSHJ P,OCOMPL ;FINISH COPYING FILE
02300 TLNN FL2,PCHGF ;ANY CHANGES THIS PASS?
02400 JRST [SETZB T1,T2 ;NO - JUST DELETE OUTPUT
02500 RENAME OUT,T1
02600 JRST EDFLIN
02700 RELEAS IN,0 ;AND CLOSE INPUT FILE
02800 JRST FINDH1]
02900 FINDH: SKIPE AUXFIL
03000 JRST [SETZB T1,T2
03100 RENAME IN,T1
03200 JRST EDFLIN
03300 JRST .+1]
03400 RELEAS IN,0 ;RELEASE IO DEVICES
03500 MOVE T1,[OCRBLK,,ICRBLK]
03600 BLT T1,ICRBKE ;COPY TEMP SPECS TO INPUT
03700 MOVSI T1,'TMP' ;GET CORRECT EXTENSION
03800 HLLM T1,ICREXT
03900 TRNE FL,READOF ;READ ONLY?
04000 JRST FINDH1 ;YES: SKIP RENAME
04100 PUSHJ P,OUTDO ;PURGE BUFFER
04200 XRENM OUT,ICRBLK ;RENAME OUTPUT FILE
04300 JRST EDFLIN ;LOSER
04400 FINDH1: RELEAS OUT,0 ;CLOSE NOW
04500 MOVE T1,OCRDEV
04600 MOVEM T1,OUDEVI+1 ;GET OUTPUT STR ALSO
04700 MOVE T1,ICRDEV
04800 MOVEM T1,INDEVI+1
04900 OPEN IN,INDEVI ;AND GET THEM BACK
05000 JRST NODSK ;WHERE DID THE DISK GO, IT WAS HARE BEFORE
05100 OPEN OUT,OUDEVI
05200 JRST NODSK
05300 MOVE T1,BUFHD ;SET UP JOBFF TO ESTABLISH BUFFERS
05400 MOVEM T1,.JBFF##
05500 HLRZ T1,EDBUF ;GET BUFFER INFO
05600 INBUF IN,0(T1)
05700 OUTBUF OUT,0(T1)
05800 TRNE FL,READOF ;ARE WE IN READ ONLY MODE?
05900 JRST FINDH2 ;SET TO POINT TO ORIGINAL NAME AGAIN
06000 TLNE FL2,PCHGF ;LEAVE AS IS IF NO CHANGES
06100 SETOM AUXFIL ;MARK AUX FILE IN USE
06200 XLOOK IN,ICRBLK ;OPEN INPUT FILE
06300 JRST EDFLIN ;BUT IT JUST PUT ONE THERE
06400 IFN CRYPSW,<
06500 SETOM IBUF+3 ;INIT BLK CNTR
06600 >
06700 XENTR OUT,OCRBLK
06800 JRST EDFLIN ;SOME OTHER BASTARD MUST BE USING IT
06900 SETZM OPG ;OUTPUT PAGE CNTR
07000 IFN CRYPSW,<
07100 MOVNI T1,2
07200 MOVEM T1,OBUF+3 ;INIT BLK CNTR
07300 >
00100 FINDH3: SETZM WC ;WC STARTS OUT 0
00200 TDZ FL,[TECOF,,EOF!EOF2]
00300 TDO FL,[FSTOPF,,BOF]
00400 TLNN FL,COPFIL ;DON'T HURT THIS FLAG IF IN COPY
00500 TLZ FL2,PCHGF ;NO CHANGES YET
00600 MOVEI T1,1 ;SET UP INPUT PAGE IN CASE OF
00700 MOVEM T1,INPG ;ORDER OR LTL ERRORS ON INPUT
00800 SETZM SVWD
00900 SETZM OLDLIN ;USED IN CHECKING INPUT ORDER OF LINES
01000 PUSHJ P,FILLBF ;FILL UP THE BUFFER
01100 MOVEI T1,1
01200 MOVEM T1,CPG ;START ON PAGE 1
01300 MOVE PNTR,BUFP ;SET PNTR TO START OF WORLD
01400 JRST FIND ;AND GO LOOKING
01500
01600 FNDFST: MOVE T1,@BUFP ;GET FIRST WORD
01700 FNDFS1: MOVE PNTR,BUFP ;SET TO START OF WORLD
01800 POPJ P, ;AND DISMISS
01900
02000 FINDH4: RELEAS ALTDV,0 ;LET GO OF ALTERNATE DEVICE
02100 OPEN ALTDV,ALDEVI
02200 JRST NODSK
02300 MOVE T1,SVJRL2
02400 MOVEM T1,.JBFF##
02500 INBUF ALTDV,0
02600 XLOOK ALTDV,ALTBLK
02700 JRST NOFIL ;WHOOPS
02800 JRST FINDH3
02900
03000 FINDH2: MOVE T1,[ORGBLK,,ICRBLK]
03100 BLT T1,ICRBKE ;SET UP FILE NAME
03200 XLOOK IN,ICRBLK
03300 JRST NOFIL ;NO FILE THERE START OVER
03400 IFN CRYPSW,<
03500 SETOM IBUF+3 >
03600 JRST FINDH3 ;GO ON
00100
00200 ;FIND THE NEXT LINE, PAGE MARK, ETC.
00300
00310 FINDN: SKIPE T1,(PNTR) ;TEST FOR END OF BUFFER ;** FIX **
00320 JRST FINDN0 ; NO, JUMP TO FIND NEXT;** FIX **
00330 CAMGE PNTR,BUFP ;TEST FOR PNTR TOO LOW ;** FIX **
00340 JRST FINDN0 ; YES, GO INCR & TESTT ;** FIX **
00350 TRNE FL,EOF2 ;TEST FOR EOF ;** FIX **
00360 POPJ P, ; YES, RETURN 0 IN T1 ;** FIX **
00370 PUSHJ P,GETN ;GET NEXT BUFFER ;** FIX **
00380 JRST FINDN ; & CONTINUE LOOKING ;** FIX **
00390
00400 FINDN1: SKIPN T1,(PNTR)
00500 JRST FINDN2
00600 TRNN T1,1
00700 FINDN0: AOJA PNTR,FINDN1 ;** FIX **
00800 POPJ P, ;RETURN THE LINE
00900
01000 FINDN2: TRNE FL,EOF2 ;IS IT EOF?
01100 JRST FINDN3 ; YES, GO RETURN 0 (FOR EOF) ;** FIX **
01200 PUSHJ P,GETN ;GET NEXT BUFFER
01300 JRST FINDN1 ;GO LOOK SOME MORE
01400
01410 FINDN3: MOVE PNTR,BUFP ;GET START OF BUFFER ;** FIX **
01420 ADD PNTR,WC ; & POINT AT BUFFER END ;** FIX **
01430 POPJ P, ;RETURN TO CALLER ;** FIX **
01500
01600
01610 IFN %SS035, <
01620
01630 FINDZ: SKIPN T1,(PNTR) ;TEST FOR END OF BUFFER ;** FIX **
01640 JRST FINDN3 ; YES, JUMP ;** FIX **
01650 ADDI PNTR,1 ; NO, INCR TO NEXT WORD;** FIX **
01660 ; & FALL THRU ;** FIX **
01670
01700 FINDZ1: SKIPN T1,(PNTR) ;AS FINDN BUT STOPS AT END OF RECORD
01800 JRST FINDN3 ;** FIX **
01900 TRNN T1,1 ;LINE NUMBER?
02000 AOJA PNTR,FINDZ1 ;** FIX **
02100 POPJ P,
02150 >; END OF IFN %SS035
02200
02300
02400
02500 ;FIND THE PREVIOUS LINE
02600
02700 FINDB1: SKIPN T1,(PNTR) ;WATCH OUT FOR START OF BUFFER
02800 JRST FINDB2
02900 TRNN T1,1 ;LINE NUMBER?
03000 FINDB: SOJA PNTR,FINDB1 ;TRY AGAIN
03100 CAMN T1,PGMK ;TEST FOR PAGE MARK
03200 SOS CPG ;NOW ON PREVIOUS PAGE
03300 POPJ P, ;RETURN LINE NUMBER
03400
03500 FINDB2: TRNE FL,BOF ;AT START OF FILE?
03600 JRST FNDFS1 ;YES, GO GET THE FIRST LINE OF FILE
03700 MOVE T1,1(PNTR) ;GET THE FIRST LINE ON THIS PAGE
03800 TRNN T1,1 ;MAKE SURE THERE IS ONE THERE
03900 ERROR ICN ;NO, WE ARE CONFUSED
04000 PUSH P,SINDEX ;SAVE (CALLER MAY NEED IT)
04100 MOVE SINDEX,T1
04200 PUSHJ P,FINDHD ;THIS WILL WORK AND WE WILL HAVE A LITTLE SPACE BEFORE
04300 POP P,SINDEX ;GET THIS BACK
04400 SOJA PNTR,FINDB1 ;GO LOOK BACK AGAIN
04500
04600 SUBTTL BUFFER HANDLING ROUTINES
00100 OCOMPL: TLNN FL2,PCHGF ;SEE IF NEEDED
00200 POPJ P, ;NO - RETURN
00300 OCOMP0: MOVE T1,WC ;GET CURRENT WORD COUNT
00400 ADD T1,BUFP ;TURN IT INTO A POINTER
00500 PUSHJ P,DUMP ;DUMP DUMPS BUFFER FROM BUFP TO (T1)
00600 SETZM WC ;TELL IT NO CURRENT WORD COUNT
00700 TRNE FL,EOF2 ;ALL DONE?
00800 POPJ P,
00900 PUSHJ P,FILLBF ;FILL UP INPUT BUFFER
01000 PUSHJ P,CHKREN ;DID WE REENTER?
01100 JRST COMND ;YES: GO TO COMMAND LOOP
01200 JRST OCOMP0 ;AND GO DUMP THIS ONE TOO
01300
01400
01500
01600 GCHAR: ;;; ENTRY FOR UNSEQUENCE (CHAR MODE)
01700 GETWD: TRNE FL,EOF
01800 JRST RTEOF ;RETURN 0 IF EOF
01900 TLNE FL,COPFIL ;IN A COPY, WE GET FROM SOMEWHERE ELSE
02000 JRST COPGET
02100 SOSG IBUF+2 ;CHECK FOR MORE WORDS
02200 PUSHJ P,GETDO ;NO - GET SOME BY INPUT
02300 GETWD1: ILDB T3,IBUF+1 ;PICK UP A WORD
02400 JUMPE T3,GETWD ;IGNORE 0 WORDS
02500 POPJ P, ;RETURN
02600
02700 GETDO: IN IN,0 ;FETCH A BUFFER
02800 JRST GTUNDO ;OK RETURN
02900 STATZ IN,1B22 ;ERROR - MAYBE EOF?
03000 TROA FL,EOF ;EOF - SET FLAG
03100 ERROR DIE ;YOU LOSE!
03200 POP P,0(P) ;RETURN UP A LEVEL
03300 RTEOF: MOVEI T3,0 ;AND RETURN A ZERO
03400 POPJ P,
03500
03600 GTUNDO:
03700 IFN CRYPSW,<
03800 MOVEM 7,S.CRYP+7
03900 MOVEI 7,S.CRYP
04000 BLT 7,S.CRYP+6
04100 AOS 6,IBUF+3 ;GET BLK NUMBER
04200 MOVE 5,ICRCOD
04300 HRRZ 7,IBUF ;ADDR OF BUFFER
04400 ADD 7,[XWD -200,2]
04500 PUSHJ P,CRYPT.##
04600 MOVSI 7,S.CRYP
04700 BLT 7,7
04800 >
04900 POPJ P,
00100 PCHAR: ;;; ENTRY FOR UNSEQUENCE (CHAR MODE)
00200 OUTWD: SOSG OBUF+2 ;CHECK WORDS LEFT
00300 PUSHJ P,OUTDO
00400 OUTWD1: IDPB T3,OBUF+1 ;OUTPUT IT
00500 POPJ P, ;AND RETURN
00600
00700 OUTDO: TLNE FL2,DSKCK ;CHECK DISK?
00800 PUSHJ P,DSKTST ;YES:
00900 IFN CRYPSW,<
01000 MOVEM 7,S.CRYP+7
01100 MOVEI 7,S.CRYP
01200 BLT 7,S.CRYP+6
01300 HRRZ 7,OBUF
01400 ADD 7,[XWD -200,2]
01500 MOVE 5,OCRCOD
01600 AOSL 6,OBUF+3 ;ALLOW FOR DUMMY OUTPUT
01700 PUSHJ P,CRYPT.##
01800 MOVSI 7,S.CRYP
01900 BLT 7,7
02000 >
02100 OUT OUT,0
02200 POPJ P, ;NO ERRORS - RETURN
02290 IFE %SS061, <
02300 PUSH P,[OUTDOK] ;FAKE UP PDL
02400 PUSH P,T1 ;SAVE T1
02500 PUSH P,T2 ; AND T2
02590 IFE %SS005, <
02600 STATO OUT,1B21 ;ERROR OR QUOTA EXCEDED
02700 ERROR DDE ;ERROR - YOU LOSE
02710 >; END OF IFE %SS005
02720 IFN %SS005, <
02730 GETSTS OUT,T1 ;GET THE DSK STATUS
02740 TRZN T1,1B21 ;TEST FOR QUOTA PROBLEMS
02750 ERROR DDE ; NO, FATAL ERROR
02760 SETSTS OUT,(T1) ;CLEAR QUOTA PROBLEMS
02770 OUTSTR [ASCIZ /[Some output already lost]/] ; & TELL THE USER
02780 >; END OF IFN %SS005
02800 JRST DSKBTL ;GO TELL LOSER
02900 ;;;; POPJ RETURN TO .+1
03000 OUTDOK: TLO FL2,DSKCK ;REMEMBER THIS HAPPENED
03100 POPJ P, ;OUTPUT ALREADY DONE IT SEEMS
03110 >; END OF IFE %SS061
03120 IFN %SS061, <
03130 ERROR DDE ;WITH "DSKFUL PAUSE" SET, ANY ERROR
03140 ; IS FATAL!!!
03150 >; END OF IFN %SS061
03200
03300 ;ROUTINE TO DUMP BUFFER FROM BUFP TO (T1)
03400
03500 DUMP: MOVE T2,BUFP
03600 CAMGE T2,T1 ;CHECK TO SEE IF WE ARE DUMPINF ANYTHING
03700 TRZ FL,BOF ;IF SO TURN OFF BOF
03800 TRNN FL,READOF ;RETURN IF READ ONLY MODE
03900 DUMP1: CAML T2,T1 ;MORE TO DO?
04000 POPJ P, ;NO, RETURN
04100 PUSH P,T1 ;SAVE FOR LATER
04200 MOVEI T1,1(T2) ;FIND END OF THIS LINE
04300 DUMP3: SKIPN T3,(T1) ;ANY OLD END WILL DO
04400 JRST DUMP2
04500 TRNN T3,1 ;SUCH AS A LINE NUMBER
04600 AOJA T1,DUMP3 ;NOT YET
04700 DUMP2: SUB T1,T2 ;GET LENGTH
04790 IFE %SS052, <
04800 CAML T1,OBUF+2 ;WILL IT FIT?
04900 PUSHJ P,OUTDO ;NO, DUMP CURRENT BUFFER
04905 >; END OF IFE %SS052
04910 IFN %SS052, <
04915 MOVE T3,FILFMT ;GET MINIMUM REQ'D FREE SPACE
04920 CAML T1,OBUF+2 ;TEST IF ENTIRE RECORD WILL FIT
04925 CAMGE T3,OBUF+2 ;TEST IF MIN. FREE SPACE AVAILABLE
04930 JRST DUMP4 ; JUMP IF RECORD FITS OR MIN. FREE SPACE AVAILABLEE
04935 PUSHJ P,OUTDO ;DUMP THE BUFFER
04940 AOS OBUF+2 ;INCR BUFFER COUNT TO GET 128 WORDS
04945 ; INTO THE NEXT BUFFER (DIRTY, DIRTY CODE,
04950 ; BUT IT WORKS...)
04955 >; END OF IFN %SS052
05000 DUMP4: MOVE T3,(T2) ;PICK UP WORD
05100 CAMN T3,PGMK ;COUNT UP OUTPUT PAGES
05200 AOS OPG ;...
05300 PUSHJ P,OUTWD
05400 ADDI T2,1 ;ADVANCE POINTER
05500 SOJG T1,DUMP4 ;AND CHECK COUNT
05600 POP P,T1
05700 JRST DUMP1 ;GO CHECK FOR END
00100 DSKTST: PUSH P,T1 ;SAVE SOME AC'S
00200 PUSH P,T2
00300 PUSHJ P,FREDSK ;FIND OUT HOW MUCH DSK THERE IS
00400 CAIL T1,MINDSK ;LESS THAN MINIMUM?
00500 JRST DSKRET ;NO: PROCEED
00600 DSKBTL: PUSHJ P,CLRCTT ;YES: CLEAR TYPE AHEAD/^O ;** FIX **
00700 OUTSTR DSKMS2 ;TELL HIM WHAT HAPPENED
00800 PUSHJ P,TELSPC ;SUMMARY OF SPACE ;** FIX **
00900
01000 DSKTS0: OUTSTR [ASCIZ /
01100 Well? /]
01200 INCHRW T1 ;GET ANSWER
01300 DSKTS1: CLRBFI
01400 OCRLF
01500 ANDI T1,137 ;FORCE UPPER CASE
01600 CAIN T1,"G"
01700 JRST NOWAT
01800 CAIN T1,"R"
01900 JRST DSKRES
02000 CAIN T1,"T"
02100 JRST TTEST
02200 CAIE T1,"W"
02300 JRST DSKHLP
02400 TLO FL2,SLPSW ;SET FOR SPECIAL SLEEP ACTION
02500 CHKTYP: INCHRS T1 ;LOOK FOR CHAR
02600 JRST TRYDSK ;NOPE - TRY DSK OUTPUT
02700 JRST DSKTS1 ;YES - LOOK AT WHAT HE TYPED
02800
02900 TRYDSK: MOVEI T1,2 ;SLEEP FOR 2 SEC.
03000 SLEEP T1, ;ZZZ
03100 TTEST: PUSHJ P,FREDSK ;CHECK FREE STORAGE
03200 BTEST: CAIL T1,MINDSK ;OK NOW?
03300 JRST [OUTSTR [ASCIZ /DSK ok now./]
03400 OCRLF
03500 JRST DSKRET]
03600 TLNN FL2,SLPSW ;CHECK SPECIAL
03700 JRST DSKTS0 ;TO TOP OF LOOP
03800 OUTCHR [15]
03900 JRST CHKTYP ;TRY AGAIN
04000
04100 NOWAT: TLZ FL2,DSKCK ;TURN OFF DISK CHECKING
04200 DSKRET: POP P,T2 ;RESTORE AC'S
04300 POP P,T1
04400 POPJ P,
04500
04600 DSKRES: PUSHJ P,TELSPC ;PRINT OUT RESOURCES
04700 JRST TTEST ;AND TRY NOW. ;** FIX **
04800
04900 FREDSK: MOVE T1,[3,,STRNAM] ;DSKCHR UUO
05000 DSKCHR T1,
05100 SKIPA T1,[^D100] ;AS GOOD A NUMBER AS ANY
05200 SKIPG T1,STRNAM+1 ;GET AMOUNT IN T1
05300 ADDI T1,OVRDRW ;ADJUST FOR OVERDRAW
05400 CAMLE T1,STRNAM+2 ;HOW ABOUT THE REST OF THE WORLD
05500 MOVE T1,STRNAM+2 ;DISK IS FULL - GIVE LESSER
05600 POPJ P,
05700
05800 ;ROUTINE TO SET UP STR INFO FOR DSKCHK
05900
06000 STRSET: ;HERE TO SET UP OUTPUT STR INFO
06010 IFE %SS006, <
06020 MOVEI T1,OUT ;PATH UUO ON OUTPUT CHL
06100 MOVEM T1,PTHADR
06200 MOVE T1,[<SFDLVL+4>,,PTHADR]
06300 PATH. T1,
06400 SKIPA T1,[SIXBIT "DSK"]
06500 MOVE T1,PTHADR
06510 >; END OF IFE %SS006
06520 IFN %SS006, <
06530 MOVE T1,XBLOCK+.RBDEV ;GET THE ACTUAL UNIT NAME
06540 ; NOTE WE ASSUME 'STRSET' CALL FOLLOWS
06550 ; AN EXTENDED 'ENTER' FOR 'XBLOCK'
06560 >; END OF IFN %SS006
06600 MOVEM T1,STRNAM ;STORE STRUCTURE NAME
06700 MOVE T1,[5,,STRNAM]
06800 DSKCHR T1, ;GET REAL NAME
06900 SKIPA T1,[SIXBIT "DSK"]
07000 MOVE T1,STRNAM+4
07100 MOVEM T1,STRNAM ;ACTUAL NAME
07200 MOVEM T1,OCRDEV ;ACTUAL DEVICE
07300 POPJ P,
00100 DSKHLP: OUTSTR DSKMSG
00200 JRST DSKTS0
00300
00400 DSKMSG: ASCIZ "You must type:
00500 G - Do the output (now and forever).
00600 T - Test disk space and do output if space available.
00700 R - Give resources and do output if space available.
00800 W - Wait until either space appears or you type a different response.
00900 "
01000 DSKMS2: ASCIZ "
01100 [Insufficient disk space to do output]
01200
01300 "
01400
01500 TELSPC: PUSHJ P,FREDSK
01600 TELSP0: MOVE T2,STRNAM+1 ;GET FREE SPACE
01700 JUMPL T2,TELOVR ;OVERDRAWN?
01750 OUTSTR [ASCIZ "Available "] ;** FIX **
01800 TELSP1: PUSHJ P,DPRNT ;PRINT IN DECIMAL
01900 OUTSTR [ASCIZ " disk blocks on "] ;** FIX **
02000 MOVE T2,STRNAM ;SIXBIT ATOM TO PRINT
02100 PUSHJ P,PRTSX6
02200 PUSHJ P,FORCE ;DUMP BUFFER
02300 OCRLF
02400 MOVE T2,STRNAM+2 ;GET REST OF WORLD
02500 PUSHJ P,DPRNT ;IN DECIMAL
02600 OUTSTR [ASCIZ " blocks for all users on this structure"]
02700 OCRLF
02800 POPJ P, ;RETURN
02900
03000 TELOVR: OUTSTR [ASCIZ "Over quota by "]
03100 MOVN T2,T2 ;TELL HIM BAD NEWS
03200 JRST TELSP1
03300
03400 INSIST: OUTSTR [ASCIZ "? You must type either "]
03500 CONFRM: OUTSTR [ASCIZ "(Y or N): "] ;** FIX **
03600 INCHRW T1 ;GET RESPONSE
03700 ANDI T1,137 ;FORCE UPPER CASE
03800 CLRBFI
03900 CAIE T1,"N"
04000 JRST CONFRY ;MAYBE HE MEANT YES
04100 OUTSTR [ASCIZ "o
04200 "]
04300 POPJ P,
04400
04500 CONFRY: CAIE T1,"Y"
04600 JRST INSIST
04700 OUTSTR [ASCIZ "es
04800 "]
04900 JRST CPOPJ1
00100
00200 GETN: MOVE T1,WC ;GET THE NEXT BUFFER. FIND CURRENT WORD COUNT
00300 CAMGE T1,HLFWC ;GREATER THAN HALF OF MAX POSSIBLE?
00400 JRST FILLBF ;NO, JUST REFILL BUFFER
00500 ASH T1,-1 ;YES, TAKE HALF OF IT
00600 ADD T1,BUFP ;CONVERT TO POINTER
00700 GETN1: SKIPN T2,(T1) ;LOOK FOR A WORD BOUNDARY
00800 JRST NOWFL ;WE ARE HERE?
00900 TRNN T2,1 ;SEQUENCE NUMBER?
01000 SOJA T1,GETN1
01100 NOWFL: PUSHJ P,DUMP ;DUMP IT
01200 MOVE T2,T1 ;COPY POINTER
01300 SUB T2,BUFP ;AND FIND OUT HOW MANY DUMPED
01310 IFN %SS035, <
01320 JUMPLE T2,FILLBF ;DONE IF NOTHING TO MOVE
01330 >; END OF IFN %SS035
01400 SUB PNTR,T2 ;ADJUST POINTER
01500 EXCH T2,WC ;CALC NEW WORD COUNT
01600 SUBB T2,WC
01700 ADD T2,BUFP ;GET POINTER TO END OF BUFFER
01800 HRLS T1 ;SET UP BLT
01900 HRR T1,BUFP
02000 BLT T1,(T2)
02050 SETZM 1(T2) ;ASSURE 0 AT END+1 ;** FIX **
02100 ;;; JRST FILLBF ;AND FINISH FILLIN BUFFER ;** FIX **
02200
02300
02400
02500 FILLBF: MOVE T1,WC ;GET WORD COUNT
02600 ADD T1,BUFP ;AND CONVERT TO POINTER TO END OF BUFFER
02700 FILBF3: CAML T1,FILPT ;FULL ENOUGH?
02800 POPJ P, ;YES, RETURN
02900 TLNE FL,TECOF ;SPECIAL READING FOR TECO FILES
03000 JRST RDTECO
03100 HRLI T1,-MXWPL-2 ;GET A COUNT FOR MAX LINE SIZE
03200 SKIPN T3,SVWD ;SEE IF THERE IS A WORD LEFT FROM LAST TIME
03300 PUSHJ P,GETWD ;ELSE GET A NEW ONE
03400 JUMPE T3,SNEOF ;MUST BE EOF
03500 CAMN T3,PGMK ;CHECK FOR PAGE MARKS
03600 JRST CKPGMK ;GO FUDGE P/M
03700 TLZE FL,FSTOPF ;IF FIRST OP
03800 JRST CKTECO ;CHECK FOR TECO FILE
03810 TRNN T3,1 ;TEST FOR SEQ # HERE ;** FIX **
03820 NERROR ILFMT ; NO, ILLEGAL FORMAT ERROR ;** FIX **
03900 NOTECO: MOVEM T3,SVWD2 ;SAVE FOR SEQUENCE CHECK
04000 JRST FILBF4 ;GO PUT IT AWAY
04100 FILBF1: PUSHJ P,GETWD ;ELSE GET A NEW ONE
04200 JUMPE T3,FILBF2 ;0 WORD MUST BE EOF
04300 TRNE T3,1 ;CHECK FOR SEQNUM
04400 JRST FILBF2 ;YES, FINISH PUTTING IT IN
04410 CAMN T3,[BYTE(7)15,15,12,0,0] ;TEST FOR OLD STRANGE LINE ;** FIX **
04420 MOVE T3,[BYTE(7)11,15,12,0,0] ; YES, CONVERT TO PROPER ;** FIX **
04500 FILBF4: MOVEM T3,(T1) ;PUT IN THIS WORD
04600 AOS WC ;AND ADVANCE WORD COUNT
04700 AOBJN T1,FILBF1 ;ADVANCE POINTER AND CHECK COUNT
04800 JRST INLTL ;LINE IS TOO LONG
04900 FILBF2: MOVEM T3,SVWD ;SAVE THIS WORD
05000 FILBF0: SETZM (T1) ;MAKE SURE OF A ZERO WORD
05100 HRRZS T1 ;ELIMINATE COUNT INFO
05200 MOVE T3,SVWD2 ;CHECK ON ORDER OF INPUT LINES
05300 CAMG T3,OLDLIN ;CHECK FOR CORRECT ORDER
05400 JRST OUTOFO ;LINES ARE OUT OF ORDER
05500 FILBF5: MOVEM T3,OLDLIN ;SAVE FOR LATER
05600 SKIPE SVWD ;CHECK TO SEE IF WAS EOF
05700 JRST FILBF3 ;AND TRY FOR MORE
05800 SNEOF: SETZM (T1) ;MAKE SURE OF ZERO WORD
05900 TRO FL,EOF2 ;SET EOF FLAG
06000 MOVE T1,INPG ;GET INPUT PAGE
06100 MOVEM T1,BGPG ;AND SET LARGEST PAGE
06200 TRO FL,BGSN
06300 SETZM SVWD ;ALSO ZERO EXTRA WORD
06400 POPJ P, ;AND RETURN
06500
06600 CKPGMK: SETZM OLDLIN ;RESET LINE LAST INPUT
06700 AOS INPG ;INCR INPUT PAGE
06800 MOVEM T3,0(T1) ;STASH PGMK
06900 AOS WC ;INCR WORD/COUNT
07000 PUSHJ P,GETWD ;PASS NEXT WORD
07100 MOVE T3,PGMKW2 ;GRNTEE CORRECT P/M 2ND WORD
07200 MOVEM T3,1(T1) ;STASH
07300 AOS WC ;INCR WC
07400 SETZM 2(T1) ;GRNTEE ZERO WORD
07500 SETZM SVWD ;FORCE READ
07600 MOVEI T1,2(T1) ;CORRECT PNTR
07700 JRST FILBF3 ;CHECK FULL
07800
07900 INLTL: PUSHJ P,GETWD ;FIND THE END OF THE LINE ON INPUT
08000 JUMPE T3,INLTL2 ;THIS IS IT
08100 TRNN T3,1 ;OR MAYBE THIS
08200 JRST INLTL ;KEEP LOOKING
08300 INLTL2: MOVEM T3,SVWD ;SAVE IT
08400 PUSH P,T1 ;SAVE POINTER TO END OF IT
08500 SUBI T1,2 ;LAST PART THAT IS IN THE LINE
08600 MOVEI T2,<BYTE (21)0(7)15,12> ;A CRLF
08700 DPB T2,[POINT 15,(T1),35] ;MAKE SURE IT ENDS PROPERLY
08800 INLTL1: SKIPN T2,(T1) ;NOW LOOK FOR THE START OF IT
08900 ERROR ICN ;SOMETHING HAS GONE WRONG, THERE IS NO LINE
09000 TRNN T2,1 ;START?
09100 SOJA T1,INLTL1 ;NO, TRY AGAIN
09200 MOVE T2,INPG ;PRINT HIM THE CURRENT PAGE
09300 PUSHJ P,PGPRN
09400 PUSHJ P,OUTLIN ;PRINT THE LINE
09500 RERROR LTL ;AND THE ERROR MESSAGE
09600 POP P,T1 ;RESTORE POINTER TO END
09700 SOS WC ;GET WORD COUNT CORRECTED
09800 SOJA T1,FILBF0 ;AND CONTINUE FILL
09900
10000 OUTOFO: PUSH P,T1 ;SAVE THE POINTER
10100 PUSH P,T3 ;SAVE T3 ALSO
10200 SUBI T1,1 ;GET BACK INTO LINE
10300 OUTOF1: SKIPN T2,(T1) ;LOOK FOR START OF LINE
10400 ERROR ICN ;HORRIBLE CONFUSION
10500 TRNN T2,1 ;CHECK FOR SEQ NUM
10600 SOJA T1,OUTOF1 ;NOPE, TRY SOME MORE
10700 MOVE T2,INPG ;PRINT HIM THE PAGE
10800 PUSHJ P,PGPRN
10900 PUSHJ P,OUTLIN ;PRINT THE LINE
11000 RERROR ORDER ;GIVE HIM SOMETHING TO THINK ABOUT
11100 POP P,T3 ;RESTORE
11200 POP P,T1 ;GET SET TO GO ON
11300 JRST FILBF5 ;GO
00100 CKTECO: TRNE T3,1 ;CHECK FOR A LINE NUMBER
00200 JRST NOTECO ;NO ITS NOT A TECO FILE
00300 TLO FL,TECOF ;SET WARNING FLAG
00400 SETZM SVWD ;GRNTEE USE FIRST SEQ #
00410 IFN %SS064, <
00420 TLZ FL2,PMINSF ;SHOW NO P/M INSERTED
00430 >; END OF IFN %SS064
00500 TLNE FL,COPFIL ;IS IT ANOTHER FILE?
00600 JRST CKTEC2 ;SPECIAL CHECK
00700 TLO FL2,PCHGF!FCHGF ;SAVE WE'VE CHANGED
00800 SETSTS IN,1 ;SET FOR CHAR AT A TIME INPUT
00900 MOVSI T3,(<POINT 7,0>)
01000 HLLM T3,IBUF+1 ;SET INPUT BYTE POINTER
01100 MOVEI T3,5 ;COMVERT TO CHRS
01200 IMULM T3,IBUF+2
01300 AOS IBUF+2 ;AND COMPENSATE FOR THINKING WE TOOK ONE
01400
01500 RDTECO: HRRZM T1,TMPT1 ;SAVE THIS FOR A WHILE
01600 MOVEI T3,1(T1) ;ZERO OUT A FEW WORDS
01700 HRL T3,T1
01800 SETZM (T1)
01900 BLT T3,MXWPL(T1)
02000 ADDI T1,1 ;THIS IS WHERE CHRS SHOULD BE PUT
02100 PUSH P,T1 ;SAVE
02200 SKIPE BASICF ;IS THIS A BASIC FILE
02300 JRST RDBAS ;YES: PROCESS SPECIAL
02400 SKIPE T1,SVWD ;CHECK BEGINNING OF PAGE
02500 CAIN T1,1 ;...
02600 JRST [MOVE T1,TECFST
02700 MOVEM T1,SVWD
02800 MOVEM T1,SVWD2
02900 JRST RDTEC1]
03000 MOVE T2,TECINC ;GET INCREMENT
03100 PUSHJ P,ASCIAD
03200 MOVEM T1,SVWD ;SAVE FOR LATER
03300 MOVEM T1,SVWD2 ;AND FOR ORDER CHECK
03400 CAMGE T1,TECINC ;CHECK WAR
03500 JRST INSPG1 ;FORCE PAGE INSERT
03600 RDTEC1: EXCH T1,(P) ;GET OLD T1 BACK AND SAVE NUMBER
03700 MOVEI T2,MXWPL*5-2 ;COUNT
03800 MOVEI T3,11 ;FIRST CHR
03900 HRLI T1,(<POINT 7,0>)
04000 IDPB T3,T1
04100 LINL1: PUSHJ P,GETWD ;NEXT CHR
04200 LINL1A: CAIN T3,15
04300 JRST LINL1 ;IGNORE RETURNS
04400 CAIN T3,14
04500 JRST [SKIPE BASICF ;ILLEGAL IN BASIC MODE
04600 ERROR BBF
04700 JRST IPGMK]
04710 IFN %SS064, <
04720 TLZ FL2,PMINSF ;SHOW NO P/M INSERTED
04730 >; END OF IFN %SS064
04800 JUMPE T3,EOF1 ;MUST BE END OF FILE
04900 POP P,-1(T1) ;PUT NUMBER IN PROPER PLACE
05000 JRST LP1 ;AND READ MORE OF LINE
05100 CLP: PUSHJ P,GETWD
05200 LP1: CAIN T3,15 ;IGNORE RETURNS
05300 JRST CLP
05400 CAIE T3,0 ;FOR EOF
05500 CAIN T3,12 ;OR LINE FEED
05600 JRST LINFD ;GO PUT IN RETURN LINE FEED
05700 CAIN T3,14
05800 JRST LINFD
05900 IDPB T3,T1 ;ELSE DEPOSTI
06000 SOJG T2,CLP ;HAVE WE RUN OUT
06100 ADD T1,[XWD 700,0] ;BACK UP POINTER
06200 TLZ FL,TECOF ;USE THE ABSENCE AS A FLAG
06300 PUSHJ P,GETWD
06400 CAIE T3,12
06500 JUMPN T3,.-2
06600 LINFD: MOVEI T3,15
06700 IDPB T3,T1
06800 MOVEI T3,12
06900 IDPB T3,T1
07000 MOVEI T1,1(T1)
07100 MOVE T3,T1
07200 SUB T3,TMPT1 ;GET COUNT
07300 ADDM T3,WC
07400 TLOE FL,TECOF ;IF OFF WE HAD A LTL ERR
07500 JRST FILBF0 ;THIS WILL FINISH UP
07600 PUSH P,T1 ;SET UP FOR LTL CODE
07700 AOS WC
07800 AOS (P)
07900 SOJA T1,INLTL1
08000
08100 INSPG1: POP P,T1
08190 IFE %SS064, <
08200 SKIPA
08300 IPGMK: POP P,T2 ;GET RID OF IT
08310 >; END OF IFE %SS064
08320 IFN %SS064, <
08330 TLO FL2,PMINSF ;SHOW P/M INSERTED
08340 JRST IPGMK1 ; & CONTINUE
08350 IPGMK: TLZE FL2,PMINSF ;TEST FOR P/M JUST INSERTED & CLEAR BIT
08360 JRST LINL1 ; YES, THEN DONE NOW
08370 POP P,T2 ;POP OFF THE STACK
08380 IPGMK1: ;HERE TO INSERT A P/M
08390 >; END OF IFN %SS064
08400 MOVEI T3,1 ;SO IT WILL NOT BE EOF
08500 MOVEM T3,SVWD ;SO WE START OVER
08600 MOVE T3,PGMK
08700 MOVEM T3,OLDLIN
08800 MOVEM T3,-1(T1)
08900 MOVEI T2,2
09000 ADDM T2,WC
09100 MOVE T3,PGMKW2
09200 MOVEM T3,(T1)
09300 SETZM 1(T1) ;GRNTEE ZERO
09400 MOVEI T1,1(T1) ;UPDATE PNTR
09500 AOS INPG ;INCR INPUT PAGE
09600 JRST FILBF3 ;FINISH OFF
09700
09800 EOF1: POP P,T2 ;CLEAR STACK
09900 SOJA T1,SNEOF
10000
10100 ;HERE TO HANDLE BASIC FILES
10200
10300 RDBAS: MOVEI T2,5 ;5 CHARS MAX
10400 MOVE T1,[<ASCII "00000">_<-1>]
10500
10600 RDBAS0: PUSHJ P,GETWD ;GET CHAR
10700 JUMPE T3,BASEOF ;MUST BE EOF
10800 CAIE T3,40 ;SKIP SPACES
10900 CAIN T3,11 ;AND/OR TABS
11000 JRST RDBAS0
11010 IFN %SS047, <
11020 CAIN T3,14 ;TEST FOR <FF>
11030 JRST [ ; YES, JUMP
11040 PUSHJ P,GETWD ;READ NEXT CHAR
11050 JUMPE T3,BASEOF ; EOF, OK, BUT <FF> DROPPED
11060 ERROR BBF ; MORE TEXT, BAD BASIC FILE
11070 ]
11080 >; END OF IFN %SS047
11100 CAIG T3,"9" ;FIRST CHAR MUST BE A DIGIT
11200 CAIGE T3,"0" ;...
11300 ERROR BBF
11400 JRST RDBDG1
11500
11600 RDBDIG: PUSHJ P,GETWD ;FETCH NEXT CHAR
11700 JUMPE T3,BASEOF ;EOF SEEN IF T3 := 0
11800 CAIG T3,"9" ;MUST BE DIGIT
11900 CAIGE T3,"0"
12000 JRST RDBDG2 ;END OF DIGIT STREAM
12100 RDBDG1: LSH T1,7 ;MAKE ROOM FOR NEW DIGIT
12200 ADD T1,T3
12300 SOJA T2,RDBDIG ;ADD IN AND READ NEXT
12400
12500 RDBDG2: SKIPGE T2 ;CHECK FOR MORE THAN 5
12600 ERROR BBF
12700 LSH T1,1 ;MAKE LIKE REAL SEQ #
12800 IORI T1,1
12900 MOVEM T1,SVWD ;SAVE GOOD THINGS
13000 MOVEM T1,SVWD2
13100 EXCH T1,0(P) ;GET PNTR BACK & SAVE #
13200 HRLI T1,(<POINT 7,0>);FORM B.P.
13300 MOVEI T2,11 ;DEPOSIT A TAB
13400 IDPB T2,T1 ;...
13500 MOVEI T2,MXWPL*5-2 ;INIT LTL CNTR
13600 CAIE T3,11 ;IF TAB
13700 CAIN T3,40 ; OR SPACE
13800 JRST LINL1 ;GET NEXT CHAR
13900 JRST LINL1A ;ELSE ALREADY HAVE CHAR
14000
14100 BASEOF: POP P,T1 ;RETURN POINTER
14200 JRST SNEOF ;SAY EOF SEEN
14300
14400 SUBTTL RANGE SPECIFIER READERS
00100
00200 ;ROUTINE TO GET ONE LINE NUMBER FROM INPUT STREAM. HANDLES + AND -
00300
00400 GETLS: PUSHJ P,SCAN
00500 GETL: TRZ FL,LINSN!ADDL!SUBL
00600 TRZ FL2,STARF
00700 TLZ FL2,UARWF
00800 CAIN C,"^"
00900 JRST DOFST
01000 CAIN C,"*"
01100 JRST DOLST
01110 IFN %SS014, <
01120 CAIN C,"+" ;TEST FOR PLUS
01130 JRST DOPLUS ; YES, JUMP
01140 CAIN C,"-" ;TEST FOR MINUS
01150 JRST DOMINS ; YES, JUMP
01160 PUSHJ P,CKIMPL ;CHECK FOR TERMINATOR
01170 JRST DOIMPL ; YES, TREAT AS IMPLIED "."
01180 >; END OF IFN %SS014
01200 IFN EXTEND,<
01300 CAIN C,200 ;DO WE HAVE TO SEARCH FOR IT
01400 PUSHJ P,LSRCH ;OK THEN HERE WE GO
01500 >
01600 TRZN FL,NUMF
01700 POPJ P, ;SCAN DID NOT SEE A NUMBER RETURN (CALLER CAN GIVER ERR)
01800 MOVEM T1,HILN ;SAVE THE NUMBER HERE
01900 GETL1: TRO FL,LINSN ;SET A FLAG TO SAY WE SAW THE LINE
02000 PUSHJ P,SCAN ;SCAN FOR + OR -
02100 CAIN C,"+"
02200 JRST ADDNUM
02300 CAIE C,"-"
02400 POPJ P, ;NEITHER
02500 TROA FL,SUBL ;SET SUBTRACT FLAG
02600 ADDNUM: TRO FL,ADDL ;SET ADD FLAG
02610 IFN %SS014, <
02620 SUBNUM: ;HERE WITH ADD/SUB TO IMPLIED LINE #
02630 >; END OF IFN %SS014
02700 PUSHJ P,SCAN ;SCAN ANOTHER
02800 TRZN FL,NUMF ;WAS IT A NUMBER
02900 NERROR ILC ;ANYTHING ELSE IS ILLEGAL
03000 MOVEM T2,SVINC ;SAVE IT
03100 JRST SCAN ;RETURN AFTER SCANNING ONE MORE
03200 DOLST: TRO FL2,STARF
03300 JRST GETL1
03400 DOFST: TLO FL2,UARWF
03500 JRST GETL1
03505
03510 IFN %SS014, <
03515 DOPLUS: TROA FL,ADDL ;SET FLAG TO SHOW LINE ADDITION
03520 DOMINS: TRO FL,SUBL ;SET FLAG TO SHOW LINE SUBTRACTION
03525 PUSHJ P,DOIMPL ;SET UP IMPLIED LINE #
03530 JRST SUBNUM ; & GO READ OFFSET
03535 DOIMPL: TRO FL,LINSN!PGSN ;SHOW LINE & PAGE SEEN
03540 MOVE T1,CLN ;GET CURRENT LINE #
03545 MOVE T2,CPGL ;GET CURRENT PAGE #
03550 MOVEM T1,HILN ;STORE LINE #
03555 POPJ P, ;RETURN TO CALLER
03560 >; END OF IFN %SS014
03600
03700
03800
03900 ;ROUTINE TO RESOLVE THE + AND - IN THE LINE NUMBER. WE MUST WAIT
04000 ;UNTIL THE PAGE HAS BEEN DEFINED BEFORE DOING THIS
04100
04200 ADDSUB: MOVE SINDEX,HILN ;GET THE NUMBER
04300 MOVE T1,HIPG ;GET THE REQUIRED PAGE
04400 MOVEM T1,DPG ;AND SET IT AS THE DESIRED ONE
04500 TLNE FL2,UARWF
04600 JRST [MOVE SINDEX,[<ASCII /00000/>!1]
04700 PUSHJ P,FIND
04800 SKIPE T1 ;FIND ANY
04900 CAMN T1,PGMK
04990 IFE %SS027, <
05000 MOVE T1,[<ASCII /00100/>!1]
05010 >; END OF IFE %SS027
05020 IFN %SS027, <
05030 MOVE T1,TECFST ;GET DEFAULT STARTING LINE #
05040 >; END OF IFN %SS027
05100 MOVE SINDEX,T1
05200 JRST DOAS]
05300 TRNN FL2,STARF
05400 JRST DOAS
05500 MOVE SINDEX,[<ASCII /99999/>!1] ;FIND A BIG LINE
05600 PUSHJ P,FIND
05700 CAME T1,[<ASCII /99999/>!1] ;IF ITS THERE ITS LAST
05800 PUSHJ P,FINDB ;ELSE BACK UP
05900 SKIPE T1 ;CHECK TO SEE IF EMPTY PAGE
06000 CAMN T1,PGMK
06090 IFE %SS027, <
06100 SKIPA
06110 >; END OF IFE %SS027
06120 IFN %SS027, <
06130 SKIPA SINDEX,TECFST ;IF PAGE EMPTY, SET TO 'START' FOR
06140 ; POSSIBLE INSERTION, SINCE ALL LINE
06150 ; #'S ARE EQUIVALENT FOR AN EMPTY PAGE
06160 >; END OF IFN %SS027
06200 MOVE SINDEX,T1 ;OK, USE ONE FOUND, ELSE LEAVE BIG
06300 DOAS: MOVEM SINDEX,HILN ;STORE ACTUAL # IF ^/* ;** FIX **
06350 TRZE FL,ADDL ;DID WE WANT TO ADD? ;** FIX **
06400 JRST ADLIN ;YES, GO ADD
06500 TRZN FL,SUBL ;OR SUBTRACT?
06600 CPOPJ: POPJ P, ;NO, RETURN
06700 PUSHJ P,FIND ;GET THE DESIRED LINE
06800 SUBL1: SOSGE SVINC ;DO WE WANT TO GO BACK STILL FARTHER
06900 POPJ P, ;NO, ALL DONE
07000 PUSHJ P,FINDB ;GET THE PREVIOUS LINE
07100 SKIPE T1 ;0 MUST BE AT START OF BUFFER, QUIT
07200 CAMN T1,PGMK ;WAS IT A PAGE MARK?
07300 POPJ P, ;YES, AS FAR AS WE GO, SINDEX HAS CORRECT NUMBER
07400 MOVE SINDEX,T1 ;THIS WILL DO
07500 JRST SUBL1 ;GO TRY FOR MORE
07600 ADLIN: PUSHJ P,FIND ;GET DESIRED LINE
07700 CAME T1,PGMK ;WAS IT A PAGE MARK?
07800 JUMPN T1,ADLIN1 ;OR 0 (I.E. END OF FILE)
07900 POPJ P, ;RETURN WITH ORIGINAL NUMBER
08000 ADLIN1: CAME T1,HILN ;SEE IF AN EXACT MATCH
08100 SOS SVINC ;IF NO, ALREADY ARE +1
08200 MOVE SINDEX,T1 ;GET THE WORD WE HAVE FOUND
08300 ADLIN2: SOSGE SVINC ;NEED TO GO FURTHER
08400 POPJ P, ;NO, RETURN RESULTS
08500 PUSHJ P,FINDN ;GET THE NEXT LINE IN SEQUENCE
08600 CAME T1,PGMK ;PAGE MARK?
08700 JUMPN T1,.+2 ;OR EOF
08800 POPJ P, ;YES, RETURN
08900 MOVE SINDEX,T1 ;ACCEPT NEW NUMBER
09000 JRST ADLIN2 ;AND LOOK FOR MORE
09100
00100
00200 ;ROUTINE GETS A FULL SEQ NUMBER OF FORM A/B
00300
00400 GETLAS: PUSHJ P,SCAN
00500 GETLA: TRZ FL,PGSN ;NO PAGE SEEN YET
00600 PUSHJ P,GETL ;GET THE LINE NUMBER PART
00700 MOVE T2,CPGL ;IN CASE LSRCH GOT A NEW PAGE
00800 TRNE FL,PGSN ;DID LSRCH GET PAGE?
00900 MOVEM T2,HIPG ;YES, USE IT
01000 CAIE C,"/" ;IS THIS A PAGE COMMING?
01100 JRST NOPG ;NO, A LINE NUMBER AT MOST
01200 PUSHJ P,SCAN ;YES, GET THE PAGE NUMBER
01210 IFN %SS014, <
01220 CAIE C,"+" ;TEST FOR IMPLIED PAGE #
01230 CAIN C,"-" ;TEST FOR IMPLIED PAGE #
01240 JRST DOPERD ; EITHER, JUMP
01250 PUSHJ P,CKIMPL ;CHECK FOR IMPLIED '/.'
01260 JRST DOPERD ; YES, JUMP
01270 >; END OF IFN %SS014
01300 CAIN C,"*"
01400 JRST LASTPG ;GET LAST PAGE #
01500 CAIE C,"^" ;UPARROW MEANS
01600 JRST GETLPG ;GET PAGE 1
01700 MOVEI T2,1
01800 TRO FL,NUMF ;MAKE LIKE NUMBER
01900 GETLPG: SKIPLE T2 ;NUMBERS .LE. 0 LOSE
02000 TRZN FL,NUMF ;WAS IT A NUMBER
02100 NERROR ILC ;LOSE LOSE
02200 TRO FL,PGSN ;YEP, WE SAW IT
02300 MOVEM T2,HIPG ;SAVE THAT NUMBER
02400 PUSHJ P,SCAN ;CHECK FOR + OR -
02410 IFN %SS014, <
02420 JRST NOPERD ;JUMP AROUND CODE
02430 DOPERD: MOVE T2,CPGL ;GET CURRENT PAGE #
02440 MOVEM T2,HIPG ;STORE CURRENT PAGE
02450 TRO FL,PGSN ;SHOW PAGE # SEEN
02460 NOPERD: ;HERE TO CHECK FOR RELATIVE PAGE
02470 >; END OF IFN %SS014
02500 CAIN C,"+"
02600 JRST PGPLS
02700 CAIE C,"-"
02800 JRST NOPG ;NO, GO DO ADSUB ON LINE NUMBER
02900 PUSHJ P,SCAN ;GET THE NUMBER
03000 TRZN FL,NUMF ;MUST BE A NUMBER
03100 NERROR ILC
03200 MOVE T1,HIPG
03300 SUB T1,T2
03400 MOVEM T1,HIPG ;FILL IN NUMBER
03500 NOPGA: PUSHJ P,SCAN ;SCAN PAST NUMBER
03600 NOPG: TRNN FL,LINSN!PGSN ;DID WE SEE A LINE OR A PAGE?
03700 NERROR ILC ;NO, SOMETHING IS WRONG
03800 PUSH P,T1 ;SAVE (HAVE ALREADY SCANNED)
03900 PUSH P,T2
04000 PUSHJ P,ADDSUB ;TAKE CARE OF + AND - FOR LINE
04100 POP P,T2
04200 POP P,T1
04300 MOVEM SINDEX,HILN ;SAVE RESULT
04400 POPJ P, ;AND RETURN
04500
04600 PGPLS: PUSHJ P,SCAN ;GET NUMBER TO ADD
04700 TRZN FL,NUMF ;A NUMBER?
04800 NERROR ILC ;NO, NERROR
04900 ADDM T2,HIPG ;ADD IT IN
05000 JRST NOPGA ;AND CLEAN UP
05100
05200 LASTPG: TRNE FL,BGSN ;SEEN LAST
05300 JRST LSTPG1 ;YES: SKIP CODE
05400 MOVSI T1,1
05500 MOVEM T1,DPG ;TRY FOR LARGE
05600 MOVEI SINDEX,0
05700 PUSHJ P,FIND
05800 TRNN FL,BGSN ;SHOULD SEE IT NOW
05900 ERROR ICN
06000 LSTPG1: MOVE T2,BGPG
06100 TRO FL,NUMF ;NUMBER SEEN
06200 JRST GETLPG
06300
06400
06500
06600 ;ROUTINE SETS HIPG IN CASE NONE SEEN BY GETLA, THEN CALLS GETLA
06700
06800 GET1S: PUSHJ P,SCAN
06900 GET1: MOVE T3,CPGL
07000 MOVEM T3,HIPG
07100 JRST GETLA
07200
07300
07400
07500 ;GET A PAIR OF FORM A/B,C/D LOLN IS SET BY CALLER BEFORE CALL
07600
07700 GET2S: PUSHJ P,SCAN
07800 GET2: TRZ FL,CNTF ;NOT A ! COMMAND
07810 IFN %SS014, <
07820 PUSHJ P,CKIMPL ;CHECK FOR IMPLIED LINE #
07830 JRST GET2EX ; YES, JUMP
07840 >; END OF IFN %SS014
07850 IFN %SS072, <
07860 TRNE FL,IDF ;TEST FOR AN IDENTIFIER
07870 JRST GET2SY ; YES, POSSIBLE SYMBOLIC RANGE
07880 >; END OF IFN %SS072
07900 PUSHJ P,GET1 ;GET A LINE AND PAGE NUMBER PAIR
08000 MOVE T3,HIPG ;NOW SET LOWER PAGE TO THE ONE SEEN
08100 MOVEM T3,LOPG
08200 MOVE T3,HILN ;RESET LOW LINE IS A NUMBER SEEN
08300 TRNE FL,LINSN
08400 MOVEM T3,LOLN
08500 GET2HF:MOVE T3,[<ASCII /99999/>!1] ;SET UP A LARGE NUMBER
08600 TRNN FL,LINSN ;IF NO LINE NUMBER SEEN
08700 MOVEM T3,HILN
08790 IFE %SS014, <
08800 TRZ FL,PGSN ;SO DELETE CAN DETECT A SECOND PAGE SPEC
08810 >; END OF IFE %SS014
08900 CAIN C,"!" ;IS IT A ! COMMAND?
09000 JRST GET2CT ;GO TAKE CARE OF IT
09100 CAIE C,":" ;CHECK FOR SECOND SET
09200 POPJ P, ;NOPE, RETURN
09300 MOVEM T3,HILN ;SET HILN ANYWAY
09390 IFE %SS072, <
09400 JRST GETLAS ;AND GO GET THE SECOND PAIR
09402 >; END OF IFE %SS072
09404 IFN %SS072, <
09406 PUSHJ P,SCAN ;SCAN FOR NEXT ATOM
09408 TRNN FL,IDF ;TEST FOR AN IDENTIFIER
09410 JRST GETLA ; NO, JUMP
09412 MOVS T1,ACCUM ;GET THE IDENTIFIER, SWAPPED
09414 CAIE T1,'EF ' ;TEST FOR "...:EF" RANGE
09416 NERROR ILC ; NO, ERROR
09418 GET2AL: MOVE T3,[<ASCII /99999/>!1] ;GET LARGEST POSSIBLE LINE #
09420 MOVEM T3,HILN ; & STORE
09422 MOVSI T3,1 ;GET EXTREMELY LARGE PAGE #
09424 MOVEM T3,HIPG ; & STORE
09426 TRZ FL,LINSN!ADDL!SUBL ;CLEAR LINE-TYPE FLAGS
09428 TRO FL,PGSN ;SHOW PAGE # SEEN
09430 JRST SCAN ;GO SCAN NEXT & RETURN
09432
09434 GET2SY: MOVS T1,ACCUM ;GET THE IDENTIFIER, SWAPPED
09436 CAIE T1,'BF ' ;TEST FOR "BF..." FORMAT
09438 CAIN T1,'EF ' ;TEST FOR "EF" FORMAT
09440 SKIPA T3,[<ASCII /00000/>!1] ; EITHER, GET 0 STARTING LINE # & SKIP
09442 NERROR ILC ; NEITHER, ERROR
09444 MOVEM T3,HILN ;SET AS ENDING LINE #
09446 MOVEM T3,LOLN ;SET AS STARTING LINE #
09448 MOVEI T3,1 ;GET PAGE # 1
09450 MOVEM T3,HIPG ;SET AS ENDING PAGE #
09452 MOVEM T3,LOPG ;SET AS STARTING PAGE #
09454 TRZ FL,PGSN!ADDL!SUBL ;CLEAR FLAGS
09456 TRO FL,LINSN ;SHOW LINE # SEEN
09458 CAIN T1,'EF ' ;TEST FOR "EF" RANGE
09460 JRST GET2AL ; YES, JUMP
09462 PUSHJ P,SCAN ;GET NEXT ATOM IF "BF..."
09464 CAIE C,"!" ;TEST FOR RANGE SPECIFIER
09466 CAIN C,":" ;TEST FOR RANGE SPECIFIER
09468 JRST GET2HF ; YES, GO READ THE RANGE
09470 NERROR ILC ; NO, "BF" IS ILLEGAL
09472 >; END OF IFN %SS072
09474
09476 IFN %SS014, <
09478 GET2EX: MOVE T3,CLN ;GET CURRENT LINE
09480 MOVEM T3,LOLN ;STORE AS LOW LINE #
09482 MOVEM T3,HILN ; & AS HIGH LINE #
09484 MOVE T3,CPGL ;GET CURRENT PAGE
09486 MOVEM T3,LOPG ;STORE AS LOW PAGE #
09488 MOVEM T3,HIPG ; & AS HIGH PAGE #
09490 TRO FL,LINSN ;SHOW LINE # SEEN
09492 JRST GET2HF ;GO GET 2D LINE #
09494 >; END OF IFN %SS014
09500
09600 GET2CT: TRO FL,CNTF ;SET THE APPROPRIATE FLAG
09700 PUSHJ P,SCAN ;THERE SHOULD BE A NUMBER HERE
09800 TRNN FL,NUMF
09900 NERROR ILC ;LOSE
10000 MOVEM T2,SVCNT ;HANG ON TO IT
10100 JRST SCAN ;SCAN NEXT AND RETURN
10200
10300
10400 IFN %SS014, <
10500 CKIMPL: CAIE C,"," ;TEST FOR COMMA
10600 CAIN C,";" ;TEST FOR SEMI-COLON
10700 POPJ P, ; YES, IMPLIED #, RETURN +0
10800 CAIE C,":" ;TEST FOR COLON
10900 CAIN C,"!" ;TEST FOR EXCLAMATION PT
11000 POPJ P, ; YES, RETURN +0
11100 CAIE C,"=" ;TEST FOR EQUAL SIGN
11200 CAIN C,"_" ;TEST FOR BACK-ARROW
11300 POPJ P, ; YES, RETURN +0
11400 TRNN FL,EXTOG ;TEST FOR EXPERT USER
11500 JRST CPOPJ1 ; NO, RETURN+1 (. NOT IMPLIED AT EOL)
11600 TRNE FL,TERMF ;TEST FOR END OF LINE
11700 POPJ P, ; YES, RETURN +0
11800 JRST CPOPJ1 ;NONE OF THE ABOVE, RETURN +1
11900 >; END OF IFN %SS014
12000
12100 SUBTTL LINE NUMBER SEARCH
00100 IFN EXTEND,<
00200 ;SEARCH FOR A LINE AND USE ITS NUMBER INSTEAD OF .
00300 ;MOSTLY PLAGIARIZED FROM SEARCH
00400
00500 LSRCH: PUSH P,SVINC ;SAVE PREVIOUSLY GATHERED LINE NUMBERS
00600 PUSH P,SVCNT
00700 PUSH P,HIPG
00800 PUSH P,LOLN
00900 PUSH P,LOPG
01000 PUSH P,FL ;SAVE FLAGS IN CASE CALLED WITHIN SEARCH
01100 PUSH P,FL2
01200 TLZ FL,ASSMF ;CLEAR ALL FLAGS
01300 SETZM LOLN ;JUST LIKE EVERYONE ELSE HAS TO
01400 SETZM LSCNT ;START WITH ZERO
01500 SOSGE LSBUFN ;GET STRING BUFFER NUMBER
01600 NERROR TMS ;NESTING TOO DEEP
01700 MOVE T2,LSBUFN ;INDEX IN STRING BUFFER TABLES
01800 MOVE T1,LSPTR(T2) ;SET UP BYTE POINTER
01900 MOVE T3,LSPTT(T2) ;AND POINTER TO BYTE POINTER TABLE
02000 PUSHJ P,SSTRNG ;GET A SEARCH STRING
02100 JRST [MOVE T2,LSBUFN ;INDEX TO POINTERS
02200 SKIPN @LSPTT(T2) ;WAS STRING SET?
02300 NERROR NSG ;NO, TELL HIM
02310 IFN %SS043*DEFCRL, <
02320 TLO FL,ASSMF ;ASSUME ".+1" CONSTRUCTION
02330 >; END OF IFN %SS043*DEFCRL
02400 CAIN C,12
02500 JRST ASLMD1 ;SPECIAL CONTINUE MODE
02600 JRST .+1] ;YES, USE OLD ONE
02700 TLZ FL,NUMSRF!DECID!EXCTSR ;CLEAR FLAGS
02705 IFN %SS040, <
02710 TRZ FL2,DOEXCT ;ASSUME NON-EXACT MATCHING
02715 SKIPE EXACTF ;TEST FOR /EXACT
02720 TRO FL2,DOEXCT ; YES, SET EXACT MATCH
02725 >; END OF IFN %SS040
02730 IFN %SS041, <
02735 TLNE FL2,PDECID ;TEST FOR /DECIDE
02740 TLO FL,DECID ; YES, SET DECIDE-MODE
02745 >; END OF IFN %SS041
02750 IFN %SS070, <
02755 TLZ FL2,FNDNOT ;CLEAR "FIND NOT" FLAG
02760 >; END OF IFN %SS070
02800 PUSHJ P,SCAN ;CHECK FOR WHAT COMES AFTER
02900 TRNN FL,TERMF ;IF TERMINATOR
03000 CAIN C,"," ;OR ,
03100 JRST ASLMDT ;SET UP LIMITS SPECIALLY
03200 CAIE C,"!"
03300 CAIN C,":"
03400 JRST ASLMDT ;LET HIM SPECIFY 2ND HALF OF RANGE
03410 IFN %SS043*DEFCRL, <
03420 TLZ FL,ASSMF ;CLEAR ASSUME .+1 FLAG
03430 >; END OF IFN %SS043*DEFCRL
03500 PUSHJ P,GET2 ;ELSE CALL USUAL LIMIT ROUTINE
03600 LSC4: MOVE T1,HILN ;SAVE END OF RANGE
03700 MOVEM T1,LSHILN
03800 MOVE T1,HIPG
03900 MOVEM T1,LSHIPG
03990 IFE %SS042, <
04000 CAIE C,"," ;ANY MORE ARGUMENTS?
04100 JRST LSC1 ;NO, CHECK TERMINATOR AND PROCEED
04200 PUSHJ P,SCAN ;YES, SEE WHAT IT IS
04300 TRNN FL,IDF ;SHOULD BE IDENT OR NUMBER
04400 JRST LSC2 ;NOT IDENT, CHECK FOR NUMBER OF SEARCHES
04500 MOVS T1,ACCUM ;GET THE IDENT
04600 CAIN T1,(<SIXBIT /N />) ;AND FIND OUT WHAT IT IS
04700 TLO FL,NUMSRF!DECID
04800 CAIN T1,(<SIXBIT /D />)
04900 TLO FL,DECID ;WANTS TO DECIDE ON LINE
05000 TLNN FL,NUMSRF!DECID ;WAS IT EITHER?
05100 JRST LSC3 ;NO, CHECK E
05200 PUSHJ P,SCAN ;CONTINUE LOOKING
05300 CAIE C,","
05400 JRST LSC1 ;NO MORE ARGUMENTS
05500 PUSHJ P,SCAN ;WELL WHAT KIND IS THIS ONE?
05600 TRNN FL,IDF ;MORE IDENTS?
05700 JRST LSC2 ;NO, MUST BE NUMBER OF SEARCHES
05800 MOVS T1,ACCUM
05900 LSC3: CAIE T1,(<SIXBIT /E />)
06000 NERROR ILC ;NO, HE MUST HAVE MADE A MISTAKE
06100 TLO FL,EXCTSR ;YES, REMEMBER IT
06200 PUSHJ P,SCAN ;AND CHECK FOR MORE
06300 CAIE C,","
06400 JRST LSC1 ;NO MORE
06500 PUSHJ P,SCAN ;ONLY ONE THING IT CAN BE NOW
06600 LSC2: TRNN FL,NUMF
06700 NERROR ILC ;NOPE, LOSE
06800 MOVEM T2,LSCNT ;SAVE AS COUNT OF LINES TO FIND
06900 PUSHJ P,SCAN ;GET TERMINATOR (WE HOPE)
06904 >; END OF IFE %SS042
06908 IFN %SS042, <
06912 MOVE SINDEX,[LSCNT,,[SIXBIT /N/
06916 TLO FL,NUMSRF!DECID
06920 SIXBIT /D/
06924 TLC FL,DECID
06928 IFE %SS040, <
06932 SIXBIT /E/
06936 TLO FL,EXCTSR
06940 >; END OF IFE %SS040
06944 IFN %SS040, <
06948 SIXBIT /E/
06952 TRC FL2,DOEXCT
06956 >; END OF IFN %SS040
06960 IFN %SS070, <
06964 SIXBIT /-/
06968 TLO FL2,FNDNOT
06972 >; END OF IFN %SS070
06976 EXP 0]]
06980 PUSHJ P,SCNMOD ;SCAN FOR ALL OPTIONS
06984 >; END OF IFN %SS042
07000 LSC1: TRNN FL,TERMF ;ALLS WELL THAT ENDS WELL
07100 NERROR ILC ;BUT THIS DOSNT
07200 LSCH1A: MOVE T1,LSBUFN
07300 MOVE T1,LSPTT(T1) ;GET POINTER TO STRINGS
07400 PUSHJ P,CODSR ;AND GENERATE CODE
00100 MOVE T1,LOPG ;GET SET TO HUNT IT
00200 MOVEM T1,DPG
00300 MOVEM T1,LSPG ;FLAG TO SAY IF WE SHOULD PRINT PAGE
00400 MOVE SINDEX,LOLN
00500 PUSHJ P,FIND
00600 TRZ FL,LINSN ;NO LINES YET
00700 ONLSC: PUSHJ P,ONMOV ;CHECK RANGE
00800 JRST ENDLSC ;DONE
00900 TLZE FL,ASSMF ;FIRST TIME AND WANT .+1?
01000 JRST [CAME T1,LOLN ;IS THERE EXACT MATCH?
01100 JRST .+1 ;NO, THIS IS .+1
01200 AOS SVCNT ;PRETEND WE DIDNT SEE IT
01300 JRST LSNXT] ;AND TAKE NEXT
01400 CAMN T1,PGMK ;PAGES ARE SPECIAL
01500 JRST LSCPAG ;SO TAKE GOOD CARE OF THEM
01600 MOVE T2,LSBUFN
01700 MOVE T2,LSPTT(T2) ;POINTER TO STRINGS
01790 IFE %SS070, <
01800 PUSHJ P,COMSRC ;GO SEARCH THIS LINE
01900 JRST LSNXT ;LOSER
01910 >; END OF IFE %SS070
01920 IFN %SS070, <
01930 PUSHJ P,COMTST ;GO MAKE LINE COMPARISON & TEST "FNDNOT" FLG
01940 JRST LSNXT ; NOT WANTED, SKIP IT
01950 >; END OF IFN %SS070
02000 MOVE T2,CPG ;GET CURRENT PAGE
02100 CAME T2,LSPG ;AND SEE IF WE SHOULD PRINT IT
02200 PUSHJ P,PGPRN ;YES
02300 MOVE T2,CPG ;NOW SET IT AS CURRENT
02400 MOVEM T2,CPGL
02500 MOVEM T2,LSPG ;ALSO RESET FLAG
02600 MOVE T2,(PNTR) ;ALSO SET LINE
02700 MOVEM T2,CLN
02800 TRO FL,LINSN ;WE SAW ONE
02900 TLNN FL,DECID ;DOES HE WANT OPTION?
03000 JRST LSNXTC ;NO, GO GET NEXT ONE OR STOP
03010 IFN %SS043, <
03020 PUSHJ P,CLRCTO ;CLEAR ^O, IF ON
03030 >; END OF IFN %SS043
03100 TLNE FL,NUMSRF ;DO WE WANT ONLY LINE NUMBERS?
03200 JRST LSCNUM ;YES
03300 MOVE T1,PNTR ;GO PRINT LINE
03400 PUSHJ P,OUTLIN
03410 IFN %SS043, <
03420 LSNXT0: OUTSTR [ASCIZ /D*/] ;TYPE A SPECIAL PROMPT
03430 >; END OF IFN %SS043
03500 LSNXT1:
03600 INCHRW T1
03700 ANDI T1,177
03790 IFE %SS037, <
03800 OCRLF
03900 CAIE T1,177 ;DID HE SAY RUBOUT(DO NOT USE)?
04000 JRST LSOUT ;NO, WE'RE THROUGH
04005 >; END OF IFE %SS037
04010 IFN %SS037, <
04015 CAIN T1,40 ;TEST FOR A BLANK
04020 JRST LSOUT0 ; YES, LINE ACCEPTED, JUMP
04025 CAIE T1,177 ;TEST FOR A RUBOUT
04030 JRST [ ; NO, ERROR
04035 OUTSTR [BYTE (7) 77,40,7,0,0] ;TYPE "? "<BELL>
04040 CLRBFI ;CLEAR TYPE-AHEAD
04045 JRST LSNXT1 ; & REPEAT
04050 ]
04055 TRNN FL,EXTOG ;TEST FOR EXPERT
04060 OUTSTR [ASCIZ /[Ignored]/] ; NO, TELL THE USER
04065 OCRLF ; & RETURN THE CARRIAGE
04070 >; END OF IFN %SS037
04100 LSNXTC: SOSG LSCNT ;HAVE WE FOUND ENOUGH
04200 JRST LSOUT ;YES, GIVE UP (WE HAVE SEEN AT LEAST ONE)
04300 LSNXT: PUSHJ P,FINDN ;GET NEXT LINE TO LOOK A
04400 JRST ONLSC
04500 LSCNUM: MOVE T1,(PNTR) ;PRINT SEQUENCE NUMBER
04590 IFE %SS021, <
04600 PUSHJ P,OUTSN
04700 OCRLF
04710 >; END OF IFE %SS021
04720 IFN %SS021, <
04730 PUSHJ P,OUNTSN ;TYPE SEQUENCE NUMBER W/O TAB
04740 >; END OF IFN %SS021
04790 IFE %SS043, <
04800 JRST LSNXT1 ;AND DECIDE
04810 >; END OF IFE %SS043
04820 IFN %SS043, <
04830 JRST LSNXT0 ;GO TYPE PROMPT & DECIDE
04840 >; END OF IFN %SS043
04850
04900 ENDLSC: TRZN FL,LINSN ;DID WE SEE ONE?
05000 NERROR NLN ;NULL RANGE
05100 JRST LSOUT
05200 LSCPAG: AOS CPG ;JUST ADVANCE PAGE COUNTER
05300 JRST LSNXT ;AND PROCEED
05310 IFN %SS037, <
05320 LSOUT0: OCRLF ;RETURN THE CARRIAGE
05330 >; END OF IFN %SS037
05400 LSOUT: POP P,FL2 ;RESTORE THE FLAGS WE USED
05500 POP P,T1
05600 AND T1,[XWD ASSMF!NUMSRF!EXCTSR!DECID,ADDL!SUBL!CNTF]
05700 ANDCM FL,[XWD ASSMF!NUMSRF!EXCTSR!DECID,ADDL!SUBL!CNTF]
05800 IOR FL,T1
05900 POP P,LOPG ;RESTORE PREVIOUS LINE NUMBERS
06000 POP P,LOLN
06100 POP P,HIPG
06200 POP P,SVCNT
06300 POP P,SVINC
06400 MOVE T1,CLN ;LOAD CURRENT LINE AND PAGE WHICH WE FOUND
06500 MOVE T2,CPGL
06600 TRO FL, NUMF!PGSN ;AND MAKE LIKE SCAN SAW A NUMBER
06700 AOS LSBUFN ;GO BACK TO SEARCH STRING ON PREVIOUS LEVEL IF ANY
06800 POPJ P, ;AND EXIT VICTORIOUS
00100 ASLMD1: TROA FL,CNTF ;MARK AS KEEP END OF RANGE
00200 ASLMDT: TRZ FL,CNTF ;JUST IN CASE
00290 IFE %SS043*DEFCRL, <
00300 TLO FL,ASSMF ;WE ASSUME .+1
00310 >; END OF IFE %SS043*DEFCRL
00400 MOVE T1,CLN ;SET THINGS UP FOR . TO INFINITY
00500 MOVEM T1,LOLN
00600 MOVEM T1,HILN ;AS GOOD AS ANYTHING WITH THE PAGE WE WILL
00700 MOVE T1,CPGL ;USE
00800 MOVEM T1,LOPG
00900 TRZE FL,CNTF ;KEEP END?
01000 JRST LNOSPC ;YES
01100 CAIE C,":" ;IF A : OR !
01200 CAIN C,"!"
01300 JRST HALFLS ;GET THE SECOND HALF (.+1 TO GIVEN)
01310 IFN %SS043*DEFCRL, <
01320 TLNE FL,ASSMF ;TEST FOR ASSUMED .+1
01330 JRST LNOSPB ; YES, THEN CONTINUE TO UPPER RANGE
01340 >; END OF IFN %SS043*DEFCRL
01400 MOVSI T1,377777 ;GET A LARGE PAGE
01500 MOVEM T1,HIPG
01600 JRST LSC4 ;BACK INTO THINGS
01700
01800 HALFLS: MOVEM T1,HIPG ;SET TOP AS /.
01900 PUSHJ P,GET2HF ;GET THE SECOND HALF
02000 JRST LSC4 ;AND GO
02100
02110 IFN %SS043*DEFCRL, <
02120 LNOSPB: TRO FL,CNTF ;SET A FLAG AGAIN -"$$" FORMAT REQUIRES MORE TEXT
02130 >; END OF IFN %SS043*DEFCRL
02200 LNOSPC: MOVE T1,LSHIPG
02300 MOVEM T1,HIPG ;PUT BACK END
02400 MOVE T1,LSHILN
02500 MOVEM T1,HILN
02510 IFN %SS043*DEFCRL, <
02520 TRZE FL,CNTF ;TEST FOR MORE TEXT TO SCAN
02530 JRST LSC4 ; YES, JUMP
02540 >; END OF IFN %SS043*DEFCRL
02600 JRST LSCH1A
02700 >
02800
02900 SUBTTL INITIALIZE
00100
00200
00300 ;HERE IS THE INITIALIZE CODE
00400
00500 STPT:
00590 IFE %SS066, <
00600 SKIPA ;SKIP IF NORMAL ENTRY ;** FIX **
00700 OUTSTR [ASCIZ /
00710 % SAIL feature not assembled/] ;IGNORE CCL ENTRY IF NOT ASS'D ;** FIX **
00720 >; END OF IFE %SS066
00730 IFN %SS066, <
00740 TDZA T1,T1 ;+0 ENTRY, SET TO ZERO
00750 SETO T1, ;+1 ENTRY, SET TO -1
00760 >; END OF IFN %SS066
00790 ;;*FIX* FOLLOWING CODE NOT NEEDED WITH REAL TWO-SEGMENT SUPPORT
00800 ;;*FIX* SETZM RPGSW
00900 ;;*FIX* SETZM TMPCF ;CLEAR TMPCOR FLAG
01000 IFN RENTSW,<
01100 ;;*FIX* MOVEI 0,IMPEND
01200 ;;*FIX* HRLM 0,.JBSA##
01300 RESET
01400 ;;*FIX* MOVE 0,.JBFF##
01500 ;;*FIX* CORE 0, ;GET ENUF CORE
01600 ;;*FIX* EXIT ;YOU LOSE
01700 MOVE 0,[XWD DATAB,DATABL]
01800 BLT 0,DATABL+DATAE-DATAB
01900 >
02000 SETZM ZEROB
02100 MOVE 0,[XWD ZEROB,ZEROB+1]
02200 BLT 0,IMPEND-1
02300 MOVE 0,[BYTE (7) 15,15,15,15,15]
02400 MOVEM 0,CRSX ;PUT CR'S IN PLACE
02405 IFN %SS066, <
02410 MOVEM T1,SAILSW ;STORE THE SAIL SWITCH
02415 >; END OF IFN %SS066
02420 IFN %SS006, <
02425 SETOM DEFPTH ;SET -1 TO READ DEFAULT PATH
02430 MOVE T1,[<SFDLVL+4>,,DEFPTH] ;GET PATH. UUO PARMS FOR DEFAULT PATH
02435 PATH. T1, ;READ THIS USER'S DEFAULT PATH
02440 HALT . ; ERROR, PUNT
02445 MOVE T1,[%LDSTP,,.GTLDV] ;GET GETTAB PARMS FOR STD PROTECTION
02450 GETTAB T1, ;GET STD PROTECTION
02455 MOVSI T1,155000 ; FAILED, SET LEVEL C
02460 ROT T1,^D9 ;ROTATE INTO L.O. BITS
02465 MOVEM T1,DEFPRT ; & STORE FOR LATER
02470 GETPPN T1, ;GET MY PPN
02475 JFCL ; (JUST IN CASE)
02480 MOVEM T1,MYPPN ;STORE MY PPN
02485 >; END OF IFN %SS006
02500 IFE RENTSW,< RESET >
02600 MOVE P,[IOWD PDLSIZ,PDL] ;GET AN INITIAL PDL ;** FIX **
02700 PUSHJ P,DISINT ;DISABLE ^C TRAPPING ;** FIX **
02800
02810 IFN %SS061, <
02820 HRLOI T1,21 ;GET 21,,-1 TO READ "DSKFUL" PARMS
02830 SETUUO T1, ;READ "DSKFUL" PARMS
02840 MOVEI T1,1 ; FAILED, SET TO "DSKFUL ERROR"
02850 HRLI T1,21 ;PUT "DSKFUL" ID IN L.H.
02860 MOVEM T1,OLDPDS ; & STORE AS OLD "DSKFUL" PARAMETER
02870 >; END OF IFN %SS061
02900 MOVSI FL,QMODF ;SET FOR ' IS NOT SPECIAL
02990 IFE %SS036, <
03000 MOVEI FL2,0 ;NOTHING IN SECOND FLAG REGISTER
03010 >; END OF IFE %SS036
03020 IFN %SS036, <
03030 SETZB FL2,CREATF ;CLEAR FLAGS & CREATE FLAG
03040 >; END OF IFN %SS036
03090 IFE %SS067, <
03100 SETOM BAKF ;SET FOR BAK FILE
03110 >; END OF IFE %SS067
03120 IFN %SS067, <
03130 IFL DEFBAK, < SETOM BAKF > ; SET TO -1 FOR /BAK
03140 IFE DEFBAK, < SETZM BAKF > ; SET TO 0 FOR /NOBAK
03150 IFG DEFBAK, < PUSHJ P,SETOLD > ; SET TO +1 FOR /OLD
03160 >; END OF IFN %SS067
03200 MOVEI T1,TTYCH ;SET UP DEFAULT INPUT
03300 MOVEM T1,CHIN ;...
03310 IFN %SS066, <
03320 SKIPE SAILSW ;TEST FOR SAIL ENTRY
03330 JRST RPGRET ; YES, SKIP TTY RESCAN
03340 >; END OF IFN %SS066
03400 IFN CCLSW,<
03500 MOVE T1,[POINT 7,CMDBUF]
03600 MOVEM T1,P.TEXT
03700 RESCAN 1
03800 SKPINL ;CHECK SOMETHING THERE
03900 JRST RPGRET ;NO--GO ASK USER
04000 MOVE T1,[POINT 7,CMDBUF]
04100 MOVEI T2,5*^D20
04200 CMDL: SKPINC ;MAKE SURE SOMETHING THERE
04300 JRST CMDD ;NO--GIVE UP
04400 INCHWL T3 ;YES--GET IT
04500 CAIN T3,15 ;PITCH RETURNS
04600 JRST CMDL
04700 IDPB T3,T1
04800 CAIE T3,12 ;LOOK FOR TERM
04900 CAIN T3,33
05000 JRST CMDD
05100 SOJG T2,CMDL
05200
05300 CMDD: CAIN T3,33 ;TEST FOR ALTMODE ;** FIX **
05310 OCRLF ; YES, RETURN THE CARRIAGE ;** FIX **
05320 MOVEI T3,12
05400 DPB T3,T1
05500 SETOM RPGSW
05600 >
05700 RPGRET: MOVE T1,[JSR ERRHD] ;SET UP UUO HANDLER
05800 MOVEM T1,.JB41##
05900 MOVEI T1,PDLOV ;SET UP A PDLOV TRAP
06000 MOVEM T1,.JBAPR##
06100 MOVEI T1,200000 ;SET FOR PDLOV ONLY
06200 APRENB T1,
06300 OPEN TTY,TTDEVI ;FOR SETSTS ONLY
06400 EXIT ;YOU LOSE
06500 MOVEI T1,TTIBUF ;SET UP INPUT BUFFER
06600 EXCH T1,.JBFF##
06700 INBUF TTY,1
06800 MOVEM T1,.JBFF##
06900 MOVE T1,[POINT 7,TTOBUF]
07000 MOVEM T1,TTOPNT ;SET UP TTY OUTPUT BUFFER
07100 MOVEI T1,^D80
07200 MOVEM T1,TTOCNT
07300 MOVE T1,.JBFF##
07400 MOVEM T1,BUFHD ;FOR LATER RECOPY OPERATIONS
00100 NOCOM0: TLNN FL2,AUTOF
00200 MOVE P,[IOWD PDLSIZ,PDL]
00300 TRNE FL2,SVIT ;SKIP * IF DOING W COMMAND
00400 JRST RPGR1
00410 IFN %SS027, <
00420 MOVE T1,[<ASCII /00100/>!1] ;GET DEFAULT VALUE
00430 MOVEM T1,INCR ;STORE AS INCREMENT
00440 MOVEM T1,TECINC ;STORE AS UNSEQ-FILE INCREMENT
00450 MOVEM T1,TECFST ;STORE AS 1ST LINE #
00460 >; END OF IFN %SS027
00500 TLZ FL2,INPARS!BELLF ;SAY WE ARE STARTING
00600 SETZM OPTION ;LOOK FOR DEFAULT
00700 PUSHJ P,DOOPT
00800 JRST .+2 ;IGNORE NOT FOUND RETURN
00900 JRST [OUTSTR [ASCIZ "? Syntax error in default options"]
01000 SETZM RPGSW ;CLR CMD MODE
01100 CLRBFI
01200 JRST .+1]
01210 IFN %SS066, <
01220 SKIPN SAILSW ;TEST FOR SAIL ENTRY
01230 JRST NOCOM1 ; NO, JUMP
01240 PUSHJ P,RDTMP ;READ SAIL'S COMMAND FILE
01250 SKIPA ; FAILED, SKIP
01260 SETOM RPGSW ; READ IT, SET ANOTHER FLAG
01270 >; END OF IFN %SS066
01300 NOCOM1: TLO FL2,INPARS ;SET FOR PARSE
01400 IFN CCLSW,<
01500 SKIPE RPGSW
01600 JRST DOCMD.
01700 >
01800 ;;*FIX* OUTSTR [ASCIZ /
01900 ;;*FIX* File: /]
01925 OCRLF ;END THE LINE ;** FIX **
01950 OUTSTR [ASCIZ /File: /] ; & PROMPT FOR NEW FILESPEC ;** FIX **
01975 ;(CODE RE-WRITTEN TO USE COMMON LITERAL)
02000 DOCMD.: PUSHJ P,PARSE
02005 IFN %SS047, <
02010 HLRZ T1,ORGEXT ;GET ORIGINAL EXTENSION
02015 HLRZ T2,NEWEXT ;GET NEW EXTENSION
02020 CAIN T2,'BAS' ;TEST FOR NEW EXT'N 'BAS'
02025 SKIPN NEWNAM ; *AND* NEW FILESPEC GIVEN
02030 CAIN T1,'BAS' ;TEST FOR OLD EXT'N 'BAS'
02035 SKIPE BASICF ;TEST FOR /BASIC/NOBASIC NOT GIVEN
02040 SKIPA ; SKIP IF NOT *.BAS OR USER-SPECIFIED
02045 SETOM BASICF ; ELSE ASSUME /BASIC
02050 HLRS BASICF ;CONVERT 0,,-1 TO 0 (/NOBASIC KLUDGE)
02055 MOVE T1,['BASIC '] ;GET 'BASIC' PROGRAM NAME
02060 SKIPE BASICF ;TEST FOR /BASIC
02065 MOVEM T1,RPGR+1 ; YES, CHANGE DEFAULT /RUN PROGRAM NAME
02070 >; END OF IFN %SS047
02100 RPGR1: TLZ FL2,INPARS ;PARSE DONE
02200 MOVE T1,[ORGBLK,,ICRBLK]
02300 BLT T1,ICRBKE ;MOVE INFO TO INPUT BLOCK
02400 MOVE T1,[NEWBLK,,OCRBLK]
02500 BLT T1,OCRBKE ;INFO FOR TEMP FILES
02510 IFN %SS006, <
02520 MOVEI T3,ORGBLK ;GET ADDR OF ORIGINAL FILE SPEC
02530 MOVEI T4,ICRBLK ;GET ADDR OF INPUT FILE SPEC
02540 PUSHJ P,OPATH ;GO FORMAT THE PATHS
02550 >; END OF IFN %SS006
02600 MOVSI T3,'SOS' ;SET UP TEMP FILE NAME
02700 PUSHJ P,JOBNUM
02800 MOVEM T3,EDNAM
02900 MOVEM T3,OCRNAM
03000 MOVSI T1,'TMP'
03100 MOVEM T1,OCREXT
03200 MOVE T1,ORGCOD ;GET ORIG FILE PSW
03300 SKIPN NEWNAM ;DO WE HAVE A NEW FILE
03400 MOVEM T1,OCRCOD ;NO - USE ORIG PSW
03500 MOVE T1,ORGDEV ;GET INPUT DEVICE NAME
03600 MOVEM T1,INDEVI+1 ;STASH IN OPEN BLOCK
03700 DEVCHR T1, ;GET CHARACTERISTICS
03800 TLNN T1,(1B1) ;SEE IF REAL LIVE DISK
03900 JRST NOTDKI ;NOPE!
04000 MOVEI T1,INDEVI ;ADDR OF OPEN BLOCK
04100 DEVSIZ T1, ;GET BUFFER INFO
04200 SKIPA [2,,203] ;DEFAULT IF NO UUO
04300 JUMPLE T1,NOTDKI ;LOSE IF ERROR FLAGS
04400 MOVEM T1,EDBUF ;STORE FOR LATER
04500
04600 OPEN IN,INDEVI ;OPEN INPUT CHL
04700 JRST NOTDKI ;OOPS!
04800
04802 IFN %SS006, <
04804 XLOOK IN,ICRBLK ;DO (REAL) EXTENDED LOOKUP
04806 JRST RPGR1B ; FAILED, JUMP
04808
04810 MOVEI T1,IN ;GET CHANNEL # FOR PATH. UUO
04812 PUSHJ P,DOPATH ;EXECUTE THE PATH. UUO
04814 TRNN FL2,SVIT ;TEST FOR "W" CMD
04816 SKIPE NEWNAM ;TEST FOR OUTPUT FILE SPEC
04818 JRST RPGR1A ; EITHER, JUMP TO REMEMBER THE FILESPEC
04820 TRNE FL,READOF ;TEST FOR READ-ONLY
04822 JRST RPGR1A ; EITHER, JUMP TO REMEMBER THE FILESPEC
04824 HLLZS XBLOCK+.RBEXT ;SET 'FILE NOT FOUND' ERROR CODE
04826
04828 ; HERE TO CHECK IF FILE FOUND WHERE EXPECTED
04830 MOVEI T4,ICRBLK ;POINT AT FILE BLOCK
04832 PUSHJ P,CKPATH ;TEST FOR FILE FOUND ON RIGHT PATH
04834 JRST RPGR1B ; NO, TREAT AS NOT FOUND
04836 JRST RPGR1C ; YES, JUMP FOR FURTHER PROCESSING
04838
04840 ; HERE TO REMEMBER THE ACTUAL PATH FROM THE LOOKUP, W/O PATH CHECKING
04842 RPGR1A: PUSHJ P,SAVPTH ;SAVE THE PATH
04844 TRNE FL2,SVIT ;TEST FOR "W" COMMAND
04846 JRST RPGR1D ; YES, NEED TO REMEMBER FILESPEC FOR OUTPUT
04848 JRST RPGR1E ;; NO, MERELY CONTINUE
04850
04852 ; FILE NOT FOUND AT ALL OR WHERE EXPECTED, SET UP FOR DEFAULT PATH CREATION
04854 RPGR1B: MOVE T1,[DEFPTH+2,,ORGPTH] ;GET BLT PARMS
04856 IFN %SS036, <
04858 SKIPN CREATF ;SKIP TO USE ORIG PATH IF CREATING
04860 >; END OF IFN %SS036
04862 BLT T1,ORGPTH+SFDLVL ;SET DEFAULT PATH AS DESIRED PATH
04864 JRST NOFILE ; & GO CREATE A FILE
04866
04868 ; HERE TO CHECK FOR IMPLICIT COPY OPERATION
04870 RPGR1C: ;HERE AFTER FILE FOUND IN RIGHT PATH
04872 IFN %SS036, <
04874 SKIPE CREATF ;TEST FOR CREATING
04876 JRST NOFILE ; YES, TREAT AS FILE-NOT-FOUND (TO CREATE ANEW)
04878 >; END OF IFN %SS036
04880 PUSHJ P,SAVPTH ;SAVE THE ACTUAL PATH
04882 IFN FTIMPCPY, <
04884 MOVE T2,PTHADR+2 ;GET ACTUAL FILE PPN
04886 CAME T2,DEFPTH+2 ;TEST FOR DEFAULT PATH
04888 CAMN T2,MYPPN ;TEST FOR USER PPN [-]
04890 JRST RPGR1D ; EITHER, EDIT FILE IN PLACE
04892 HRROI T1,ORGCOD ;COPY NAME,EXT,PSW
04894 POP T1,NEWCOD ; FROM
04896 POP T1,NEWEXT ; OLD FILE
04898 POP T1,NEWNAM ; TO NEW FILE
04900 MOVE T1,[DEFPTH+2,,NEWPTH] ;MAKE NEW PPN THE DEFAULT PATH
04902 BLT T1,NEWPTH+SFDLVL ; DITTO
04904 MOVE T1,DEFPRT ;GET DEFAULT PROTECTION
04906 HRRZ T2,ORGPRT ;GET USER-GIVEN INPUT PROTECTION
04908 SKIPN T2 ; & TEST FOR GIVEN
04910 HRRM T1,NEWPRT ; NO, OUTPUT FILE GETS DEFAULT PROTECTION
04912 MOVSI T1,'DSK' ;OUTPUT TO 'DSK' TO FIND USER'S UFD/SFD
04914 MOVEM T1,NEWDEV ;STORE AS NEW DEVICE
04916 SKIPA T1,[NEWPTH,,OCRPTH] ;GET BLT PARMS TO SET NEW PATH AS OUTPUT
04918 >; END OF IFN FTIMPCPY
04920 RPGR1D: MOVE T1,[PTHADR+2,,OCRPTH] ;GET BLT PARMS TO SET ACTUAL PATH AS OUTPUT
04922 BLT T1,OCRPTH+SFDLVL ;SET OUTPUT PATH FROM NEW OR ACTUAL
04924 RPGR1E: ;HERE IF NO PATH CHECKING/DEFAULTING
04926 >; END OF IFN %SS006
04928 IFE %SS006, <
04950 XLOOK IN,ICRBLK ;DO EXTENDED LOOKUP
05000 JRST NOFILE ;CHECK TYPE OF FAILURE
05100
05200 MOVEI T1,IN ;SET UP FOR PATH UUO
05300 MOVEM T1,PTHADR
05400 MOVE T1,[<SFDLVL+4>,,PTHADR]
05500 PATH. T1,
05600 ERROR ICN ;NEVER COME HERE (OFTEN)
05700
05800 SKIPN NEWNAM ;SAVE PATH INFO IN NEW FILE
05900 JRST [MOVE T1,[PTHADR+2,,OCRPTH]
06000 BLT T1,OCRPTH+SFDLVL
06100 JRST .+1]
06190 IFE %SS036, <
06200 SETZM CREATF ;SAY NOT CREATE
06210 >; END OF IFE %SS036
06300 TRNE FL,READOF ;IF READ ONLY, LOOKUP IS ENUF
06400 JRST GUDPRV
06500 LDB T2,[POINT 9,XBLOCK+2,8]
06600 CAIL T2,400 ;CHECK IF OK TO EDIT
06700 SKIPE NEWNAM ;NO GOOD IF NO OUTPUT SPEC
06800 GUDPRV: SKIPA T1,PTHADR ;ATTN PROGRAM BUMMERS
06900 JRST BADPRV ;CANNOT EDIT THIS ONE
07000 HRRM T2,ORGPRT ;SAVE FOR LATER
07100 ANDI T2,77 ;STASH TEMP FILE PROT
07200 SKIPN T2 ;WATCH OUT FOR X00 FILES
07300 MOVEI T2,100 ;THIS IS BETTER
07400 HRRM T2,OCRPRT
07402 >; END OF IFE %SS006
07404 IFN %SS006, <
07406 MOVEI T3,NEWBLK
07408 MOVEI T4,OCRBLK
07410 PUSHJ P,OPATH ;GET REAL PATH AS IF WE DID AN ENTER
07412 IFE %SS036, <
07414 SETZM CREATF ;SAY NOT CREATE
07416 >; END OF IFE %SS036
07418 TRNE FL,READOF ;IF READ ONLY, LOOKUP IS ENUF
07420 JRST GUDPR1 ;PROTECTION DOESN'T MATTER
07422 SKIPE NEWNAM ;NEW NAME?
07424 JRST GUDPRV ;YES - WON'T DELETE ORIG
07426 MOVEI T2,2 ;GET LOOKUP CODE FOR PROTECTION ERROR
07428 HRRM XBLOCK+.RBEXT ;STORE FOR POSSIBLE DIAGNOSIC
07430 LDB T2,[POINT 9,XBLOCK+.RBPRV,8] ;NO
07432 MOVE T3,ORGPTH
07434 PUSHJ P,CHKRNM ;CAN WE DELETE ORIG?
07436 JRST [ ;NO, JUMP
07438 HRLI T2,5 ;GET CODE FOR READ ACCESS
07440 TRNN FL2,SVIT ;TEST FOR "W" COMMAND
07442 PUSHJ P,DOCKAC ;TEST FOR READ ACCESS POSSIBLE
07444 JRST NOFILE ; PROTECTION FAILURE IF "W" OR CAN'T READ
07446 OUTSTR [ASCIZ \% Input file protection implies /READONLY
07448 \] ;TYPE A MESSAGE
07450 TRO FL,READOF ;SET /READONLY
07452 JRST GUDPR1 ; & JUMP
07454 ]
07456 JFCL ;YES, AS-IS
07458 ;YES, W/PROTECTION CHANGE
07460 GUDPRV: HRRZ T2,NEWPRT ;GET NEW PROTECTION, IF ANY
07462 SKIPN T2 ; GOT IT, SKIP
07464 HRRZ T2,ORGPRT ;GET OLD PROTECTION, IF ANY
07466 SKIPN T2 ;IS THERE ANY?
07468 LDB T2,[POINT 9,XBLOCK+.RBPRV,8] ; NONE GIVEN, GET THE FILE'S PROTECTION
07470 PUSHJ P,CKTMPV ;FIND VIABLE *.TMP FILE PROTECTION
07472 GUDPR1: MOVE T1,XBLOCK+.RBDEV ;GET ACTUAL INPUT STR NAME
07474 >; END OF IFN %SS006
07500 MOVEM T1,STRNAM ;SET UP FOR DSKCHR
07600 MOVE T1,[5,,STRNAM]
07700 DSKCHR T1, ;FIND REAL NAME
07800 SKIPA T4,[SIXBIT "DSK"]
07900 MOVE T4,STRNAM+4
08000 MOVEM T4,ORGDEV ;STORE DEVICE NAME
08100 FILRET: SKIPE NEWNAM ;OUTPUT SPECIFIED?
08200 MOVE T4,NEWDEV ;YES: GET OUTPUT DEVICE
08300 MOVEM T4,OUDEVI+1 ;SAVE IT IN OUPUT BLOCK
08400 MOVEM T4,OCRDEV ;AND OUTPUT FILE DESC
08500 DEVCHR T4, ;GET CHARACTERISTICS
08600 TLNN T4,(1B1) ;GRNTEE DISK
08700 JRST NOTDKO
08800
08900 OPEN OUT,OUDEVI ;OPEN OUTPUT CHL
09000 JRST NOTDKO ;GRONK
09100
09200 HLRZ T1,EDBUF ;GET DEFAULT # OF BUFFERS
09300 INBUF IN,0(T1) ;GET BUFFERS
09400 OUTBUF OUT,0(T1) ;...
09500 MOVE T1,.JBFF##
09600 SETZM 0(T1) ;SAVE A ZERO WORD
09700 ADDI T1,1 ;NEXT ONE IS START OF
09800 MOVEM T1,BUFP ; BUFFERS
09900 IFN %SS050, <
10000 ADD T1,CORSIZ ;COMPUTE LAST DESIRED CORE ADDRESS
10100 CORE T1, ;GET THAT MUCH CORE
10200 JFCL ; & IGNORE ERRORS
10300 >; END OF IFN %SS050
00100 MOCO: MOVE T1,.JBREL## ;FIND THE END OF CORE
00200 MOVEM T1,CORTOP
00300 SUBI T1,2*MXWPL+2 ;LEAVE SPACE FOR A COUPLE OF LINES
00400 MOVEM T1,FILPT ;THIS IS HOW FAR TO FILL THE BUFFER
00500 MOVE T1,CORTOP ;NOW FIND THE SIZE
00600 SUB T1,BUFP
00690 IFE %SS050, <
00700 CAIGE T1,3000
00710 >; END OF IFE %SS050
00720 IFN %SS050, <
00730 CAMGE T1,CORSIZ ;TEST FOR ENOUGH CORE
00740 >; END OF IFN %SS050
00800 JRST [MOVE T2,.JBREL##
00900 ADDI T2,2000
01000 CORE T2,
01100 SKIPA
01200 JRST MOCO
01300 JRST .+1] ;DID NOT GET IT, GIVE UP
01400 MOVE T2,T1 ;GET A COPY
01500 SUBI T2,MXWPL+1 ;WHEN TO START DUMPING
01600 MOVEM T2,MAXWC
01700 ASH T1,-1 ;TAKE HALF OF IT
01800 MOVEM T1,HLFWC ;SAVE THAT FIGURE
01900 TRNE FL2,SVIT
02000 JRST NOSV1 ;SKIP SOME MORE STUFF IF IN W COMMAND
02010 MOVEI T3,.TOSOP ;GET TRMOP. "SKIP IF OUTPUT.." PARM ;** FIX **
02020 MOVEM T3,TTYPRM ; & STORE INTO PARM LIST ;** FIX **
02100 PJOB T3,
02200 TRMNO. T3, ;GET TTY #
02300 JRST NOLCT ;ERROR - IGNORE
02350 MOVEM T3,TTYUDX ;STORE FOR LATER ;** FIX **
02400 MOVEI T2,.TOLCT ;CODE FOR LC TEST
02500 MOVE T1,[2,,T2]
02600 TRMOP. T1,
02700 JRST NOLCT ;NOT IMP EITHER
02790 IFE %SS065, <
02800 SKIPN T1
02900 TRO FL,M37F ;LC SET SO SAY HE'S M37
02905 >; END OF IFE %SS065
02910 IFN %SS065, <
02915 JUMPN T1,NOLCT ;JUMP IF "TTY UC" (*NOT* LC)
02920 TRON FL,M37F ;TEST FOR /M37 SET, & SET IT
02925 SETZM CASEBT ; IF NOT SET, BUT LC TTY, FORCE /UPPER
02930 ;NOTE: THIS RESULTS THAT A USER MAY HAVE
02935 ; /LOWER SET IN A SOS SWITCH.INI ENTRY
02940 ; FOR USE WITH UPPER-CASE ONLY TTY'S,
02945 ; BUT WHERE THE USER RUNS ON AN
02950 ; UPPER/LOWER TTY, /UPPER IS SET SO
02955 ; THAT THE TTY SHIFT KEY CONTROLS
02960 ; THE INPUT CASE!
02965 >; END OF IFN %SS065
03000 NOLCT: MOVE T1,[<ASCII /00000/>!1]
03100 MOVEM T1,CLN ;SET UP THE CURRENT LINE
03190 IFE %SS027, <
03200 SKIPN T1,TECINC ;USE STEP IF GIVEN
03300 MOVE T1,[<ASCII /00100/>!1] ;AND CURRENT INCREMENT
03400 MOVEM T1,INCR
03410 >; END OF IFE %SS027
03420 IFN %SS027, <
03430 MOVE T1,TECFST ;GET STARTING LINE #
03440 >; END OF IFN %SS027
03500 MOVEM T1,CURINS ;CURRENT PLACE TO INSERT IF NO ARGS TO I
03510 IFN %SS017, <
03520 IFN %SS027, <
03530 MOVE T1,INCR ;GET STARTING INCREMENT
03540 >; END OF IFN %SS027
03550 MOVEM T1,IINCR ;INITIAL INCR FOR "I"<CR> CMD
03560 >; END OF IFN %SS017
03600 NOSV1: MOVEI T1,1 ;AND THE CURRENT PAGE
03700 MOVEM T1,CPG
03800 TRNE FL2,SVIT ;DO NOT CHANGE LOGICAL PAGE (.)
03900 JRST NOSV1A
04000 MOVEM T1,CPGL
04100 MOVEM T1,IPG ;CURRENT PAGE TO INSERT ON
04200 NOSV1A: MOVE PNTR,BUFP ;SET THE BUFFER POINTER
04250 SETZM (PNTR) ; ASSURE ZERO AT END OF BUFFER ;** FIX **
04300 MOVEI T1,1 ;SET INPUT PAGE
04400 MOVEM T1,INPG
04500 SETZM SVWD ;O WORDS WAITING
04600 SETZM WC ;ZERO WORD COUNT FOR START
04700 SETZM OLDLIN ;UESD FOR ORDER CHECKING ON INPUT
04800 TLNN FL2,AUTOF ;PRESERVE IF IN AUTO SAVE
04900 SETZM ALTSN ;USED FOR ALTMODE SEEN FOR I AND R
05000 SETZM AUXFIL ;USED TO FLAG AUXILLARY FILE IN USE
05100 TRNE FL2,SVIT
05200 JRST NOSV2
05300 ;*FIX* SETZM CASEBT ;0 FOR LETTERS AS UPPER CASE 40 FOR LOWER ;** FIX **
05350 ; FIXES SPR 10-15942 & 10-17082
05400 SETZM SRPNT ;NO SEARCH STRING YET
05500 SETZM R1PNT ;ALSO REPLACE STRINGS
05600 SETZM R2PNT
05700 ;*FIX* SETZM SVPBTS# ;OMITTED SINCE NO OTHER REFERENCE ;** FIX **
05800 MOVSI T1,1 ;SET BIG PAGE LARGE FOR NOW
05900 MOVEM T1,BGPG
06000 TRNE FL,READOF ;DONT BOTHER IF READ-ONLY
06100 JRST NOSV2
06200 XLOOK OUT,OCRBLK ;GRNTEE TMP FILE GONE
06300 JRST [HRRZ T1,XBLOCK+1+<EXTOFF*%SS006>
06400 JUMPN T1,EDFLIN ;ERROR IF OTHER THAN FNF
06500 JRST NOSV2]
06600 SETZB T1,T2 ;DELETE IT IF THERE
06700 RENAME OUT,T1
06800 JRST EDFLIN ;LOSE IF CAN'T DELETE
06900 NOSV2: MOVSI T1,'TEM' ;RESET EXT
07000 HLLM T1,OCREXT
07090 IFE %SS062, <
07100 TLO FL2,BELLF ;ALLOW BELLS
07110 >; END OF IFE %SS062
07200 PUSHJ P,ENBINT ;ENABLE ^C INTS
07210 IFN %SS061, <
07220 PUSHJ P,SETPDS ;SET "DSKFUL PAUSE" FOR EDITING
07230 >; END OF IFN %SS061
07300 SKIPE CREATF ;CHECK IF WE ARE CREATING
07310 IFN %SS036, <
07320 SKIPE NEWNAM ;TEST FOR CREATING FROM OLD FILE
07330 SKIPA ; SKIP IF NOT CREATING OR TWO FILE SPECS
07340 >; END OF IFN %SS036
07400 JRST CRTOK
07500 IFN CRYPSW,< SETOM IBUF+3 >
07510 IFN %SS023, <
07520 SKIPE RPGSW ;DON'T TYPE IF USER-SPECIFIED
07530 >; END OF IFN %SS023
07600 TRNE FL2,SVIT ;WRAP ON SAVE CMD(W)
07700 JRST NOSV3 ;YES: DON'T PRINT MSG AGAIN!
07800 MOVEI T1,[ASCIZ /Edit: /]
07900 TRNE FL,READOF ;CHECK FOR R/O
08000 MOVEI T1,[ASCIZ /Read: /]
08100 OUTSTR @T1 ;PRINT MSG
08190 IFE %SS006, <
08200 MOVEI T4,ICRBLK
08300 PUSHJ P,GVNAM0 ;GIVE FILE NAME
08304 >; END OF IFE %SS006
08308 IFN %SS006, <
08312 MOVEI T4,ORGBLK ;GET FILE BLOCK W/REAL STR NAME
08316 PUSHJ P,GVNAM0 ; & TYPE IT
08320 SKIPN NEWNAM ;TEST FOR OUTPUT FILE SPEC
08324 JRST NOSPEC ; NO, JUMP
08328 MOVSI T1,-<PTH+SFDLVL+1> ;GET AOBJN PTR TO CHECK FILE SPEC
08332 MOVE T2,ICRBLK(T1) ;GET 1 WORD FROM INPUT FILE SPEC
08336 CAMN T2,NEWBLK(T1) ;CHECK AGAINST 1 WD OF OUTPUT FILE SPEC
08340 AOBJN T1,.-2 ;REPEAT UNTIL DONE
08344 JUMPGE T1,NOSPEC ;DON'T OUTPUT IF SAME FILE SPEC
08348 IFN %SS036, <
08352 SKIPE CREATF ;TEST FOR CREATING
08356 OUTSTR [ASCIZ / creating /] ; YES, TYPE IT
08360 SKIPN CREATF ;TEST FOR NON-CREATING
08364 >; END OF IFN %SS036
08368 OUTSTR [ASCIZ / as /] ;START THE MESSAGE
08372 MOVEI T4,NEWBLK ;POINT AT NEW SPEC
08376 PUSHJ P,GVNAM0 ; & TYPE IT
08380 NOSPEC: ;HERE IF NO NEW FILE SPEC
08384 >; END OF IFN %SS006
08400 OCRLF
08500 NOSV3: TRNE FL,READOF
08600 JRST NOENT ;DO NOT ENTER
08700 XENTR OUT,OCRBLK
08800 JRST EDFLIN ;SOME OTHER BASTARD IS USING IT
08900 PUSHJ P,STRSET ;SETUP STR INFO
09000 SETZM OPG ;OUTPUT PAGE CNTR
09100 IFN CRYPSW,<
09200 MOVNI T1,2
09300 MOVEM T1,OBUF+3
09400 >
09500 NOENT: TRO FL,BOF ;IS AT START OF FILE
09600 TLO FL,FSTOPF ;FIRST OP
09700 TLZ FL2,ALLCHG ;NO CHANGES YET
09710 IFN %SS006, <
09720 HRRZ T1,ORGPRT ;GET LAST OUTPUT PROTECTION
09730 TRZE FL2,SVIT ;TEST FOR SAVE OPERATION
09740 TRNN T1,400 ;TEST FOR HIGH PROTECTION USED
09750 SKIPA ; SKIP IF NOT SAVE & HIGH PROTECTION
09760 TLO FL2,FCHGF ; ELSE SET BIT TO RE-PROTECT FILE
09770 >; END OF IFN %SS006
09800 PUSHJ P,FILLBF ;AND FILL UP THE BUFFER
09900 TLZN FL2,AUTOF ;SKIP IF AUTO SAVE
10000 JRST COMND
10090 IFE %SS006, <
10100 TRZ FL2,SVIT ;CLR THIS TOO
10110 >; END OF IFE %SS006
10200 MOVE SINDEX,SVLNUM ;GET BACK TO POINT OF LAST INSERT
10300 TLZ FL2,NORENT ;RE-ENABLE FOR REENTER
10400 JRST FIND ;EXITS TO CALLER
00100 RJUST: MOVE T3,ACCUM ;GET THE SIXBIT
00200 MOVEI T1,0
00300 RJUST1: MOVEI T2,0
00400 LSHC T2,6
00500 CAIL T2,"0"-40 ;CHECK FOR OCTAL DIGIT
00600 CAILE T2,"7"-40
00700 POPJ P,
00800 LSH T1,3
00900 IORI T1,-20(T2)
01000 JUMPN T3,RJUST1 ;DONE IF NULLS LEFT
01100 AOS (P)
01200 POPJ P, ;SKIP RETURN FOR ALL OK
01300
01400 ;ROUTINE FOR FETCH FULL PATH NAME
01500
01600 SETPPN: PUSHJ P,SCAN ;FETCH ATOM
01700 TRNN FL,IDF!NUMF ;CHECK FOR ATOM
01800 JRST [CAIN C,"-" ;CHECK FOR DEFAULT SPEC
01900 JRST STDPTH
01990 IFE %SS006, <
02000 SKIPN T1,MYPPN ;HAVE DEFAULT?
02100 PUSHJ P,USRPPN ;NO: GET ONE
02110 >; END OF IFE %SS006
02120 IFN %SS006, <
02130 MOVE T1,MYPPN ;GET THE DEFAULT
02140 >; END OF IFN %SS006
02200 HLLZM T1,PTH(ALTP)
02300 JRST SETPP1]
02400 PUSHJ P,RJUST ;RIGHT JUSTIFY ATOM IN OCTAL
02500 POPJ P, ;PPN ERROR
02600 HRLZM T1,PTH(ALTP)
02700 PUSHJ P,SCAN
02800 SETPP1: CAIE C,"," ;PROPER DELIM
02900 POPJ P,
03000 PUSHJ P,SCAN ;FETCH NEXT ATOM
03100 TRNN FL,IDF!NUMF ;ALLOW [,,...]
03200 JRST [
03210 IFE %SS006, <
03220 SKIPN T1,MYPPN
03300 PUSHJ P,USRPPN
03310 >; END OF IFE %SS006
03320 IFN %SS006, <
03330 MOVE T1,MYPPN ;GET THE DEFAULT
03340 >; END OF IFN %SS006
03400 HRRM T1,PTH(ALTP) ;FILL IN DEFAULT
03500 JRST SETPP2]
03600 PUSHJ P,RJUST ;GET OCTAL ATOM
03700 POPJ P, ;PPN ERROR
03800 HRRM T1,PTH(ALTP) ;STASH PROG #
03900 PUSHJ P,SCAN ;MOVE ON
04000 SETPP2: MOVSI T3,-<SFDLVL+1>
04100 HRR T3,ALTP
04200 JRST STPTH1
04300
04400 SETPTH: PUSH P,T3 ;SAVE AOBJN WD
04500 PUSHJ P,SCAN ;FETCH ATOM
04600 TRNN FL,IDF!NUMF ;CHECK FOR END OF SPEC
04700 JRST T1POPJ ;PRUNE PDL AND EXIT
04800 MOVE T3,0(P) ;FETCH PNTR
04900 MOVE T1,ACCUM ;FETCH SFD NAME
05000 MOVEM T1,PTH(T3) ;STORE IN PROPER PLACE
05100 PUSHJ P,SCAN ;SCAN NEXT
05200 POP P,T3 ;SET UP AOBJN PNTR
05300 STPTH1: ;HERE TO LOOK FOR SFD'S, "]" CHAR
05310 IFN %SS006, <
05320 SETZM PTH+1(T3) ;ASSURE ZERO AT END OF PATH
05330 TRNN FL,TERMF ;SKIP IF END OF LINE
05340 >; END OF IFN %SS006
05350 CAIN C,"]" ;GOOD TERMINATOR?
05400 JRST CPOPJ1 ;YES: EXIT
05500 CAIE C,"," ;MORE TO COME?
05600 POPJ P, ;NO: ERROR RET
05700 AOBJN T3,SETPTH ;YES: TRY NEXT
05800 POPJ P, ;OOPS!
05900
05990 IFE %SS006, <
06000 USRPPN: GETPPN T1,
06100 JFCL ;INCASE JACCT ON
06200 MOVEM T1,MYPPN ;SAVE FOR LATER
06300 POPJ P,
06310 >; END OF IFE %SS006
06400
06500 STDPTH: ;HERE TO SET UP THE DEFAULT PATH
06510 IFN %SS006, <
06520 MOVEI T3,(ALTP) ;GET PATH BLOCK INTO RIGHT AC
06530 PUSHJ P,OPATH3 ;FILL IN DEFAULT PATH
06540 >; END OF IFN %SS006
06550 PUSHJ P,SCAN ;CHECK PROPER TERM
06600 TRNN FL,IDF!NUMF
06700 CAIE C,"]"
06710 IFN %SS006, <
06720 TRNE FL,TERMF ;TEST FOR END OF LINE
06730 AOS (P) ; SET TO RETURN+1 SINCE PROPERLY TERMINATED
06740 >; END OF IFN %SS006
06800 POPJ P, ;LOSE
06890 IFE %SS006, <
06900 SETZM PTH(ALTP) ;USE DEFAULT
07000 JRST CPOPJ1
07100 >; END OF IFE %SS006
00100 READN0: TDZA T2,T2 ;INIT DEVICE TO 0
00200 READNM: MOVSI T2,'DSK' ;INIT DEVICE TO DSK
00300 SETZM TMPBLK ;CLEAR OUT PARSE AREA
00400 MOVE T1,[TMPBLK,,TMPBLK+1]
00500 BLT T1,TMPBKE
00600 MOVEI ALTP,TMPBLK ;SET UP FOR SETPPN
00700 SETZM RSW ;AND SWITCH FLAGS
00800 SETZM SSW
00900 MOVEM T2,TMPDEV
01000 TRNN FL,IDF!NUMF ;IS IT AN IDENT
01100 POPJ P, ;ERROR RETURN
01200 PUSH P,ACCUM ;SAVE ATOM
01300 PUSHJ P,SCAN ;SCAN FOR DELIM
01400 CAIE C,":" ;IS IT A DEVICE
01500 JRST [POP P,TMPNAM ;IT IS A FILE NAME
01600 JRST NOTDEV]
01700 POP P,TMPDEV ;YES: SAVE IN CORRECT PLACE
01800 PUSHJ P,SCAN ;GET NEXT ATOM
01900 TRNN FL,IDF!NUMF ;IS IT AN IDENT
02000 POPJ P, ;NO: RETURN
02100 MOVE T1,ACCUM ;FETCH ARG
02200 MOVEM T1,TMPNAM
02300 PUSHJ P,SCAN
02400 NOTDEV: CAIN C,"[" ;CHECK FOR PPN
02500 JRST READPP
02510 IFN %SS006, <
02520 CAIN C,074 ;TEST FOR BEGINING OF PROTECTION
02530 JRST READPT ; YES, JUMP
02540 >; END OF IFN %SS006
02600 CAIE C,"."
02700 JRST RDTERM
02800 PUSHJ P,SCAN ;THIS SHOULD BE AN EXTENSION
02900 TRNE FL,TERMF ;CHECK FOR NULL EXT
03000 JRST CPOPJ1 ;OK IF NOTHING AFTER PERIOD
03100 TRNN FL,IDF!NUMF
03200 JRST NOTDE1 ;JUMP TO PERMIT NULL EXTENSIONS ;** FIX **
03300 MOVE T1,ACCUM ;GET IT
03400 HLLZM T1,TMPEXT ;AND PUT IT IN THE EXTENSION FIELD
03500 PUSHJ P,SCAN
03510 NOTDE1: ;HERE AFTER EXTENSION SCANNED ;** FIX **
03520 IFN %SS006, <
03530 CAIN C,074 ;TEST FOR BEGINING OF PROTECTION
03540 JRST READPT ; YES, JUMP
03550 READNX: ;HERE AFTER PROTECTION READ
03560 >; END OF IFN %SS006
03600 CAIE C,"[" ;NOW LOOK FOR PPN
03700 JRST RDTERM
03800 READPP: PUSHJ P,SETPPN ;FETCH FULL PATH NAME
03900 POPJ P, ;ERROR IN PPN
03910 IFN %SS006, <
03920 TRNN FL,TERMF ;SKIP IF TERMINATOR READ
03930 >; END OF IFN %SS006
04000 PUSHJ P,SCAN ;LOOK PAST BRACKET
04100 RDTERM: TLNN FL2,INOPTF ;NO SWITCHES IN OPTION FILE
04150 CAIE C,"/" ;CHECK FOR READ ONLY MODE
04200 JRST CPOPJ1 ;ALL OK
04210 IFN %SS030, <
04220 RDSWT: ;HERE TO SCAN SWITCHES
04230 >; END OF IFN %SS030
04300 PUSHJ P,SCAN
04400 TRNN FL,IDF
04500 POPJ P,
04600 MOVS T1,ACCUM
04700 CAIN T1,'R '
04800 SETOM RSW
04900 CAIN T1,'S '
05000 SETOM SSW
05100 PUSHJ P,SCAN
05200 SKIPN RSW
05300 SKIPE SSW
05400 AOS (P)
05500 POPJ P,
05600
05700 IFN %SS006, <
05800 READPT: PUSHJ P,SCAN ;GET NEXT ATOM
05900 TRNE FL,NUMF ;TEST FOR A NUMBER
06000 PUSHJ P,RJUST ;GO JUSTIFY THE NUMBER
06100 POPJ P, ; ERROR RETURN IF NOT LEGAL OCTAL
06200 TDNE T1,[-1,,777000] ;TEST FOR 3 DIGIT-MAXIMUM
06300 POPJ P, ; TOO BIG, ERROR RETURN
06400 HRRM T1,TMPPRT ;STORE THE PROTECTION AWAY
06500 PUSHJ P,SCAN ;GET THE NEXT ATOM
06600 CAIN C,076 ;TEST FOR CLOSING ANGLE-BRACKET
06700 PUSHJ P,SCAN ; YES, SKIP IT
06800 JRST READNX ;CONTINUE PARSING
06900 >; END OF IFN %SS006
00100 ;CREATE A NEW FILE
00200
00300 NOFILE: MOVEI T4,ICRBLK ;SET FOR PRINTING
00400 HRRZ T1,XBLOCK+1+<EXTOFF*%SS006> ;GET FAIL CODE
00410 IFN %SS006, <
00420 SKIPN NEWNAM ;TEST FOR OUTPUT FILESPEC
00430 TRNE FL2,SVIT ;TEST FOR "W" CMD
00440 HRROS T1 ; EITHER, FILE-NOT-FOUND IS AN ERROR
00450 >; END OF IFN %SS006
00500 TRNN FL,READOF ;ERROR IF R/O
00600 JUMPE T1,NOFIL1 ;OK IF FNF CODE
00610 IFN %SS006, <
00620 PUSHJ P,CLRCTT ;CLEAR ^O & TYPE-AHEAD
00630 OUTSTR [ASCIZ /? /] ;TYPE "?" FOR MPB
00640 >; END OF IFN %SS006
00700 PUSHJ P,GVNAM0 ;PRINT NAME
00800 OUTCHR ["("]
00900 HRRZ T1,XBLOCK+1+<EXTOFF*%SS006> ;FAIL CODE
01000 MOVEI T3,OCHR ;OUTPUT ROUTINE
01100 PUSHJ P,OCTPR ;PRINT IN OCTAL
01200 PUSHJ P,FORCE ;DUMP BUFFER
01300 OUTSTR [ASCIZ /) - LOOKUP failed/]
01400 HRRZ T1,XBLOCK+1+<EXTOFF*%SS006> ;FAIL CODE
01500 CAIN T1,0
01600 OUTSTR [ASCIZ /, file not found/]
01700 CAIN T1,1
01800 OUTSTR [ASCIZ /, no such directory/]
01900 CAIN T1,2
02000 OUTSTR [ASCIZ /, protection violation/]
02100 CAIN T1,6
02200 OUTSTR [ASCIZ /, RIB or UFD error/]
02300 CAIN T1,23
02400 OUTSTR [ASCIZ /, no such SFD/]
02500 OCRLF
02510 IFN %SS061, <
02520 PUSHJ P,RSTPDS ;RESET "DSKFUL" STATUS
02530 PUSHJ P,DISINT ;DISABLE ^C TRAP
02540 TRNN FL2,SVIT ;TEST FOR "W" CMD
02550 JRST STPT ; NO, GO RE-PROMPT FOR FILE NAME
02560 >; END OF IFN %SS061
02600 EXIT
02700
02790 IFE %SS006, <
02800 NOFIL1: OUTSTR [ASCIZ /Input: /]
02900 PUSHJ P,GVNAM0
02945 OCRLF ;END THE LINE ;** FIX **
03000 MOVE T1,[%LDSTP,,.GTLDV]
03100 GETTAB T1, ;GET DEFAULT PTB.
03200 MOVSI T1,155000 ;MUST BE LVL C
03300 LDB T1,[POINT 9,T1,8]
03400 HRRM T1,ORGPRT
03500 ANDI T1,77 ;SET UP FOR TEMP
03600 SKIPN T1 ;LOOK FOR X00
03700 MOVEI T1,100 ;AND USE THIS
03800 HRRM T1,OCRPRT
03900 SETOM CREATF ;SAY WE ARE CREATING
04000 MOVE T1,[ORGPTH,,OCRPTH]
04100 BLT T1,OCRPTH+SFDLVL ;SET UP OUTPUT PATH
04200 MOVE T4,ORGDEV ;GET DEVICE NAME
04300 JRST FILRET ;GO OPEN IT
04302 >; END OF IFE %SS006
04304
04306 IFN %SS006, <
04308
04310 ; FILE INITIALIZATION - WHEN CREATING A NEW FILE
04312
04314 NOFIL1: MOVEI T3,ORGBLK ;FIND PATHS FOR INPUT
04316 MOVEI T4,ICRBLK
04318 PUSHJ P,OPATH ;GIVES PATH IF WE DID ENTER
04320 OUTSTR [ASCIZ /Input: /] ;TYPE INPUT FILE SPEC
04322 MOVEI T4,ICRBLK ;SPECIFIES WHAT FILE WE PRINT
04324 PUSHJ P,GVNAM0
04326 OCRLF ;END THE LINE SOONER ;** FIX **
04328 MOVE T1,[ORGPTH,,OCRPTH] ;GET BLT PARMS FOR PATH COPYING
04330 BLT T1,OCRPTH+SFDLVL ; & SET UP OUTPUT PATH
04332 IFN %SS071, <
04334 SETZM FILSIZ ;SHOW OUTPUT FILE SIZE UNKNOWN
04336 >; END OF IFN %SS071
04338 SETOM CREATF ;SAY WE ARE CREATING
04340 HRRZ T2,ORGPRT ;USE SPECIFIED PROT
04342 SKIPN T2 ;TEST FOR SPECIFIED PROTECTION
04344 MOVE T2,DEFPRT ; NO, GET SYSTEM DEFAULT
04346 PUSHJ P,CKTMPV ;FIND VIABLE *.TMP FILE PROTECTION
04348 MOVE T4,ORGDEV ;GET DEVICE NAME
04350 JRST FILRET ;GO OPEN IT
04352 >; END OF IFN %SS006
04400
04500 CRTOK:
04600 XENTR OUT,OCRBLK ;CREAT TEMP FILE
04700 JRST EDFLIN
04800 PUSHJ P,STRSET ;SETUP STR INFO
04900 SETZM OPG ;OUTPUT PAGE CNTR
05000 IFN CRYPSW,<
05100 MOVNI T1,2
05200 MOVEM T1,OBUF+3
05300 >
05400 ;;*FIX* SETZM (PNTR) ;ZERO FIRST WORD OF BUFFER
05500 TRZ FL,READOF ;CREAT AND READOF ARE NOT POSSIBLE
05600 TRO FL,BOF!EOF!EOF2 ;SAY AT START AND NO MORE TO READ
05700 TLO FL2,ALLCHG ;NEW FILE - THEREFORE CHANGES
05800 MOVEI T1,1 ;SET BGPG
05900 MOVEM T1,BGPG
06000 JRST CRTINS ;AT LAST
06100
06190 IFNDEF %SS066, <
06200 DOSAIL: OUTSTR [ASCIZ /
06300 ? SAIL FEATURE NOT YET IMPLEMENTED!/]
06400 EXIT
06410 >; END OF IFNDEF %SS066
06500
06600 PAGE
06700 SUBTTL PATH-MANIPULATION SUBROUTINES
06800
06900 IFN %SS006, <
07000
07100 ;
07200 ; DETERMINE RENAME/DELETION PRIVILEGES FOR GIVEN PROTECTION/PPN PAIR
07300 ; CALL- T2 = PROTECTION CODE, RIGHT ADJUSTED
07400 ; T3 = FILE'S PPN
07500 ; RETURN +0 IF CAN'T RENAME OR (CHANGE PROTECTION & SUPERSEDE)
07600 ; +1 IF CAN RENAME/DELETE WITH GIVEN PROTECTION
07700 ; +2 IF CAN CHANGE PROTECTION (TO RENAME/DELETE) & SUPERSEDE
07800 ; (T2 = PROTECTION TO SET TO PERMIT RENAME/DELETION)
07900 ;
08000
08100 CHKRNM: MOVE T4,MYPPN ;GET MY PPN
08200 ANDI T2,777 ;ASSURE JUST PROTECTION
08300 JUMPE T2,CPOPJ1 ;JUMP IF <000>, MONITOR BUG IN 'CHKACC' UUO
08400 HRLI T2,1 ;GET CODE FOR RENAME/DELETION
08500 PUSHJ P,DOCKAC ;CHECK FOR RENAME/DELETION PRIVS
08600 TLOA T2,3 ; NO, NOW GET CODE FOR SUPERSEDE & SKIP
08700 JRST CPOPJ1 ; YES, RETURN+1, PROTECTION OK AS-IS
08800 PUSHJ P,DOCKAC ;CHECK FOR SUPERSEDE PRIVS (.LT.400 TEST)
08900 POPJ P, ; NO, RETURN+0, NO ACCESS ALLOWED
09000 HRLI T2,0 ;GET CODE FOR PROTECTION CHANGING
09100 PUSHJ P,DOCKAC ;CHECK FOR PROTECTION CHANGING
09200 POPJ P, ; NO, RETURN+0, CAN'T ACCESS
09300 ANDI T2,077 ;NEED PROTECTION FOR RENAMING
09400 IORI T2,100 ; SO SET TO <1XX>
09500 AOS 0(P) ;DOUBLE SKIP RETURN
09600 JRST CPOPJ1
09700
09800 ;
09900 ; DETERMINE *.TMP FILE PROTECTION THAT WILL PERMIT LATER RENAME/PROTECTION CHANGE
10000 ; CALL- T2 = DESIRED OUTPUT FILE PROTECTION
10100 ; OCRPTH = OUTPUT FILE PPN
10200 ; RETURN ORGPRT = ACTUAL OUTPUT FILE PROTECTION
10300 ; OCRPRT = ACTUAL *.TMP FILE PROTECTION
10400 ;
10500
10600 CKTMPV: HRRM T2,ORGPRT ;STORE OUTPUT FILE PROTECTION
10700 ANDI T2,077 ;MASK PROTECTION TO <0XX>
10800 SKIPN T2 ;TEST FOR <000>
10900 MOVEI T2,100 ; YES, MAKE <100>
11000 MOVE T3,OCRPTH ;GET OUTPUT FILE PPN
11100 MOVE T4,MYPPN ;GET USER'S PPN
11200 PUSHJ P,DOCKAC ;CHECK FOR PROTECTION CHANGING PRIVS
11300 TLOA T2,1 ; NO, GET CODE FOR RENAME/DELETE & SKIP
11400 JRST CKTPV1 ; YES, JUMP, PROTECTION ACCEPTABLE
11500 PUSHJ P,DOCKAC ;CHECK FOR RENAME/DELETE PRIVS
11600 JRST BADPRV ; NO, FATAL ERROR, NO PRIVS TO WRITE/RENAME FILE
11700 HRRZ T2,ORGPRT ; YES, RESTOR ORIGINAL PROTECTION
11800 CKTPV1: HRRM T2,OCRPRT ;STORE *.TMP FILE PROTECTION
11900 POPJ P, ;RETURN TO CALLER
12000
12100 ;
12200 ; SUBROUTINE TO PERFORM 'CHKACC' UUO
12300 ; CALL- T2 = [FUNCTION CODE,,PROTECTION]
12400 ; T3 = FILE'S PPN
12500 ; T4 = USER'S PPN
12600 ; RETURN +0 IF PERMISSION DENIED
12700 ; +1 IF PERMISSION GRANTED OR UUO NON-EXISTENT
12800 ;
12900
13000 DOCKAC: MOVEI T1,T2 ;POINT AT ARG LIST
13100 CHKACC T1, ;ASK FOR PERMISSION
13200 SETZ T1, ; NO UUO, SET TO ZERO
13300 JUMPE T1,CPOPJ1 ; ZERO, PERMISSION GRANTED
13400 POPJ P, ; NON-ZERO, PERMISSION DENIED
13500
13600 ;
13700 ; SUBROUTINE TO FIND PATH THAT ENTER WOULD TAKE FOR GIVEN FILE SPEC
13800 ; CALL- T3 = GIVEN FILE SPEC POINTER
13900 ; T4 = FILE SPEC THAT IS UPDATED FOR CHANGES
14000 ;
14100
14200 OPATH: SKIPN T1,DEV(T3) ;GET DEVICE FROM FILE SPEC & TEST IT
14300 MOVSI T1,'DSK' ; NONE, USE 'DSK'
14400 PUSHJ P,DOPATH ;PERFORM THE PATH. UUO
14500 OPATH0: MOVE T1,PTHADR+1
14600 TRNN T1,1B30 ;WILL DEVICE OVERRIDE PPN SPEC?
14700 JRST OPATH2 ;NO - PROCESS GIVEN SPEC
14800 MOVE T1,DEFPTH+2 ;GET DEFAULT PPN
14900 CAME T1,PTHADR+2 ;IF ERSATZ PPN = DEFAULT PPN
15000 JRST OPATH1 ;DOESN'T - PUT ERSATZ PPN IN SPEC
15100 SKIPE T1,PTH(T3) ;IF GIVEN PPN ZERO, SKIP THRU TO
15200 ; SET TO DEFAULT PATH
15300 OPATH1: MOVE T1,PTHADR+2 ;OTHERWISE ERSATZ PPN
15400 MOVEM T1,PTH(T3) ;OVERRIDES GIVEN PPN
15500 SETZM PTH+1(T3) ;CLEAR NEXT WORD FOR END OF PATH
15600 OPATH2: SKIPN PTH(T3) ;TEST FOR PPN GIVEN
15700 PUSHJ P,OPATH3 ; NO, GO DEFAULT IT
15800 MOVSI T1,PTH(T3) ;GET ADDR OF 1ST PATH IN LH
15900 HRRI T1,PTH(T4) ;GET ADDR OF 2ND PATH IN RH
16000 CAME T3,T4 ;TEST FOR SAME FILESPEC
16100 BLT T1,PTH+SFDLVL(T4) ; NO, COPY 1ST PATH INTO 2ND PATH
16200 POPJ P, ;RETURN TO CALLER
16300 OPATH3: MOVSI T1,DEFPTH+2 ;GET ADDR OF DEFAULT PATH AGAIN
16400 HRRI T1,PTH(T3) ; & MAKE INTO ANOTHER XWD
16500 BLT T1,PTH+SFDLVL(T3) ;FILL IN THE DEFAULT PATH
16600 POPJ P, ;RETURN TO CALLER
16700
16800 ;
16900 ; SUBROUTINE TO EXECUTE A PATH. UUO
17000 ;
17100
17200 DOPATH: MOVEM T1,PTHADR ;STORE THE DESIRED PATH. ARG
17300 MOVE T1,[<SFDLVL+4>,,PTHADR] ;GET THE PATH. ARG LIST PTR
17400 PATH. T1, ;EXECUTE THE UUO
17500 SETZM PTHADR+1 ; ERROR, SHOW NOT ERSATZ DEVICE
17600 POPJ P, ;RETURN TO CALLER
17700
17800 ;
17900 ; SUBROUTINE TO SEE IF LOOKUP SUCCEEDED ON THE RIGHT PATH
18000 ; CALL- T1 = PATH. ARG FOR 'DOPATH'
18100 ; T4 = FILESPEC ARG FOR 'CKPATH'
18200 ; RETURN +0 IF WRONG PATH
18300 ; +1 IF RIGHT PATH
18400 ;
18500
18600 TSTPTH: PUSHJ P,DOPATH ;EXECUTE THE PATH. UUO
18700 ;FALL THRU INTO "CKPATH"
18800
18900 ; SUBROUTINE TO COMPARE PATHS, WITH SPECIAL "ZERO MEANS END" TEST
19000 ; CKPATH - COMPARES ACTUAL PATH (IN PTHADR) WITH FILE SPEC (ADDR IN T4)
19100 ; CKPTH0 - COMPARES PATHS FROM TWO FILE SPECS (ADDRS IN T1,T4)
19200
19300 CKPATH: MOVEI T1,PTHADR+2-PTH ;GET FILESPEC-TYPE ADDRESS FOR PTHADR
19400 CKPTH0: MOVEI T2,PTH(T4) ;POINT AT THE PATH WORD
19500 HRLI T2,DEFPTH+2 ;BUILT A DEFAULT-PATH BLT WORD
19600 SKIPN PTH(T4) ;TEST FOR DEFAULT PATH
19700 BLT T2,PTH+SFDLVL(T4) ; YES, FILL IN THE DEFAULT PATH
19800 HRLI T1,-<SFDLVL+1> ;GET FULL-PATH AOBJN PTR
19900 MOVE T2,DEFPTH+1 ;GET DEFAULT SCAN SWITCHES
20000 TRNE T2,1B34 ;TEST FOR PATH SCANNING
20100 HRLI T1,-1 ; YES, ANYWHERE IN DIRECTORY OK
20200 CKPTH1: MOVE T2,PTH(T1) ;GET NEXT WORD OF ACTUAL PATH
20300 CAME T2,PTH(T4) ;TEST AGAINST DESIRED PATH
20400 POPJ P, ; NOT EQUAL, RETURN +0
20500 JUMPE T2,CPOPJ1 ; EQUAL & ZERO, RETURN+1 (PATHS SAME)
20600 ADDI T4,1 ;INCR TO NEXT WORD
20700 AOBJN T1,CKPTH1 ;INCR & REPEAT
20800 JRST CPOPJ1 ; DONE, RETURN+1 (SAME PATH)
20900
21000 ; SUBROUTINE TO SAVE ACTUAL PATH (IN PTHADR) AS INPUT PATH
21100
21200 SAVPTH: MOVE T2,[PTHADR+2,,ORGPTH] ;COPY AS ORIGINAL PATH
21300 BLT T2,ORGPTH+SFDLVL ; DITTO
21400 MOVE T2,[PTHADR+2,,ICRPTH] ;COPY AS INPUT PATH
21500 BLT T2,ICRPTH+SFDLVL ; DITTO
21600 POPJ P, ;RETURN TO CALLER
21700 >; END OF IFN %SS006
21800 SUBTTL PARSE CODE
00100 ;LOOK FOR SYSTEM COMMAND. MAY BE "R SOS" OR "SOS" OR "EDIT"
00200
00300 PARSE: MOVEI ALTP,NEWBLK ;INIT NAME PNTR
00400 ;;*FIX* PUSHJ P,ZERNEW ;CLR OUT FILE BLOCK (NOT NEEDED - SEE BLT, BELOW)
00500 MOVEI T1,LDCHR ;SET UP CHIN FOR PARSE
00600 EXCH T1,CHIN ;SAVE OLD VALUE
00700 MOVEM T1,SVPCIN ;...
00800 SETZM PZBEG ;CLEAR PARSE AREA
00900 MOVE T1,[PZBEG,,PZBEG+1]
01000 BLT T1,PZEND
01100 MOVSI T1,'DSK'
01200 MOVEM T1,DEV(ALTP) ;DEFAULT DEVICE
01300 TRZ FL,F.ANY ;CLEAR ATOM SEEN
01400 SKIPN RPGSW
01500 JRST PARSE1
01600 PUSHJ P,RDSKIP
01700 PUSHJ P,RDATOM ;GET FIRST ATOM
01800 TRO FL,F.LAHD
01900 LDB T1,[POINT 6,D,5]
01910 IFN %SS036, <
01920 CAIN T1,'C' ;TEST FOR 'CREATE' COMMAND
01930 JRST [ ; YES, JUMP
01940 SETOM CREATF ;SET THE CREATE FLAG
01950 JRST FIXUP ; & GO TURN INTO 'SOS' FOR TEMP FILE
01960 ]
01970 >; END OF IFN %SS036
02000 CAIE T1,"R"-40 ;RUN CMD?
02100 JRST PARSE1 ;NO: GO PARSE COMMAND LINE
02200 PUSHJ P,RDSKIP
02300 PUSHJ P,RDATOM ;SKIP FILE NAME
02400 CAIN C,":" ;IN CASE DEVICE NAME
02500 JRST .-3
02600 CAIN C,"-" ;DASH BREAK?
02700 JRST [TRZ FL,F.LAHD
02800 SETOM TMPCF ;SET TO SKIP TMP READ
02900 JRST FIXUP]
03000 CAIN C,12 ;END OF WORLD?
03100 JRST RDEOT0 ;YES: PROCESS
03200 PUSHJ P,RDSKIP ;NO: SKIP CORE ARG
03300 PUSHJ P,RDATOM
03400 TRO FL,F.LAHD
03500 FIXUP: ;HERE TO MAKE AN "SOS" COMMAND ;** FIX **
03505 HRRZ T2,P.TEXT ;GET CURRENT BUFFER POINTER ;** FIX **
03510 CAILE T2,CMDBUF ;TEST FOR SHORT CMD (.R -...) ;** FIX **
03515 JRST FIXUP0 ; NO, JUMP ;** FIX **
03520 MOVEI T1,CMDBUF+^D20 ;GET ADDR OF LAST WORD OF BUFFER;** FIX **
03525 MOVE T2,(T1) ;GET 1 WORD OF TEXT ;** FIX **
03530 MOVEM T2,1(T1) ; & MOVE IT DOWN 1 WORD ;** FIX **
03535 CAILE T1,CMDBUF ;TEST FOR DONE ;** FIX **
03540 SOJA T1,.-3 ; NO, DECR & REPEAT ;** FIX **
03545 AOS P.TEXT ;MOVE PTR UP 1 WORD ;** FIX **
03550 FIXUP0: MOVE T1,[ASCII "SOS "] ;** FIX **
03600 MOVEM T1,CMDBUF ;OVERWRITE RUN CMD
03700 MOVE T1,[POINT 7,CMDBUF+1]
03800 MOVEI C," "
03900 FIXUP1: IBP T1
04000 CAMN T1,P.TEXT
04100 JRST FIXUP2
04200 DPB C,T1
04300 JRST FIXUP1
04400 FIXUP2: TRNN FL,F.LAHD ;CORRECT # OF SPACES
04500 DPB C,T1
04600
04700 PARSE1: PUSHJ P,RDSKIP ;RETURN HERE TO SKIP SPACES
04800 PARSE2: PUSHJ P,RDATOM
04900 CAIN C,12
05000 JRST RDEOT
05100 TRO FL,F.ANY ;SET ATOM SEEN
05200 CAIN C,"/" ;SLASH
05300 JRST RDSLSH
05400 CAIN C,"."
05500 JRST RDPER
05600 CAIE C,"_"
05700 CAIN C,"="
05800 JRST RDEQL
05900 CAIE C," "
06000 CAIN C," "
06100 JRST RDSPAC
06200 IFN CRYPSW,<
06300 CAIN C,"("
06400 JRST RDLPRN
06500 >
06600 CAIN C,"["
06700 JRST RDPPN
06800 CAIN C,":"
06900 JRST RDCOLN
06910 IFN %SS006, <
06920 CAIN C,074 ;TEST FOR PROTECTION
06930 JRST RDPROT ; YES, JUMP
06940 >; END OF IFN %SS006
07000 ILLCHR: MOVEI T1,[ASCIZ /Illegal char in cmd/]
07100 JRST COMERR
07200
07300 ;HERE WHEN COLON SEEN
07400
07500 RDCOLN: TRZN FL,F.SLSH ;IN SWITCH?
07600 JRST RDCLN1 ;NO: TREAT AS DEVICE
07700 TRO FL,F.LAHD ;YES: SET LOOK AHEAD
07800 JRST RDSPC1 ;AND LOOK AT SWITCH
07900
08000 RDCLN1: JUMPE D,RDCERR ;ERROR IF NULL DEVICE
08100 TROE FL,F.COLN ;SAY SEEN ONE
08200 JRST RDCERR
08300 MOVEM D,DEV(ALTP) ;STASH
08400 JRST PARSE2 ;AND CONT PARSE
08500
08600 RDCERR: MOVEI T1,[ASCIZ /Illegal colon/]
08700 JRST COMERR
08800
08900 IFN %SS006, <
09000 RDPROT: PUSHJ P,CHKFIL ;CALL TO STORE PREVIOUS ATOM
09100 JUMPE D,RDPRTE ; ERROR IF NOTHING STORED/TO BE STORED
09200 JRST RDSPAC ; ELSE TREAT AS SPACE (STORES PREV ATOM)
09300 RDPRT1: TROE FL,F.PROT ;TEST FOR PREVIOUS PROT & SET BIT
09400 JRST RDPRTE ; PREV, ERROR
09500 PUSHJ P,SCAN ;SCAN FOR THE PROTECTION
09600 TRNE FL,NUMF ;TEST FOR A NUMBER
09700 PUSHJ P,RJUST ;JUSTIFY THE OCTAL NUMBER
09800 JRST RDPRTE ; ERROR IF NOT NUMBER OR NOT OCTAL
09900 TDNE T1,[-1,,777000] ;TEST FOR TOO BIG
10000 JRST RDPRTE ; YES, ERROR
10100 HRRM T1,PRT(ALTP) ;STORE THE PROTECTION
10200 PUSHJ P,SCAN ;GET THE DELIMITER
10300 CAIN C,076 ;TEST FOR END OF PROTECTION
10400 JRST PARSE1 ; YES, CONTIUE SCANNING
10500 CAIN C,12 ;TEST FOR END OF LINE
10600 JRST RDEOT ; YES, THEN DONE
10700 RDPRTE: MOVEI T1,[ ASCIZ /Illegal protection/] ;POINT AT TEXT
10800 JRST COMERR ; & GIVE THE ERROR
10900 >; END OF IFN %SS006
00100 ;HERE WHEN SPACE SEEN
00200
00300 RDSPAC: TRZE FL,F.SLSH
00400 JRST RDSPC1 ;CHECK SWITCH
00500 PUSHJ P,RDPLNK ;STORE DESCRIPTOR
00600 TRO FL,F.ANY ;SAY WE'VE SEEN SOMETHING
00700 JRST PARSE1
00800
00900 RDSPC1: MOVEM D,ACCUM ;STASH ARG FOR DECODE
01000 PUSHJ P,DOSET ;CALL ON SET CODE
01100 JRST SWTERR ;ERROR RETURN
01200 TRO FL,F.LAHD ;SET LOOK AHEAD
01300 MOVEM C,SAVCHR ;SAVE INCASE OF TTY INPUT
01400 JRST PARSE1 ;CONTINUE PARSE
01500
01600 SWTERR: MOVEI T1,[ASCIZ /Illegal switch/]
01700 JRST COMERR
01800
01900 ;HERE WHEN EQUAL SIGN SEEN
02000
02100 ;;*FIX* RDEQL: TROE FL,F.EQL ;MAKE SURE FIRST ONE
02200 ;;*FIX* JRST RDEQLE
02210 RDEQL: TRZE FL,F.SLSH ;TEST FOR SWITCH PRECEEDING EQUALS ;** FIX **
02220 JRST RDSPC1 ; YES, JUMP TO PROCESS IT ;** FIX **
02300 PUSHJ P,CHKFIL ;SEE IF WE HAVE A FILE
02400 JUMPE D,RDEQL1 ;OK IF D .NE. 0
02500 PUSHJ P,RDPLNK ;STASH REMAINING ATOM
02600 ;;*FIX* RDEQL1: TRZ FL,F.PER!F.COLN!F.PPN!F.CDSN!F.LAHD
02610 RDEQL1: TROE FL,F.EQL ;MAKE SURE ONLY 1 EQUALS ;** FIX **
02620 JRST RDEQLE ; NO, ERROR ;** FIX **
02630 TRZ FL,F.PER!F.COLN!F.PPN!F.CDSN!F.LAHD ;** FIX **
02700 MOVEI ALTP,ORGBLK ;CLR FLAGS AND ADVANCE PNTR
02800 MOVSI T1,'DSK'
02900 MOVEM T1,DEV(ALTP) ;DEFAULT DEVICE NAME
03000 JRST PARSE2 ;AND CONTINUE
03100
03200 RDEQLE: MOVEI T1,[ASCIZ /Illegal equal sign/]
03300 JRST COMERR
03400
03500 ;HERE WHEN SLASH SEEN
03600
03700 RDSLSH: PUSHJ P,CHKFIL
03800 JUMPE D,RDSLS1
03900 JRST RDSPAC
04000 RDSLS1: TRZ FL,F.LAHD ;CLEAR LOOK AHEAD
04100 TRON FL,F.SLSH
04200 JRST PARSE2
04300 MOVEI T1,[ASCIZ /Illegal slash/]
04400 JRST COMERR
00100 ;HERE WHEN LEFT PAREN SEEN
00200
00300 IFN CRYPSW,<
00400 RDLPRN: PUSHJ P,CHKFIL
00500 JUMPE D,RDLPER
00600 JRST RDSPAC ;TREAT AS SPACE
00700 TRON FL,F.CDSN ;GRNTEE UNIQUE CODE
00800 JRST RDLPR1 ;GO SNARF CODE
00900 RDLPER: MOVEI T1,[ASCIZ /Illegal code spec./]
01000 JRST COMERR
01100 RDLPR1: MOVE T1,[POINT 7,CODBUF]
01200 MOVEI T2,CODMAX
01300 RDLPR2: PUSHJ P,@CHIN ;FETCH A CHAR
01400 CAIN C,")"
01500 JRST RDLPR3
01600 CAIN C,12
01700 JRST RDLPER ;ERROR IF EOT
01800 IDPB C,T1
01900 SOJG T2,RDLPR2
02000 MOVEI T1,[ASCIZ /Code too long/]
02100 JRST COMERR
02200
02300 RDLPR3: MOVEI C,0
02400 IDPB C,T1
02500 MOVEM 7,S.CRYP+7
02600 MOVEI 7,S.CRYP
02700 BLT 7,S.CRYP+6
02800 MOVEI 7,CODBUF ;GET A SEED
02900 PUSHJ P,CRASZ.##
03000 MOVEM 5,COD(ALTP) ;STASH AWAY
03100 MOVSI 7,S.CRYP
03200 BLT 7,7
03300 TRZ FL,F.LAHD
03400 JRST PARSE1
03500 >
03600
03700 ;HERE WHEN PERIOD SEEN
03800
03900 RDPER: JUMPN D,RDPER1
04000 MOVEI T1,[ASCIZ /Null name with extension/]
04100 JRST COMERR
04200 RDPER1: TROE FL,F.PER
04300 JRST [MOVEI T1,[ASCIZ /Illegal period/]
04400 JRST COMERR]
04500 ;;*FIX* MOVEM D,NAM(ALTP)
04550 PUSHJ P,RDPLN1 ;GO STORE THE FILE NAME ;** FIX **
04600 JRST PARSE2
04700
04800 ;HERE WHEN END OF CMD SEEN
04900
05000 RDEOT: PUSHJ P,CHKFIL
05100 JUMPE D,RDEOT0
05200 JRST RDSPAC ;PROCESS AS SPACE IF SOMETHING THERE
05300 RDEOT0: SETZM SAVCHR ;CLEAR TTY INPUT
05400 TRNN FL,F.ANY ;ANYTHING?
05500 JRST COMER1
05600 TRNE FL,F.EQL ;EQUAL SIGN SEEN?
05700 SKIPE ORGNAM ;YES: BETTER SEE FILE NAME
05800 SKIPA
05900 JRST RDEQLE ;FUNNY EQUAL SIGN
05910 IFN %SS006, <
05920 HRRZ T1,NEWPRT ;GET THE OUTPUT PROTECTION
05930 SKIPE T1 ;TEST FOR DEFINED
05940 HRRM T1,ORGPRT ; YES, STORE AS ORIGINAL PROTECTION
05950 >; END OF IFN %SS006
06000 SKIPN NEWNAM ;WAS A NEW NAME GIVEN?
06100 JRST RDEOT2 ;NO - CHECK FOR DEFAULT
06200 TRNE FL,F.EQL ;YES - EQUAL SIGN SEEN?
06300 JRST RDEOTX ;YES - THEN DONE
06400 MOVE T1,[NEWBLK,,ORGBLK]
06500 BLT T1,ORGBKE ;PUT INFO IN ORG BLOCK
06600 PUSHJ P,ZERNEW
06700 JRST RDEOTX ;AND EXIT
06800
06900 RDEOT2: TRNN FL,F.EQL ;EQUAL SEEN?
07000 JRST [MOVEI T1,[ASCIZ /No file given/]
07100 JRST COMERR]
07200 HRROI T1,ORGEXT ;YES - SET INFO
07300 POP T1,NEWEXT ;INTO DEFAULTS
07400 POP T1,NEWNAM
07490 IFE %SS006, <
07500 RDEOTX: TRZ FL,P.FLGS ;CLEAR PARSE FLAGS
07510 >; END OF IFE %SS006
07520 IFN %SS006, <
07530 RDEOTX: TRNE FL,READOF ;TEST FOR READ-ONLY
07540 SKIPN NEWNAM ;TEST FOR OUTPUT NAME
07550 TRZA FL,P.FLGS ; NOT R/O OR NO OUTPUT, CLEAR & SKIP
07560 JRST RDEQLE ; ELSE SYNTAX ERROR
07570 >; END OF IFN %SS006
07600 MOVE T1,SVPCIN ;RESTORE CHIN
07605 IFN %SS066, <
07610 SKIPE SAILSW ;TEST FOR SAIL MODE
07615 SKIPN RPGSW ;TEST FOR SAIL SUCCESSFUL
07620 JRST RDEOT3 ; IF NOT SUCCESSFUL SAIL, RESET I/O ROUTINE
07625 ; ELSE SET UP AS @-FILE
07630 MOVEM T1,SVCCIN ;STORE PREVIOUS I/O ROUTINE
07635 TRO FL2,COMFLF ;SET THE @-FILE BIT
07640 MOVEI T1,LDCHRS ;GET NEW ROUTINE FOR 1ST SAIL CMD
07645 RDEOT3: ;TO HERE IF NOT SUCCESSFUL SAIL
07650 >; END OF IFN %SS066
07700 MOVEM T1,CHIN
07800 SKIPE RPGSW ;RPG MODE?
07900 PUSHJ P,WRTMP ;YES: WRITE OUT TEMP
07990 IFE %SS027, <
08000 SKIPN T1,TECINC ;TECO INCREMENT?
08100 MOVE T1,[<ASCII /00100/>!1]
08200 MOVEM T1,TECINC ;SET CORRECT ONE UP
08300 SKIPN TECFST ;START SEQ # GIVEN?
08400 MOVEM T1,TECFST ;NO: USE INCREMENT
08410 >; END OF IFE %SS027
08500 POPJ P, ;EXIT PARSE
00100 ;HERE TO READ PPN'S
00200
00300 RDPPN: PUSHJ P,CHKFIL ;SEE IF FILE SPEC
00400 JUMPE D,PPERR ;ERROR IF NO ATOM
00500 JRST RDSPAC ;ELSE TREAT AS SPACE
00600 TRON FL,F.PPN ;GRNTEE JUST ONE PER FILE SPEC
00700 JRST RDPPN1
00800 PPERR: MOVEI T1,[ASCIZ /Illegal PPN/]
00900 JRST COMERR
01000
01100 RDPPN1: SETZM SAVCHR ;CLEAR OUT SCAN
01200 SETZM SAVC
01300 PUSHJ P,SETPPN ;GO READ PPN
01400 JRST PPERR ;ERROR
01410 IFN %SS006, <
01420 TRNE FL,TERMF ;TEST FOR TERMINATOR
01430 JRST RDEOT0 ; YES, DONE NOW (NAME & EXT'N ALREADY STORED)
01440 >; END OF IFN %SS006
01500 TRZ FL,F.LAHD ;CLEAR LOOK-AHEAD
01600 JRST PARSE1
01700
01800 ;ROUTINE TO ZERO OUT NEWBLK
01900
02000 ZERNEW: MOVE T1,[NEWBLK,,NEWBLK+1]
02100 SETZM NEWBLK
02200 BLT T1,NEWBKE
02300 POPJ P,
00100 ;COMMAND ERROR ROUTINE
00200
00300 COMERR:
00400 OUTSTR [ASCIZ /? /]
00500 OUTSTR (T1)
00600 OCRLF
00700 SETOM TMPCF ;MAKE LIKE READ
00800 CLRBFI ;CLEAR TYPE AHEAD
00900 SETZM TTIBH+2
01000 COMER1: SKIPN TMPCF ;HERE ONCE?
01100 SKIPN RPGSW ;NO: RPG MODE?
01200 SKIPA ;SKIP INTO NORMAL CMD LOOP
01300 PUSHJ P,RDTMP ;READ TEMP (SKIP IF OK)
01400 SETZM RPGSW ;CLEAR RPG MODE
01500 TRZ FL,P.FLGS
01600 MOVE T1,SVPCIN ;RESTORE CHIN
01700 MOVEM T1,CHIN
01800 MOVE P,[IOWD PDLSIZ,PDL] ;RESTORE PDL
01850 JRST NOCOM1 ;TRY SOME MORE
01900
02000 ;HERE TO STASH ATOM IN EITHER NAME OR EXT
02100
02200 RDPLNK: JUMPE D,CPOPJ ;DONE IF NULL ATOM
02300 TRNN FL,F.PER ;PERIOD? ;** FIX **
02400 JRST RDPLN1 ;NO: STASH NAME
02490 IFE %SS006, <
02500 HLLZM D,EXT(ALTP) ;YES: EXTENSION
02510 >; END OF IFE %SS006
02520 IFN %SS006, <
02530 HLLM D,EXT(ALTP) ;STORE THE EXTENSION
02540 >; END OF IFN %SS006
02600 POPJ P,
02700
02800 RDPLN1: SKIPE NAM(ALTP) ;TEST FOR NON-ZERO NAME ;** FIX **
02810 JRST [ ; YES, JUMP ;** FIX **
02820 JSP T1,COMERR ;POINT AT MSG & GO GIVE ERROR ;** FIX **
02830 ASCIZ /Duplicate file name/ ;** FIX **
02840 ] ;** FIX **
02850 MOVEM D,NAM(ALTP) ;STORE THE FILE NAME ;** FIX **
02900 POPJ P, ;RETURN
00100 ;HERE TO READ TEMP FILE
00200
00300 RDTMP: SETOM TMPCF ;STATE THAT WE HAVE TRIED
00400 MOVNI T1,20 ;BUFFER SIZE
00500 HRLM T1,T.IOWD
00510 IFN %SS066, <
00520 MOVE T4,SAILSW ;GET THE SAIL SWITCH
00530 >; END OF IFN %SS066
00600 IFN TEMPC,<
00690 IFE %SS066, <
00700 MOVE T1,[XWD 1,T.HEAD]
00710 >; END OF IFE %SS066
00720 IFN %SS066, <
00730 RDTMP0: MOVE T1,TS.DSP(T4) ;GET THE TMPCOR PARM LIST
00740 >; END OF IFN %SS066
00800 TMPCOR T1,
00900 SKIPA ;IT FAILED - TRY FILE
01000 JRST RDTMP1
01100 >
01190 IFE %SS066, <
01200 MOVSI T3,(<SIXBIT /EDS/>)
01210 >; END OF IFE %SS066
01220 IFN %SS066, <
01230 HRRZ T3,TS.DSP(T4) ;GET THE *.TMP FILENAME ADDRESS
01240 MOVE T3,(T3) ; & GET THE FILENAME
01250 >; END OF IFN %SS066
01300 PUSHJ P,JOBNUM
01400 MOVEM T3,XBLOCK ;STASH FILE NAME
01500 MOVSI T1,(<SIXBIT /TMP/>)
01600 MOVEM T1,XBLOCK+1 ;AND EXTENSION
01690 IFE %SS006, <
01700 SETZM XBLOCK+3 ;ZERO PPN
01710 >; END OF IFE %SS006
01720 IFN %SS006, <
01730 MOVE T1,MYPPN ;GET USER'S PPN
01740 MOVEM T1,XBLOCK+3 ; & STORE TO FIND *.TMP THERE
01750 >; END OF IFN %SS006
01800 MOVE T1,[1B0+17] ;DUMP MODE + PHYS ONLY
01900 MOVSI T2,'DSK' ;ON DEFAULT STR
02000 MOVEI T3,0
02100 OPEN IN,T1 ;PERFORM OPEN
02200 JRST RDTMPE ;TREAT AS FNF
02300 LOOKUP IN,XBLOCK ;IS IT THERE
02390 IFE %SS066, <
02400 RDTMPE: JRST [RELEAS IN,0
02500 POPJ P,]
02600 INPUT IN,T.IOWD ;FETCH FILE
02605 >; END OF IFE %SS066
02610 IFN %SS066, <
02615 RDTMPE: JRST [ ;JUMP IF ERROR, LOOKUP OR OTHERWISE
02620 RELEAS IN, ;RELEASE THE CHANNEL
02625 JUMPE T4,CPOPJ ; RETURN +0 FOR ERROR IF NORMAL ('EDS')
02630 SETZB T4,SAILSW ;RESET FROM SAIL TO NORMAL
02635 JRST RDTMP ; & TRY FOR OTHER FILE
02640 ]
02645 HRRZ T1,TS.DSP(T4) ;GET ADDR-1 OF PROPER IOWD
02650 INPUT IN,1(T1) ;READ THE FILE
02655 >; END OF IFN %SS066
02700 STATZ IN,740000 ;CHECK ERRORS
02800 JRST RDTMPE ;YOU LOSE
02810 IFN %SS066, <
02820 SETZB T1,T2 ;CLEAR FOR DELETION
02830 SKIPE T4 ;TEST FOR SAIL
02840 RENAME IN,T1 ; YES, DELETE THE FILE
02850 JFCL ; (IGNORE ERRORS)
02860 >; END OF IFN %SS066
02900 RELEAS IN,0
03000 RDTMP1: MOVE T1,[POINT 7,CMDBUF]
03100 MOVEM T1,P.TEXT
03110 IFN %SS066, <
03120 JUMPE T4,CPOPJ1 ;RETURN+1 FOR SUCCESS IF NORMAL
03130 MOVE T1,[ASCII /SOS /] ;GET A PSEUDO-COMMAND
03140 MOVEM T1,CMDBUF ; & STORE INTO 1ST WORD
03150 MOVEI T1," " ;GET A BLANK
03160 DPB T1,[POINT 7,CMDBUF+1,6] ; & BLANK 1ST CHAR OF 2ND WORD
03170 >; END OF IFN %SS066
03200 ;;*FIX* AOS (P)
03300 ;;*FIX* POPJ P,
03350 JRST CPOPJ1 ;** FIX **
03400
03500 ;HERE TO WRITE TEMP FILE
03600
03700 WRTMP: HRRZ T1,P.TEXT ;CALC LENGTH OF STRING
03800 SUBI T1,CMDBUF-1
03900 MOVN T1,T1 ;NEG LENGTH
04000 HRLM T1,T.IOWD
04100 IFN TEMPC,<
04200 MOVE T1,[XWD 3,T.HEAD]
04300 TMPCOR T1,
04400 SKIPA
04500 POPJ P,
04600 >
04700 MOVSI T3,(<SIXBIT /EDS/>)
04800 PUSHJ P,JOBNUM
04900 MOVEM T3,XBLOCK
05000 MOVSI T1,(<SIXBIT /TMP/>)
05100 MOVEM T1,XBLOCK+1 ;GEN FILE NAME
05200 SETZM XBLOCK+2
05290 IFE %SS005, <
05300 SETZM XBLOCK+3
05310 >; END OF IFE %SS005
05320 IFN %SS005, <
05330 MOVE T1,MYPPN ;GET USER'S PPN
05340 MOVEM T1,XBLOCK+3 ; & STORE TO FIND *.TMP THERE
05350 >; END OF IFN %SS005
05400 MOVE T1,[1B0+17] ;DUMP MODE + PHYS ONLY
05500 MOVSI T2,'DSK' ;DEFAULT STR
05600 MOVEI T3,0
05700 OPEN OUT,T1 ;INIT DSK
05800 JRST WRTMP1 ;LOSE!
05900 ENTER OUT,XBLOCK
06000 JRST WRTMP1 ;JUST IGNORE
06100 OUTPUT OUT,T.IOWD
06200 WRTMP1: RELEAS OUT,0 ;CLOSE CHL
06300 POPJ P,
06400
06500 ;GENERAL JOBNUMBER KLUDGE...
06600
06700 JOBNUM:
06800 PJOB T1,
06900 JOBNM1: IDIVI T1,^D10
07000 IORI T2,20
07100 LSHC T2,-6
07200 TRNN T3,77
07300 JRST JOBNM1
07400 POPJ P,
00100 ;UTILITY ROUTINES
00200
00300 RDSKIP: PUSHJ P,RDSKP1 ;SKIP SPACES
00400 TRO FL,F.LAHD ;SET LOOK AGAIN
00500 POPJ P,
00600
00700 RDSKP1: PUSHJ P,@CHIN
00800 CAIE C," "
00900 CAIN C," " ;SPACE OR TAB
01000 JRST RDSKP1
01100 POPJ P,
01200
01300 RDATOM: MOVE T1,[POINT 6,D]
01400 MOVEI D,0 ;INIT ATOM
01500 RDATO1: PUSHJ P,@CHIN
01600 PUSHJ P,CKALN ;CHECK ALPHA-NUMERIC
01700 JRST RDATO2
01800 TLNN T1,770000 ;6 YET?
01900 JRST RDATO1
02000 SUBI C,40
02100 IDPB C,T1
02200 JRST RDATO1
02300
02400 RDATO2: CAIE C," "
02500 CAIN C," "
02600 PUSHJ P,RDSKP1
02700 PUSHJ P,CKALN
02800 POPJ P,
02900 MOVEI C," " ;RETURN A SPACE IF
03000 TRO FL,F.LAHD ;ALPHA-NUMERIC
03100 POPJ P,
03200
03300 ;SUBROUTINE TO CHECK WHAT TO DO AT BREAK CHAR
03400 ;CALL:
03500 ; PUSHJ P,CHKFIL
03600 ; <HERE IF NAME NOT STORED (CHECK D)>
03700 ; <HERE IF NAME STORED AND PERIOD SEEN>
03800 ; <HERE IF NO FURTHER PROCESSING REQUIRED>
03900
04000 CHKFIL: SKIPN NAM(ALTP) ;SEE IF WE GOT A NAME
04100 JRST CHKFL1 ;NO: SET LAHD AND RETURN
04200 AOS (P)
04300 ;;*FIX* TRNN FL,F.PER ;** FIX **
04400 JUMPE D,CPOPJ1 ;DOUBLE SKIP IF OK
04500 MOVEI C," " ;RETURN SPACE
04600 CHKFL1: TRO FL,F.LAHD
04700 POPJ P, ;SKIP RETURN IF NEED TO STASH 'D'
00100 ;HERE TO FETCH NEXT CHAR
00200
00300 LDCHR: SKIPN RPGSW ;FROM WHERE
00400 JRST LDCHR1
00500 TRZN FL,F.LAHD
00600 LDCHRA: IBP P.TEXT
00700 LDB C,P.TEXT
00800 CAIN C,15 ;PURGE CR'S
00900 JRST LDCHRA
01000 POPJ P,
01100
01200 LDCHR1: TRZE FL,F.LAHD
01300 SKIPA C,SVCCIN
01400 LDCHRB: PUSHJ P,TTYCH
01500 CAIN C,15 ;SKIP OVER CR'S
01600 JRST LDCHRB
01700 MOVEM C,SVCCIN
01800 POPJ P,
01805
01810 IFN %SS066, <
01815
01820 ; SPECIAL ROUTINE TO SUPPLY SAIL'S INITIAL "PN/M" COMMAND TO SOS
01825
01830 LDCHRS: PUSH P,T1 ;SAVE AN AC
01835 LDCHRL: ILDB C,P.TEXT ;GET THE NEXT BUFFERED CHAR
01840 MOVE T1,P.TEXT ;GET THE UPDATED B.P.
01845 CAMN T1,[POINT 7,CMDBUF+17,34] ;TEST FOR END OF DATA
01850 JRST LDCHRX ; YES, THEN THIS IS THE LAST
01855 JUMPE C,LDCHRL ;IGNORE IT IF NULL
01860 CAIE C,12 ;TEST FOR END OF LINE
01865 CAMN C,ESC ;TEST FOR ESCAPE
01870 LDCHRX: PUSHJ P,CKCOMF ; LF/ESC/END OF BUFFER, RESET I/O ROUTINE
01875 POP P,T1 ;RESTORE THE AC
01880 POPJ P, ;RETURN TO CALLER
01885 >; END OF IFN %SS066
01900
02000 ;CHECK IF CHAR IS ALPHA-NUMERIC
02100
02200 CKALN: CAIG C,"z"
02300 CAIGE C,"a"
02400 SKIPA
02500 SUBI C,40 ;CONVERT TO UPPER
02600 CAIL C,"0"
02700 CAILE C,"Z"
02800 POPJ P,
02900 CAILE C,"9"
03000 CAIL C,"A"
03100 AOS (P)
03200 POPJ P,
03300
03400 ;SPECIAL ROUTINE CALLED FROM SET OPTION IN INITIAL PARSE
03500
03600 OPTSWT: TLZ FL2,INPARS ;TEMP CLR FLAG
03700 PUSHJ P,DOOPT ;PARSE OPTION FILE
03800 JRST OPTSE1 ;SAY NOT FOUND
03900 JRST OPTSE2 ;SAY ERROR IN FILE
04000 TLO FL2,INPARS ;TURN BACK ON
04100 MOVEI C," " ;PRETEND LAST CHAR WAS A SPACE
04200 POPJ P, ;RETURN
04300
04400 OPTSE1: MOVEI T1,[ASCIZ /Option not found/]
04500 JRST COMERR
04600 OPTSE2: MOVEI T1,[ASCIZ /Syntax error in option file/]
04700 JRST COMERR
04800
04900 SUBTTL OPTION FILE HANDLER
00100 ;ROUTINE TO EAT AN OPTION FILE IF ANY
00200 ;CALL: PUSHJ P,DOOPT
00300 ; <OPTION NOT FOUND>
00400 ; <ERROR IN OPTION FILE>
00500 ; <OK RETURN>
00600 ; C(OPTION) = SIXBIT OF DESIRED OPTION OR ZERO IF DEFAULT
00700
00800 DOOPT: TLNE FL2,INOPTF ;TRYING TO REENTER
00900 JRST WRAPUP ;JUST GIVE CURRENT FAILURE
01000 OPEN OPT,OPTDVI
01100 POPJ P, ;SAY NOT FOUND
01200 MOVEI T1,OPTBUF ;GET BUFFER ADDR
01300 EXCH T1,.JBFF##
01400 INBUF OPT,1 ;ONE IS ENUF
01500 MOVEM T1,.JBFF## ;RESTORE JOBFF
01600 SETZM OPTFIL+2 ;CLEAR OUT ANY TRASH
01690 IFE %SS006, <
01700 SKIPN T1,MYPPN ;GET DEFAULT DIRECTORY
01800 PUSHJ P,USRPPN
01900 MOVEM T1,OPTFIL+3 ;STASH IN CORRECT PLACE
01910 >; END OF IFE %SS006
01920 IFN %SS006, <
01930 SETZM OPTFIL+3 ;ZERO PPN (OPTION FILE IN DEFAULT AREA)
01940 >; END OF IFN %SS006
02000 LOOKUP OPT,OPTFIL ;GO FIND FILE
02100 JRST [RELEAS OPT,
02200 POPJ P,] ;NOT FOUND
02300 MOVEI T1,OPTCH ;SET UP INPUT ROUTINE
02400 EXCH T1,CHIN ;SAVE CURRENT ONE
02500 MOVEM T1,SVOCIN
02600 TLO FL2,INOPTF ;SAY WE IS IN OPTION FILE
02700 SETZM SAVCHR ;CLEAR SCANNER
02750 SETZM SAVC ; DITTO ;** FIX **
02800
02900 RDOPT: PUSHJ P,SCAN ;FETCH FIRST ATOM OF LINE
03000 CAIN C,177 ;EOF OR ERROR?
03100 JRST WRAPUP ;YES: FINISH UP AND RETURN
03200 MOVE T1,ACCUM ;GET WHAT WE FOUND
03300 CAME T1,[SIXBIT "SOS"]
03400 JRST SKPEOL ;NOT WHAT WE WANT - TRY NEXT LINE
03500 PUSHJ P,SCAN ;FETCH BREAK CHAR
03600 SKIPN OPTION ;NEED DEFAULT?
03700 JRST DEFOPT ;YES:
03800 CAIE C,":" ;LOOK AT BREAK CHAR
03900 JRST SKPEOL ;SKIP LINE IF NOT COLON
04000 PUSHJ P,SCAN ;GET NEXT ATOM
04100 TRNE FL,IDF ;SEE IF IDENT
04200 JRST OPTONE ;YES: TRY THIS
04300 CAIE C,"(" ;COULD BE LEFTPAREN
04400 JRST OPTDN1 ;NOPE - IT IS TRASH
04500 OPTMOR: PUSHJ P,SCAN ;TRY FOR ATOM
04600 MOVE T1,ACCUM
04700 CAMN T1,OPTION ;IS THIS THE ONE?
04800 JRST OPTMR1 ;SCAN FOR RT PAREN
04900 PUSHJ P,SCAN ;GULP DOWN BREAK CHAR
05000 CAIN C,"," ;COMMA MEANS MORE COMING
05100 JRST OPTMOR
05200 CAIN C,")" ;RT PAREN MEANS THAT'S ALL
05300 JRST SKPEOL ;TRY NEXT LINE
05400 JRST OPTDN1 ;TRASHINESS
05500
05600 OPTMR1: PUSHJ P,SCAN ;LOOK FOR RT PAREN
05700 CAIE C,177 ;EOF OR ERROR
05800 TRNE FL,TERMF ;EOL
05900 JRST OPTDN1
06000 CAIE C,")" ;A GOOD THING
06100 JRST OPTMR1 ;KEEP LOOKING
06200 JRST OPTFN0 ;GOT IT
06300
06400 OPTONE: MOVE T1,ACCUM
06500 CAME T1,OPTION ;IS THIS IT?
06600 JRST SKPEOL ;NO: KEEP LOOKING
06700 OPTFN0: AOS (P) ;ALL ELSE ARE ERRORS OR AOK
06800 OPTFND: PUSHJ P,SCAN ;SCAN NEXT
06900 TRNE FL,IDF ;IDENTS ARE OK
07000 JRST OPTGOT ;GOT ONE - USE IT
07100 OPTNXT: CAIE C,"/" ;CHECK LEGAL DELIMS
07200 CAIN C,","
07300 JRST OPTGET ;NEED TO SCAN AGAIN
07400 CAIE C,"-" ;CHECK LINE CONT.
07500 JRST OPTDON ;NOPE - CHECK PROPER EOL
07600 PUSHJ P,SCAN ;SCAN PAST DASH
07700 TRNN FL,TERMF ;PROPER TERM?
07800 JRST WRAPUP ;NO: SYNTAX ERROR
07900 JRST OPTFND ;CONTINUE LOOKING
00100 OPTGET: PUSHJ P,SCAN ;GET NEXT ATOM
00200 TRNN FL,IDF ;IDENT?
00300 JRST WRAPUP ;NO: LOSE
00400 OPTGOT: PUSHJ P,DOSET ;SWITCH IN "ACCUM" - CALL SET ROUTINE
00500 JRST WRAPUP ;ILLEGAL ENTRY IN FILE
00600 JRST OPTNXT ;CONTINUE
00700
00800 OPTDON: TRNE FL,TERMF ;OK IF PROPER TERM
00900 OPTDN1: AOS (P) ;GIVE SKIP RETURN
01000 JRST WRAPUP ;FINISH UP
01100
01200 DEFOPT: CAIE C,":" ;IF COLON JUST SKIP LINE
01300 JRST OPTFN0 ;ELSE WE HAVE CORRECT LINE
01400 SKPEOL: PUSHJ P,GNCH ;GET A CHAR
01500 CAIN C,177 ;CHECK ON EOF
01600 JRST WRAPUP ;DONE IF SO
01700 TLNN CS,TERM_16 ;TERMINATOR?
01800 JRST SKPEOL ;NO: KEEP GOING
01900 SETZM SAVCHR ;CLEAR SCANNER
02000 JRST RDOPT ;YES: TRY THIS LINE
02100
02200 WRAPUP: RELEAS OPT, ;CLOSE CHL
02300 MOVE T1,SVOCIN ;RESTORE OLD INPUT ROUTINE
02400 MOVEM T1,CHIN
02500 TLZ FL2,INOPTF
02600 POPJ P, ;RETURN
00100 ;UTILITY ROUTINES TO READ OPTION FILE
00200
00300 OPTCH: SOSG OPTBHD+2
00400 JRST OPTINP ;NEED MORE
00500 OPTCH1: ILDB C,OPTBHD+1 ;GET CHAR
00600 JUMPE C,OPTCH ;IGNORE NULLS
00700 MOVE CS,@OPTBHD+1 ;CHECK FOR SEQ NOS
00800 TRNN CS,1
00900 POPJ P, ;NONE - RETURN
01000 MOVNI C,5 ;YES: SKIP IT
01100 ADDM C,OPTBHD+2
01200 AOS OPTBHD+1
01300 CAME CS,PGMK ;PAGE MARK?
01400 JRST OPTCH ;NO: GET NEXT CHAR
01500 MOVNI C,4 ;YES: SKIP SOME MORE
01600 ADDM C,OPTBHD+2
01700 MOVSI C,(<POINT 7,0,35>)
01800 HLLM C,OPTBHD+1
01900 JRST OPTCH ;TRY AGAIN
02000
02100 OPTINP: STATZ OPT,760000 ;EOF OR ERROR?
02200 JRST OPTEOF ;YES: RETURN -1
02300 IN OPT,0
02400 JRST OPTCH1 ;OK - RETURN
02500 STATZ OPT,740000 ;ERROR?
02600 OUTSTR [ASCIZ /? Read error in option file/]
02700 OPTEOF: MOVEI C,177 ;GET A RUBOUT
02800 POPJ P, ;AND RETURN
02900
03000 SUBTTL SPECIAL FILE UUOS
00100 ;ROUTINE TO SET UP FOR FILE OPERATION
00200
00300 SETPRM: PUSH P,T2 ;SAVE T2 - T1 ALREADY SAVED
00400 SETZM XBLOCK+2+<EXTOFF*%SS006> ;CLEAR RESIDUALS
00410 IFN %SS006, <
00420 MOVEI T2,16 ;GET LTH OF EXTENDED BLOCK
00430 MOVEM T2,XBLOCK ; & STORE AS 1ST WORD
00440 MOVE T2,[XBLOCK+4,,XBLOCK+5] ;GET BLT PARMS
00450 BLT T2,XBLOCK+16 ; & CLEAR THE REST OF THE PARMS
00460 >; END OF IFN %SS006
00500 HRRZ T2,.JBUUO## ;GET PARAMS ADDRS
00600 MOVE T1,NAM(T2) ;FILE NAME
00700 MOVEM T1,XBLOCK+<EXTOFF*%SS006>
00800 MOVE T1,EXT(T2) ;EXTENSION
00900 HLLZM T1,XBLOCK+1+<EXTOFF*%SS006>
01000 DPB T1,[POINT 9,XBLOCK+2+<EXTOFF*%SS006>,8]
01080 IFG SFDLVL, < ;** FIX **
01090 IFE %SS006, <
01100 SKIPE T1,PTH(T2) ;CHECK FOR DEFAULT PATH
01200 SKIPN PTH+1(T2) ;OR JUST PPN
01210 >; END OF IFE %SS006
01220 IFN %SS006, <
01230 SKIPN T1,PTH(T2) ;ALWAYS USE PATH-TYPE PPN IF NON-ZERO
01240 ; (PERMITS UFD_SFD RENAMES TO WORK)
01250 >; END OF IFN %SS006
01300 JRST STPRM1
01400 MOVEI T1,PTH(T2) ;ADDRS OF PATH INFO
01500 MOVSS T1
01600 HRRI T1,PTHADR+2
01700 BLT T1,PTHADR+2+SFDLVL
01800 SETZM PTHADR
01900 SETZM PTHADR+1
02000 MOVEI T1,PTHADR ;SET UP XBLOCK INFO
02010 >; END OF IFG SFDLVL ;** FIX **
02020 IFLE SFDLVL, < ;** FIX **
02030 MOVE T1,PTH(T2) ;GET THE PPN (OR ZERO) ;** FIX **
02040 >; END OF IFLE SFDLVL ;** FIX **
02100 STPRM1: MOVEM T1,XBLOCK+3-<EXTOFF*%SS006>
02110 IFN %SS006, <
02120 MOVEM T1,XBLOCK+5 ;STORE PPN OVER .RBSIZ, FOR SHORT-FORM PARMS
02130 ; (NO HARM DONE FOR EXTENDED LOOKUP/ENTER)
02140 >; END OF IFN %SS006
02200 MOVE T1,.JBUUO## ;FETCH UUO
02300 AND T1,[17B12] ;GET AC FIELD
02400 JRST T2POPJ ;RETURN
02500
02600 ;ROUTINE TO DO LOOKUP
02700
02800 LKX: PUSHJ P,SETPRM ;SETUP
02900 IOR T1,[LOOKUP 0,XBLOCK]
02910 IFN %SS006, <
02920 CAME T1,[LOOKUP ALTDV,XBLOCK] ;TEST FOR COPY-DVC LOOKUP
02930 CAMN T1,[LOOKUP IND,XBLOCK] ;TEST FOR @-FILE LOOKUP
02940 HRRI T1,XBLOCK+2 ; EITHER, USE SHORT FORM
02950 ; TO PERMIT DECTAPE I/O
02960 >; END OF IFN %SS006
03000 XCT T1
03100 AOS (P) ;SKIP ON FAIL
03110 IFN %SS071, <
03120 CAME T1,[LOOKUP IN,XBLOCK] ;TEST FOR INPUT-FILE LOOKUP
03130 POPJ P, ; NO, RETURN TO UUO HANDLER
03140 MOVE T1,XBLOCK+.RBSIZ ;GET ACTUAL # OF WDS WRITTEN
03150 ADDI T1,177 ; ROUND UP
03160 LSH T1,-7 ; & CONVERT TO BLOCKS
03170 MOVEM T1,FILSIZ ;STORE AS ESTIMATED FILE SIZE
03180 >; END OF IFN %SS071
03200 POPJ P,
03300
03400 ;ROUTINE TO DO ENTER
03500
03600 ENX: PUSHJ P,SETPRM ;SETUP
03610 IFN %SS071, <
03620 CAMN T1,[Z OUT,] ;TEST FOR OUTPUT-FILE ENTER
03630 JRST [ ; YES, JUMP
03640 SKIPLE T1,FILSIZ ;GET ESTIMATED FILE SIZE & TEST
03650 MOVEM T1,XBLOCK+.RBEST; +, STORE AS ESTIMATE FOR ENTER
03660 MOVSI T1,(<Z OUT,>) ;RESTORE THE CHANNEL #
03670 JRST .+1 ; & CONTINUE
03680 ]
03690 >; END OF IFN %SS071
03700 IOR T1,[ENTER 0,XBLOCK]
03710 IFN %SS006*LSTSW, <
03720 CAMN T1,[ENTER LPT,XBLOCK] ;TEST FOR LISTING-FILE ENTER
03730 HRRI T1,XBLOCK+2 ; YES, USE SHORT-FORM FOR DECTAPE
03740 >; END OF IFN %SS006*LSTSW
03800 XCT T1
03900 AOS (P) ;SKIP ON FAIL
04000 POPJ P,
04100
04200 ;ROUTINE TO DO RENAME
04300
04400 RNX: PUSHJ P,SETPRM ;SETUP
04405 IFN %SS006, <
04410 SKIPN XBLOCK+.RBPRV ;TEST FOR PROTECTION GIVEN
04415 JRST RNX1 ; NO, JUMP
04420 PUSH P,T2 ;SAVE AN AC
04425 IOR T1,[GETSTS .-.,T2] ;GET A GETSTS UUO
04430 XCT T1 ; & EXECUTE IT
04435 DPB T2,[POINT 4,XBLOCK+.RBPRV,12] ;STORE CURRENT FILE MODE FOR RENAME
04440 POP P,T2 ;RESTORE THE AC
04445 AND T1,[17B12] ;CLEAR ALL BUT CHANNEL #
04450 RNX1: ;HERE AFTER STATUS SET UP
04455 >; END OF IFN %SS006
04500 IOR T1,[RENAME 0,XBLOCK]
04600 XCT T1
04700 AOS (P) ;SKIP ON FAIL
04800 POPJ P,
04900
05000 SUBTTL ERROR ROUTINES
00100 EDFLIN:
00200 ;;*FIX* OUTSTR [ASCIZ /
00300 ;;*FIX* ? Temporary file nnnSOS in use or protected!
00400 ;;*FIX* /]
00410 OUTSTR [ASCIZ \
00420 ? Temporary file nnnSOS - LOOKUP/ENTER error\] ;** FIX **
00490 IFE %SS061, <
00500 EXIT
00510 >; END OF IFE %SS061
00520 IFN %SS061, <
00530 JRST GOEXIT ;GO EXIT FROM SOS
00540 >; END OF IFN %SS061
00600
00700 NOTDKI:
00800 NOTDKO:
00900 NODSK:
01000 OUTSTR [ASCIZ /
01100 ? No DISK available. Please check the DISK you have requested/]
01190 IFE %SS061, <
01200 EXIT
01210 >; END OF IFE %SS061
01220 IFN %SS061, <
01230 JRST GOEXIT ;GO EXIT FROM SOS
01240 >; END OF IFN %SS061
01300
01400 NOFIL:
01500 OUTSTR [ASCIZ /
01600 ? File dissappeared -- LOSE BIG!/]
01690 IFE %SS061, <
01700 EXIT
01710 >; END OF IFE %SS061
01720 IFN %SS061, <
01730 JRST GOEXIT ;GO EXIT FROM SOS
01740 >; END OF IFN %SS061
01800
01900 BADPRV:
01990 IFE %SS006, <
02000 OUTSTR [ASCIZ /
02100 ? Cannot edit file with prot .GE. 400/]
02110 >; END OF IFE %SS006
02120 IFN %SS006, <
02130 OUTSTR [ASCIZ /
02140 ? Insufficient privileges to write file/]
02150 >; END OF IFN %SS006
02190 IFE %SS061, <
02200 EXIT
02210 >; END OF IFE %SS061
02220 IFN %SS061, <
02230 JRST GOEXIT ;GO EXIT FROM SOS
02240 >; END OF IFN %SS061
02300
02400 PDLOV: MOVEI T1,200000
02500 APRENB T1, ;RESET PDL HANDLING
02600 NERROR STC ;GRONK USER
00100 ; THE ERROR HANDLER & SPECIAL FILE OPERATIONS
00200
00300 ERRHD0: MOVEM T1,SVT1E ;SAVE T1 IN CASE OF RERROR
00400 LDB T1,[POINT 9,.JBUUO##,8]
00500 CAILE T1,MAXUUO ;CHECK LEGAL
00600 ERROR ILUUO
00700 XCT EDISP(T1) ;DO FUNCTION
00800 AOS ERRHD ;NON-SKIP MEANS SKIP
00900 MOVE T1,SVT1E ;RESTORE T1
01000 JRSTF @ERRHD ;RETURN
01100
01200 ERRCON: HRRZ T1,.JBUUO## ;PICK UP THE ERROR NUMBER
01300 SKIPE T1
01400 CAILE T1,NUMER
01500 ERROR ILUUO ;WRONG ERROR, CALL SELF
01600 TLNE FL2,INOPTF!INPARS ;TREAT OPTION FILE AS SPECIAL
01700 JRST OPTERR ;...
01800 MOVEM T1,SVERN ;SAVE FOR =ERROR COMMAND
01810 IFN %SS006, <
01820 PUSHJ P,CLRCTO ;CLEAR ^O (IF ON)
01830 MOVE T1,SVERN ;RESTORE THE ERROR NUMBER
01840 >; END OF IFN %SS006
01900 TRNE FL,EXTOG
02000 SKIPA T1,ETBL-1(T1) ;(NN ZERO ERRORS) GET MESSAGE
02100 MOVE T1,ETBL2-1(T1) ;GET LONG FORM
02200 OUTSTR @T1
02300 TRNN FL2,COMFLF ;IN COMMAND FILE?
02400 JRST ERRHD1 ;NO: SKIP OVER LINE PRINT
02500 OUTSTR COMESS ;MSG ADDRS
02600 ERRHD1: LDB T1,[POINT 9,.JBUUO##,8] ;GET UUO
02700 XCT ERND(T1) ;DO GOOD THING
02800 JRST @ERRHD ;RERROR WILL FALL THROUGH XCT AND RETURN
02900
03000 ERND: ERROR ILUUO ;(0) IS AN ERROR
03100 JRST LOSER ;(1) DIE
03200 JRST CKIND ;(2) CHECK IND FILE
03300 MOVE T1,SVT1E ;(3) RERROR- RESTORE T1
03400
03500 LOSER: ;HERE TO EXIT AFTER "ERROR" UUO
03510 IFN %SS031, <
03520 TLNE FL,COPFIL ;TEST FOR COPYING FROM ANOTHER FILE
03530 JRST CKIND ; YES, THEN TREAT AS "NERROR"
03540 >; END OF IFN %SS031
03550 OCRLF
03560 IFN %SS061, <
03570 PUSHJ P,RSTPDS ;RESET "DSKFUL" STATUS BEFORE EXITING
03580 >; END OF IFN %SS061
03600 EXIT 1,
03700 EXIT
03800
03890 IFE %SS012!%SS066, <
03900 CKIND: TRZ FL2,COMFLF ;CLR COMMAND FILE FLAG
03910 >; END OF IFE %SS012!%SS066
03920 IFN %SS012!%SS066, <
03930 CKIND: ;HERE ON 'NERROR' UUO
03940 >; END OF IFN %SS012!%SS066
04000 CLRBFI ;CLEAR OUT THINGS
04100 SETZM TTIBH+2
04110 IFN %SS012!%SS066, <
04120 CKIND1: PUSHJ P,CKCOMF ;CLEAR @-FILE STATUS, IF ON
04130 >; END OF IFN %SS012!%SS066
04200 TRZ FL2,SUPN ;...
04300 JRST COMND ;GO ON
04400
04500 EDISP: ERROR ILUUO ;(0) ILLEGAL
04600 JRST ERRCON ;(1) ERROR
04700 JRST ERRCON ;(2) NERROR
04800 JRST ERRCON ;(3) RERROR
04900 PUSHJ P,LKX ;(4) XLOOK
05000 PUSHJ P,ENX ;(5) XENTR
05100 PUSHJ P,RNX ;(6) XRENM
05200
05300 IFN %SS061, <
05400
05500 ; TERMINAL EXIT ROUTINE
05600
05700 GOEXIT: PUSHJ P,RSTPDS ;RESET "DSKFUL" STATUS
05800 PUSHJ P,DISINT ;CLEAR ^C TRAP BEFORE EXITING
05900 EXIT ;NOW EXIT
06000
06100 ; "DSKFUL" MANIPULATION ROUTINES RSTPDS - SET BACK TO INITIAL CONDITION
06200 ; SETPDS - SET "DSKFUL PAUSE"
06300
06400 RSTPDS: SKIPA T1,OLDPDS ;GET OLD "DSKFUL" STATUS & SKIP
06500 SETPDS: HRLZI T1,21 ;GET PARMS FOR "DSKFUL PAUSE"
06600 SETUUO T1, ;SET THE DSKFUL STATUS
06700 JFCL ; (IGNORE ERRORS)
06800 POPJ P, ;RETURN TO CALLER
06900 >; END OF IFN %SS061
07000
07100 SUBTTL CONTROL-C INTERCEPT CODE
00100 REENT: TLO FL2,RENTF ;ONLY IF ALLOWED
00200 POPJ P,
00300
00400 OPTERR: MOVE T1,SVT1E ;RESTORE T1
00500 POP P,0(P) ;UP A LEVEL
00600 POPJ P, ;AND GIVE ERROR RETURN
00700
00800 ;CONTROL C INTERCEPT HANDLERS
00900
01000 ;ENABLE INTERCEPT
01100
01200 ENBINT: MOVEI T1,CNCBLK
01300 MOVEM T1,.JBINT##
01400 SETOM CNCLOK ;CLEAR INTERLOCK FOR FIRST TIME
01500 MOVEI T1,CNCREN ;SET UP REENTER ADDRS
01600 MOVEM T1,.JBREN##
01700 POPJ P,
01800
01900 ;DISABLE INTERCEPT
02000
02100 DISINT: SETZM .JBINT##
02200 SETZM .JBREN##
02300 POPJ P,
02400
02500 ;INTERUPT HANDLER
02600
02700 CNCINT: AOSE CNCLOK ;TRYING TO RE-ENTER?
02800 JRST CNCAGN ;YES: SKIP OVER CODE
02900 PUSH P,CNCBLK+2 ;STASH PC FOR RETURN
03000 PUSH P,T1 ;SAVE A REG
03005 IFN %SS051, <
03010 MOVEI T1,COMND ;GET COMMAND-WAIT RETURN ADDRESS
03015 TRNE FL2,CMDWAT ;TEST FOR CMD-WAIT
03020 HRRM T1,-1(P) ; YES, GIVE ANOTHER RETURN ADDRESS
03025 >; END OF IFN %SS051
03030 IFN %SS006, <
03035 PUSHJ P,CLRCTO ;CLEAR ^O (IF ON)
03040 >; END OF IFN %SS006
03045 IFN %SS005, <
03050 GETSTS TTY,T1 ;GET CURRENT TTY STATUS
03055 TRNE T1,200 ;TEST FOR ECHO SUPPRESSED
03060 OUTSTR [ASCIZ /^C
03065 /] ; YES, TELL THE USER WHAT HE MISSED
03070 PUSH P,T1 ;SAVE OLD TTY STATUS
03075 ONECHO ; & TURN ON TTY ECHOING
03080 >; END OF IFN %SS005
03100 CNCAGN: HLRZ T1,CNCBLK+3 ;GET REASON
03200 CAIE T1,1B34 ;^C ONLY
03300 ERROR ICN
03400 SETZM CNCBLK+2 ;RE-ENABLE
03500 TLNE FL2,NORENT ;ARE WE DISABLED?
03600 JRST CNCREN ;YES: JUST RE-ENTER
03700 CNCIN0: OUTSTR [ASCIZ "Yes? "]
03800 TRNN FL,EXTOG
03900 OUTSTR [ASCIZ "(Type H for help): "]
04000 INCHRW T1 ;GET REPLY
04100 OCRLF
04200 CLRBFI ;CLEAR OUT TTY TYPE AHEAD
04300 ANDI T1,137 ;FORCE UPPER CASE
04400 CAIN T1,"H"
04500 JRST CNCHLP ;GIVE HELP
04600 CAIN T1,"C"
04700 JRST CNCCON ;CONTINUE
04800 CAIN T1,"M"
04900 JRST MONRET ;PUNT!
05000 CAIN T1,"E"
05100 JRST CNCXIT ;DO "E" COMMAND
05200 CAIN T1,"Q"
05300 JRST CNCQT ;DO "EQ" COMMAND
05400 CAIN T1,"R"
05500 JRST CNCREN ;DO LIKE REENTER
05600 CAIN T1,"D"
05700 SKIPN T1,.JBDDT##
05800 JRST CNCIN0 ;TRY AGAIN
05900 HRRZ T1,T1
06000 EXCH T1,0(P) ;STASH ON PDL
06100 POP P,0(P) ;AND PRUNE
06200 SETOM CNCLOK ;CLEAR INTERLOCK
06210 OUTSTR [ASCIZ /
06220 .DDT
06230 /] ;TELL THE USER WHAT'S UP ;** FIX **
06300 JRST @1(P) ;AND GO DEBUG
06400
06500 ;HERE TO DUMMY E CMD
06600
06700 CNCXIT: TLO FL2,DOENDF ;SET DO END REQUEST
06800 JRST CNCREN ;AND TREAT LIKE RE-ENTER
06900
07000 ;HERE TO DUMMY UP EQ
07100
07200 CNCQT: MOVEI T1,12 ;FAKE OUT SCANNER
07300 MOVEM T1,LIMBO
07400 SETOM CNCLOK ;CLEAR INTERLOCK
07500 JRST QUIT ;AND EXIT
07600
07700 CNCREN: SKIPGE CNCLOK ;IS THIS A "REE" CMD?
07800 JRSTF @.JBOPC## ;TRY THIS ONE
07805 IFN %SS005, <
07810 POP P,T1 ;GET OLD TTY STATUS
07815 SETSTS TTY,(T1) ; & RESTORE IT (MIGHT TURN OFF ECHOING)
07820 >; END OF IFN %SS005
07825 IFN %SS051, <
07830 HRRZ T1,-1(P) ;GET ^C TRAP USER PC
07835 CAIN T1,TTYINP ;TEST FOR TTY INPUT ROUTINE
07840 MOVEI T1,COMND ; YES, CONVERT TO COMMAND ROUTINE
07845 TLNN FL2,NORENT ;TEST FOR REENTER PERMITTED
07850 HRRM T1,-1(P) ; YES, CHANGE TTY INPUT TO COMMAND ROUTINE ADDR
07855 >; END OF IFN %SS051
07900 POP P,T1
08000 SETOM CNCLOK ;CLEAR INTERLOCK
08100 JRST REENT ;AND EXIT
08200
08300 ;ROUTINE TO CHECK IF WE HAVE REENTERED, SKIP RETURN IF NOT.
08400
08500 CHKREN: TLNN FL2,NORENT ;ALLOWED?
08600 TLZN FL2,RENTF ;YES: CHECK FLAG
08700 AOS (P) ;NO: SKIP RETURN
08800 POPJ P, ;NO SKIP IF WE DID
08900
09000 CNCCON: ;HERE TO CONTINUE AFTER ^C
09010 IFN %SS005, <
09020 POP P,T1 ;GET OLD TTY STATUS
09030 SETSTS TTY,(T1) ; & RESTORE IT (MIGHT TURN OFF ECHOING)
09040 >; END OF IFN %SS005
09050 POP P,T1 ;RESTORE T1
09100 SETOM CNCLOK ;CLEAR INTERLOCK
09200 POPJ P, ;AND CONTINUE
09300
09400 CNCHLP: OUTSTR CNCTXT
09500 SKIPE .JBDDT##
09600 OUTSTR [ASCIZ "D - transfer to DDT
09700 "]
09800 JRST CNCIN0
09900
10000 CNCTXT: ASCIZ "Type one of:
10100 C - To have SOS continue with current operation
10200 E - To end edit (like E command)
10300 Q - To quit (leave file in unedited state - like EQ command)
10400 M - Temporary return to Monitor
10500 R - To stop current operation & Return to next *
10600 " ;** FIX **
10700
10800 SUBTTL ERROR MESSAGES
00100 DEFINE ERMS (A)
00200 <IRP (A) <EXP [ASCIZ /
00300 A
00400 /]
00500 >>
00600
00700 ETBL: ERMS <?Internal confusion,?Device input error>
00800 ERMS <?Device output error,%ILC,?ILUUO,%LTL,%NLN,%NSP,%ORDER>
00900 ERMS <?Device not available,%ILR>
01000 ERMS <%WAR,%TMS,%STL,%ISS,%ILFMT,%NSG,%FNF,%DNA,%NEC,%IRS,%STC,%ITD>
01100 ERMS <%NNN,%SRF,?CMERR,%CMEND,%MAR,?Bad "BASIC" file format>
01110 IFN %SS026, <
01120 ERMS <%ISLN>
01130 >; END OF IFN %SS026
01140 IFN %SS074, <
01150 ERMS <%IRO>
01160 >; END OF IFN %SS074
01200 NUMER==.-ETBL
01300 ETBL2: ERMS <?Internal confusion,?Device input error>
01400 ERMS <?Device output error,%Illegal command,?Illegal UUO>
01500 ERMS <%Line too long>
01600 [ASCIZ /
01700 %No such line(s)
01800 /]
01900 ERMS <%No such page>
02000 ERMS <%Out of order,?Device no available,%Illegal replacement on insert>
02100 ERMS <%Wrap around,%Too many strings,%String too long>
02200 ERMS <%Illegal search string,%Illegal line format>
02300 ERMS <%No string given,%File not found,%DISK not available>
02400 ERMS <%Insufficient core available,%Illegal replacement string>
02500 ERMS <%Search string too complex,%Illegal transfer destination>
02600 ERMS <%No next line,%Search fails>
02700 ERMS <?Indirect read error,%Indirect EOF>
02800 ERMS <%Margin error,?Bad "BASIC" file format>
02810 IFN %SS026, <
02820 ERMS <%Illegal starting line number>
02830 >; END OF IFN %SS026
02840 IFN %SS074, <
02850 ERMS <%Illegal when READONLY>
02860 >; END OF IFN %SS074
02900 SUBTTL COMMAND DECODER
00100 ;HERE IS THE COMMAND DECODER AND DISPATCHER
00200
00300 COMND: SETZB JF,SAVCHR ;CLEAR SAVED CHAR & SPECIAL FLAG AC ;** FIX **
00400 SETZM SAVC ;CLEAR ANOTHER SAVED CHAR
00500 ONECHO ;TURN ECHO BACK ON JUST IN CASE
00600 SKIPN T1,TEMINC;TEMP INCR?
00700 MOVE T1,INCR ;NO: USE CURRENT ONE
00800 MOVEM T1,INCR ;YES: RESOTRE OLD ONE
00900 SETZM TEMINC ;CLEAR TEMP
01000 TLNE FL,SRCOP ;THIS CASE IS SPECIAL SINCE WE
01100 SKIPA P,COPDL ;SHOULD NOT DESTROY SAVED ITEMS
01200 MOVE P,[IOWD PDLSIZ,PDL] ;ALSO PDL (IN CASE OF ERRORS)
01300 TLZE FL2,DOENDF ;NEED END COMMAND?
01400 JRST CMDEND ;YES: GO DO IT
01500 TLNE FL,SRCOP
01600 JRST NOCPCK ;DO NOT GET OUT OF COPY MODE
01700 TLZE FL,ISCOP ;IN COPY MODE?
01800 JRST COPDON ;YES, DO SPECIAL CLEAR OUT
01900 NOCPCK:
01910 IFN %SS006, <
01920 TRNN FL2,COMFLF ;DON'T CLEAR ^O IF @-FILE
01930 >; END OF IFN %SS006
02000 ;;*FIX* SKPINL
02100 ;;*FIX* JFCL
02110 PUSHJ P,CLRCTO ;CLEAR ^O (IF ON) ;** FIX **
02120 IFN %SS006!%SS062, <
02130 TLO FL2,BELLF ;TURN ON BELLS-PERMITTED FLAG
02140 >; END OF IFN %SS006!%SS062
02150 IFN %SS005, <
02160 PUSHJ P,ENBINT ;ENABLE ^C TRAPS AGAIN
02170 >; END OF IFN %SS005
02200 TLZN FL2,NORENT ;NEED TO CHECK FOR REENTER
02300 JRST NORNCK ;NO:
02400 TLZE FL2,RENTF ;SEE IF NEED TO REENTER
02500 JRST [MOVEI T1,[TLZ FL2,RENTF
02600 JRST COMND]
02700 MOVEM T1,CNCBLK+2
02800 MOVEI T1,1B34
02900 HRLM T1,CNCBLK+3 ;FAKE OUT CNCINT
03000 JRST CNCINT]
03090 IFE %SS020, <
03100 NORNCK: TRNN FL,EXTOG ;SKIP THIS HACK IF IN EXPERT MODE
03200 SKIPN T1,DELCNT# ; OR IF NO DELETIONS
03300 JRST CMNDA
03400 MOVEI T3,OCHR ;SET UP FOR PRINTER
03500 PUSHJ P,DECPR ;PRINT # OF LINES DELETED
03600 PUSHJ P,FORCE ;DUMP IT
03700 OUTSTR [ASCIZ / Lines (/]
03800 MOVE T1,FDELLN# ;GET FIRST LINE DELETED
03900 MOVEM T1,LINOUT ;PRINT IT
04000 OUTSTR LINOUT
04100 MOVE T1,FDELPG#
04200 PUSHJ P,DECPR ;AND PAGE #
04300 PUSHJ P,FORCE
04400 MOVE T1,LDELLN# ;LAST LINE DELETED
04500 SKIPN PGDELS ;IF ANY PAGE MARKS DELETED
04600 CAME T1,FDELLN ;SAME AS FIRST?
04700 JRST [OUTCHR [":"] ;NO: PRINT IT ALSO
04800 SETZI T2,
04900 OUTSTR T1
05000 SKIPN T1,PGDELS
05100 JRST .+1
05200 ADD T1,FDELPG
05300 OUTCHR ["/"]
05400 PUSHJ P,DECPR
05500 PUSHJ P,FORCE
05600 JRST .+1]
05700 OUTSTR [ASCIZ /) deleted
05800 /]
05810 >; END OF IFE %SS020
05820 IFN %SS020, <
05830 NORNCK: PUSHJ P,DELRPT ;TYPE DELETED LINES (IF ANY)
05840 >; END OF IFN %SS020
05900 CMNDA: PUSHJ P,CMDSAV ;CHECK FOR AUTO-SAVE
06000 JRST CMND2 ;DO IT
06100 TRNE FL2,SUPN!COMFLF ;SUPPRESS * AFTER PRETTY PRINT
06200 JRST CMNDB
06300 TLNE FL,SRCOP ;GIVE XTRA PROMPT IF COPY
06400 OUTCHR ["C"]
06500 OUTCHR ["*"]
06600 CMNDB: TRZ FL2,SVIT!SUPN!IFN %SS057,<INVFGS>!IFN %SS063,<SPNRQT> ;TURN OFF SOME BITS
06610 IFN %SS051, <
06620 TROE FL2,CMDWAT ;SET CMD-WAIT & TEST FOR PREVIOUS
06630 JRST CMND1 ; SUBSEQ. TIME, SKIP THE CMD INCREMENT
06640 >; END OF IFN %SS051
06700 IFN EXTEND,<
06800 MOVEI T1,LSNUM ;RESET LINE SEARCH STRINGS
06900 MOVEM T1,LSBUFN
07000 >
07100 TRNN FL2,COMFLF ;COMMAND FILE?
07200 JRST CMND1 ;NO
07300 MOVE T2,[ASCII /00001/] ;INCREMENT CMD CNT
07400 MOVE T1,COMCNT
07500 PUSHJ P,ASCIAD ;ASCII ADDDER
07600 MOVEM T1,COMCNT ;STORE
07700 CMND1: PUSHJ P,GNCH ;READ A CHARACTER
07800 TLZ FL2,RENTF ;CLEAR FLAG - HE MAY TRY TO REENTER
07900 CAIE C,15
08000 JUMPE CS,CMND1 ;IGNORE SPACES ETC
08010 IFN %SS051, <
08020 TRZ FL2,CMDWAT ;CLEAR COMMAND-WAIT NOW
08030 >; END OF IFN %SS051
08100 TLNE CS,LETF_16 ;CHECK TO SEE IF LETTER
08200 TRZ C,40 ;AND CONVERT TO UPPER CASE
08210 IFN %SS032, <
08220 SKIPE T1,CURCMD ;GET CURRENT COMMAND & TEST IT
08230 MOVEM T1,LSTCMD ; NON-ZERO, STORE AS LAST COMMAND
08240 MOVEM C,CURCMD ;STORE AS CURRENT COMMAND
08250 >; END OF IFE %SS032
08300 CMND2: MOVSI T1,-CMDLG ;GET LENGTH OF COMMAND TABLE
08400 CAME C,CMD1(T1) ;COMPARE
08500 AOBJN T1,.-1 ;CHECK FOR MATCH
08590 IFE %SS020, <
08600 SETZM DELCNT
08700 SETZM LDELLN
08800 SETZM FDELLN
08900 SETZM FDELPG ;INIT DELETE CNTS
08910 >; END OF IFE %SS020
08920 IFN %SS020, <
08930 PUSHJ P,DELCLR ;CLEAR THE DELETE COUNTERS
08940 >; END OF IFN %SS020
08990 IFE %SS074, <
09000 JUMPL T1,@CMD2(T1) ;DISPATCH IF FOUND
09005 >; END OF IFE %SS074
09010 IFN %SS074, <
09015 JUMPGE T1,CMNDE ;JUMP IF COMMAND ERROR
09020 SKIPGE T1,CMD2(T1) ;GET DISPATCH ADDR & TEST FOR /READ ERROR
09025 TRNN FL,READOF ;TEST FOR /READONLY
09030 JRST (T1) ; GO IF PERMITTED OR NOT /READONLY
09035 NERROR IRO ; "ILLEGAL IF READONLY"
09040 CMNDE: ;TO HERE FOR UNRECOGNIZED COMMAND
09045 >; END OF IFN %SS074
09050 IFN %SS032, <
09055 SETZM CURCMD ;CLEAR CURRENT COMMAND IF ERROR
09060 >; END OF IFN %SS032
09100 NERROR ILC ;ELSE ERROR
09200
09300 CMD1: EXP "P",15,"E","I","D","M","N","H","/"
09400 EXP "A","_","=","L","R","F",12,200,"C","S"
09500 EXP "G","X","J","T","W","@","Q","K","."
09510 IFN %SS001, <
09520 EXP "B"
09530 >; END OF IFN %SS001
09540 IFN %SS045, <
09550 EXP ";"
09560 >; END OF IFN %SS045
09570 IFN %SS057, <
09580 EXP "V"
09590 >; END OF IFN %SS057
09600 CMDLG==.-CMD1
09700 CMD2: EXP PRINT,NULCMD,ENDIT,<IFN %SS074,<(1B0)>,,INSERT>
09750 EXP <IFN %SS074,<(1B0)>,,DELETE>,<IFN %SS074,<(1B0)>,,MARK>,<IFN %SS074,<(1B0)>,,NUMBER>
09800 EXP HELP,SET,ALTER,SET,GIVE,LIST,<IFN %SS074,<(1B0)>,,REPLAC>,SEARCH
09900 EXP NXTLIN,BAKLIN,<IFN %SS074,<(1B0)>,,COPY>,<IFN %SS074,<(1B0)>,,SUBST>
09950 EXP GEND,<IFN %SS074,<(1B0)>,,XPAND>,<IFN %SS074,<(1B0)>,,JUST>
10000 EXP <IFN %SS074,<(1B0)>,,TRANS>,<IFN %SS074,<(1B0)>,,SVCOD>,COMFIL
10005 EXP QCOM,<IFN %SS074,<(1B0)>,,KILL>,MOVE
10010 IFN %SS001, <
10020 EXP BEGINN
10030 >; END OF IFN %SS001
10040 IFN %SS045, <
10050 EXP COMMNT
10060 >; END OF IFN %SS045
10070 IFN %SS057, <
10080 EXP <IFN %SS074,<(1B0)>,,INVERT>
10090 >; END OF IFN %SS057
10100
10200 ;COME HERE TO DO AUTO SAVE
10300
10400 CMDSAV: TRNE FL,READOF ;CHECK RO
10500 JRST CPOPJ1 ;YES - SKIP THIS
10600 TLZE FL2,CCHGF ;DID THIS COMMAND CHANGE THINGS?
10700 SOSE SAVEN ;YES -- COUNT DOWN
10800 JRST CPOPJ1 ;STILL OK
10810 IFN %SS024, <
10820 TRNE FL,EXTOG ;CHECK FOR EXPERT
10830 OUTSTR [ASCIZ "[Saving]"] ; YES, TYPE SHORT MESSAGE
10840 TRNN FL,EXTOG ;CHECK FOR NON-EXPERT
10850 >; END OF IFN %SS024
10900 OUTSTR [ASCIZ "[Doing auto-save, please wait.]"]
11000 OCRLF
11100 MOVEI C,"W" ;FUDGE UP W COMMAND
11200 MOVEI T1,12 ;FUDGE UP LINE TERM
11300 MOVEM T1,LIMBO
11400 POPJ P, ;PROCESS COMMAND
11500
11600 NULCMD: PUSHJ P,GNCH ;GRNTEE LF AFTER CR COMMAND
11700 CAIE C,12 ;IS IT?
11800 NERROR ILC ;NO: LOSE
11900 JRST COMND ;YES: WIN
12000
12100 CMDEND: MOVEI C,"E" ;DUMMY CMD
12200 TLZ FL2,RENTF ;CLR FLAG
12300 MOVEI T1,12
12400 TLNN FL,SRCOP ;NEED DUMMY LF IF NOT COPY
12500 MOVEM T1,LIMBO
12600 JRST CMND2 ;PROCESS
12700
12800 ; TERMINAL MANIPULATION ROUTINES (CLEAR ^O & TYPE-AHEAD) ;** FIX **
12900
13000 CLRCTT: CLRBFI ;CLEAR TYPE-AHEAD ;** FIX **
13100 CLRCTO: MOVE T1,[2,,TTYPRM] ;POINT AT TRMOP. PARMS ;** FIX **
13200 TRMOP. T1, ;TEST FOR OUTPUT DONE ;** FIX **
13300 JRST CLRCTX ; YES, JUMP ;** FIX **
13400 SETZ T1, ;REQUEST MINIMUM SLEEP TIME ;** FIX **
13500 SLEEP T1, ;SLEEP FOR A WHILE ;** FIX **
13600 JRST CLRCTO ; & REPEAT ;** FIX **
13700 CLRCTX: SKPINL ;CLEAR ^O (IF ON) ;** FIX **
13800 JFCL ; (JUST IN CASE) ;** FIX **
13900 POPJ P, ;RETURN TO CALLER ;** FIX **
14000
14100
14200 PAGE
14300 SUBTTL INVERT COMMANDS
14400
14500 IFN %SS057, <
14600
14700 INVERT: ;HERE FOR STANFORD CASE-INVERSION CMDS
14800 IFE %SS074, <
14900 TRNE FL,READOF ;TEST FOR READ-ONLY
15000 NERROR ILC ; YES, ILLEGAL CMD
15100 >; END OF IFE %SS074
15200 TRO FL2,INVFL ;SHOW INVERT COMMAND
15300 PUSHJ P,GNCH ;GET NEXT CHARACTER
15400 TLNE CS,LETF_16 ;TEST FOR A LETTER
15500 TRZ C,40 ; YES, CONVERT TO UPPER CASE
15600 CAIN C,"U" ;TEST FOR UPPER CASE
15700 TROA FL2,INVUP ; YES, SET BIT & SKIP
15800 CAIN C,"L" ;TEST FOR LOWER CASE
15900 TROA FL2,INVFRC ; YES, SET BIT & SKIP
16000 CAIN C,"V" ;TEST FOR PURE INVERSION
16100 JRST PRINT ; YES, JUMP IF ANY VALID COMMAND
16200 NERROR ILC ; OTHERWISE ERROR
16300
16400 >; END OF IFN %SS057
00090 IFE %SS033, <
00100 MOVE: SETZM LOLN
00200 PUSHJ P,GET1S ;GET A POS.
00300 TRNE FL,TERMF ;CHECK ARG
00400 SKIPN HILN
00500 NERROR ILC
00510 >; END OF IFE %SS033
00520 IFN %SS033, <
00530 MOVE: SETZM HILN ;CLEAR TARGET LINE #
00540 PUSHJ P,GET1S ;GET A LINE #
00550 TRNN FL,TERMF ;CHECK FOR END OF LINE
00560 NERROR ILC ; NO, ERROR
00570 >; END OF IFN %SS033
00600 MOVE T1,HIPG
00700 MOVEM T1,DPG
00800 MOVE SINDEX,HILN ;PERFORM SEARCH
00900 PUSHJ P,FIND
01000 MOVE T2,CPG ;FIND THE ONE WE WANT
01100 CAME T2,HIPG
01200 NERROR NSP
01290 IFE %SS033, <
01300 CAME T1,HILN
01400 NERROR NLN
01405 >; END OF IFE %SS033
01410 IFN %SS033, <
01415 SKIPE T1 ;TEST FOR EOF
01420 CAMN T1,PGMK ;TEST FOR P/M
01425 SKIPA T1,TECFST ; EOF OR P/M, GET 'START' (DEFAULT 1ST LINE #) & SKIP
01430 JRST MOVEIT ; NOT EOF OR P/M, JUMP
01435 SKIPE HILN ;TEST FOR LINE # SPECIFIED
01440 NERROR NLN ; YES, LINE # TOO BIG FOR THAT PAGE, ERROR
01445 MOVEIT: ;HERE TO SET A NEW CURRENT POSITION
01450 >; END OF IFN %SS033
01500 MOVEM T1,CLN ;MAKE IT CURRENT
01600 MOVEM T2,CPGL
01700 JRST COMND
01800
01900 HELP: PUSHJ P,SCAN ;CHECK FOR VALID TERM
01910 TRNE FL,IDF ;TEST FOR AN IDENTIFIER (AS IN "HELP");** FIX **
01920 PUSHJ P,SCAN ; YES, SCAN AGAIN ;** FIX **
02000 TRNN FL,TERMF
02100 NERROR ILC
02200 HRROI T1,.GTPRG ;GET NAME OF THIS PROG
02300 GETTAB T1,
02400 MOVSI T1,'SOS' ;USE DEFAULT IF NECESSARY
02500 PUSH P,.JBFF## ;PLACE FOR BUFFER IS NEEDED
02600 HRRZ T2,.JBREL## ;USE TOP OF CORE
02700 ADDI T2,1
02800 MOVEM T2,.JBFF## ;...
02900 PUSHJ P,.HELPR## ;CALL CONKLINS CROCK
03000 POP P,.JBFF## ;RESTORE OLD FF
03100 JRST COMND ;RETURN TO DO USEFUL THINGS
03200
03300 PAGE
03400 SUBTTL "B", "BP", & ";" COMMANDS
03500
03600 IFN %SS001, <
03700
03800 BEGINN: PUSHJ P,SCAN ;SCAN FOR NEXT ATOM
03900 TRNE FL,TERMF ;TEST FOR TERMINATOR
04000 JRST BEGIN1 ; YES, JUMP FOR "B" CMD
04100 MOVS T1,ACCUM ;GET THE NEXT ATOM
04200 TRNE FL,IDF ;TEST FOR IDENTIFIER
04300 CAIE T1,'P ' ;TEST FOR "BP" COMMAND
04400 NERROR ILC ; ERROR IF NOT "BP"
04500 PUSHJ P,SCAN ;NOW FIND OUT WHAT FOLLOWS
04600 SKIPA T1,CPGL ;"BP" MEANS CURRENT PAGE
04700 BEGIN1: MOVEI T1,1 ;"B" MEANS PAGE 1
04800 MOVEM T1,HIPG ;STORE AS DESIRED PAGE
04900 MOVEM T1,DPG ; DITTO
05000 TRNN FL,TERMF ;TEST FOR END OF LINE
05100 NERROR ILC ; NO, ERROR
05200 SETZ SINDEX, ;REQUEST 1ST LINE ON THE PAGE
05300 PUSHJ P,FIND ;FIND THE LINE
05600 MOVE T2,CPG ;GET ACTUAL CURRENT PAGE
05700 CAME T2,HIPG ;TEST FOR PAGE FOUND
05800 NERROR NSP ; NO, ERROR
05900 MOVEM T2,CPGL ;STORE AS CURRENT PAGE
05920 SKIPE T1 ;TEST FOR EOF
05940 CAMN T1,PGMK ;TEST FOR PAGE MARK
06000 MOVE T1,TECFST ; YES, SET TO STARTING LINE #
06100 MOVEM T1,CLN ;STORE AS CURRENT LINE
06200 JRST COMND ;CONTINUE ON
06300 >; END OF IFN %SS001
06400
06500 IFN %SS045, <
06600
06700 COMMNT: PUSHJ P,GNCH ;GET THE NEXT CHARACTER
06800 TLNN CS,TERM_16 ;TEST FOR TERMINATOR
06900 JRST COMMNT ; NO, CONTINUE READING
07000 JRST COMND ; YES, GET NEXT COMMAND
07100 >; END OF IFN %SS045
07200
07300 SUBTTL PRINT
00100 ;PRINT LINES SPECIFIED
00200
00300 PRINT: SETZM LOLN ;AS A FLAG IN CASE OF /C OR /A,/C
00400 ;;*FIX* TRZ FL2,SUPN
00500 IFN PPNTSW,<
00600 ;*FIX* MOVEI JF,0 ;CLEAR SPECIAL FLAGS ;** FIX **
00700 MOVEI T2,1
00800 MOVEM T2,LSTCNT
00900 SETZM LOGPG ;CLEAR COUNTERS AND THINGS
01000 >
01100 PUSHJ P,SCAN
01200 CAIE C,"," ;IS THERE A SWITCH?
01300 JRST PRNT5 ;NO
01400 PUSHJ P,PRNSCN ;SCAN FOR SWITCHES
01500 PRNT5: TRNE FL,TERMF
01600 JRST [ ;MAKE P WITH NO ARGS DO P.!<PLINES>
01605 IFN %SS057, <
01610 TRZE FL2,INVFGS ;TEST FOR INVERSION FLAGS
01615 NERROR ILC ; YES, ERROR (ARGS REQ'D)
01620 >; END OF IFN %SS057
01625 IFN %SS032, <
01630 HRROI T1,"P" ;GET -1,,"P"
01635 CAMN T1,LSTCMD ;CHECK FOR SUCCESSIVE "P<CR>" CMDS
01640 TRO JF,JPER ; YES, SET A FLAG
01645 HRROS CURCMD ;SET CURRENT CMD TO -1,,"P"
01650 >; END OF IFN %SS032
01655 MOVE T1,CLN ;GET CURRENT LINE
01700 MOVEM T1,LOLN
01800 MOVE T1,CPGL
01900 MOVEM T1,LOPG
02000 MOVE T1,PLINES
02100 MOVEM T1,SVCNT
02200 TRO FL,CNTF
02300 TRNE FL,DPYF
02400 OUTSTR [BYTE (7)32,177,177,177]
02500 JRST PRCNT]
02600 PUSHJ P,GET2 ;GET A DOUBLE STRING
02700 CAIE C,"," ;I{S THERE A SWITCH?
02800 JRST PRNT6 ;NO
02900 PUSHJ P,PRNSCN ;YES, LOOK AT THEM
03000 PRNT6: TRNN FL,TERMF ;DID IT END WITH A TERMINATOR
03100 NERROR ILC ;NO, ILLEGAL
03200 PRCNT: TRZ FL,LINSN ;USE THIS AS A FLAG TO CHECK FOR NULL RANGE
03300 TRNE FL2,NONUMF ;NEED TO SUPPRESS NUMBERS
03400 TRO FL2,SUPN ;YES:
03500 IFN PPNTSW,<
03600 TRNE JF,EJECT!WAIT
03700 PUSHJ P,PGWT ;WAIT FOR USER!
03800 >
03900 RPGPRN: MOVE T1,LOPG ;FIND THE FIRST LINE WANTED
04000 MOVEM T1,DPG ;SET IT AS THE ONE WE WANT
04100 MOVE SINDEX,LOLN ;PICK UP THE LINE
04200 PUSHJ P,FIND ;GO GET IT
04210 IFN %SS032, <
04220 TRZE JF,JPER ;TEST FOR SUCCESSIVE "P<CR>" CMDS
04230 PUSHJ P,FINDN ; YES, FIND THE NEXT LINE
04240 >; END OF IFN %SS032
04300 SKIPE LOLN ;DID WE WANT TO PRINT AN ENTIRE PAGE
04400 JRST PRNT1 ;NO, GO CHECK BOUNDS
04500 MOVE T2,CPG ;WHICH ONE ARE WE ON
04600 MOVEM T2,CPGL
04700 TRNN FL2,SUPN
04800 PUSHJ P,PGPRN ;PRINT THE PAGE HEADER
04900 TRO FL,LINSN ;THIS CAN COUNT AS A LINE
05000 PRNT1: PUSHJ P,ONMOV ;CHECK TO SEE IF STILL IN RANGE
05100 JRST EPRNT ;NO, END
05200 TRO FL,LINSN ;WE HAVE SEEN ONE
05300 CAMN T1,PGMK ;IS IT A PAGE MARK?
05400 JRST PRNT3 ;YES, DO SOMETHING SPECIAL
05500 MOVEM T1,CLN
05600 MOVEM T2,CPGL ;SAVE PAGE TOO
05700 MOVE T1,PNTR ;GET THE POINTER TO IT
05800 PUSHJ P,OUTLIN ;AND PRINT
05900 IFN PPNTSW,<
06000 AOSN LSTCNT
06100 PUSHJ P,PAGEND ;END OF PAGE
06200 >
06300 PRNT4: PUSHJ P,FINDN ;GET THE NEXT LINE
06400 JRST PRNT1 ;AND CONTINUE
06500 PRNT3: MOVEM T2,CPGL
06600 IFN PPNTSW,<
06700 SOS LSTCNT ;ADJUST FOR PAGE MARK
06800 PUSHJ P,PAGEND ;DO END OF PAGE ROUTINE
06900 SETZM LOGPG ;RESET LOGICAL PAGE COUNTER
07000 >
07100 TRNE FL2,NONUMF ;SPECIAL HACK IF NONUM MODE
07200 OUTCHR [14] ;WON'T HE BE ...
07300 TRNN FL2,SUPN ;UNLESS PRINTING A CLEAN COPY,
07400 PUSHJ P,PGPRN ;GO PRINT A PAGE HEADER
07500 AOS CPG
07600 MOVE T2,[<ASCII /00000/>!1]
07700 MOVEM T2,CLN ;SET LINE TO FIRST ON THAT PAGE
07800 JRST PRNT4 ;AND CONTINUE
07900 EPRNT: TRZN FL,LINSN ;DID WE PRINT SOMETHING
08000 NERROR NLN ;NO, ERROR
08100 IFN PPNTSW,<
08200 PUSHJ P,PAGEJT ;EJECT PAGE
08300 >
08390 IFE %SS063, <
08400 TRNE FL2,NONUMF
08410 >; END OF IFE %SS063
08420 IFN %SS063, <
08430 TRNN FL2,SPNRQT ;TEST FOR ",S" REQUEST
08440 ; IF SO, DON'T CLEAR 'SUPN' YET
08450 ; TO INHIBIT "*"
08460 >; END OF IFN %SS063
08500 TRZ FL2,SUPN ;TURN IT OFF IF IN NONUM MODE
08600 JRST COMND ;YES, RETURN FOR COMMAND
08700
08800
08900
09000 ;CHECK TO SEE IF OUT OF LIMITS SKIP RETURN IF OK
09100 ONMOV: JUMPE T1,CPOPJ ;0, MUST BE EOF SO ALL DONE
09200 PUSHJ P,CHKREN ;CHECK REENTER
09300 POPJ P, ;YES: SAY WE ARE THROUGH
09400 ONMOV1: MOVE T2,CPG ;GET THE CURRENT PAGE
09500 CAMN T1,PGMK ;ARE WE AT A PAGE MARK?
09600 ADDI T2,1 ;YES, TREAT AS NEXT PAGE
09700 TRNE FL,CNTF ;IS THIS A ! TYPE COMMAND?
09800 JRST ONCNT
09900 CAMLE T2,HIPG ;HOW DOES IT COMPAGE WITH UPPER LIMIT
10000 POPJ P, ;HIGHER, ALL DONE
10100 CAME T1,PGMK ;IF PAGE MARK, DO NOT COMPARE LINE
10200 CAME T2,HIPG ;OR IF NOT ON LAST PAGE
10300 SKIPA
10400 CAMG T1,HILN ;ARE WE OUT OF LINES?
10500 AOS (P) ;SKIP RETURN ALL OK
10600 POPJ P, ;GO
10700
10800 ONCNT: CAMN T1,PGMK ;DO NOT COUNT PAGE MARKS
10900 SKIPG SVCNT ;IF PAGE MARK, GIVE UP IF DONE
11000 SOSL SVCNT ;ARE WE OUT
11100 AOS (P) ;SKIP RETURN FOR OK
11200 POPJ P,
00100 ;HERE TO EJECT PAGE
00200
00300 IFN PPNTSW,<
00400 PAGEJT: TRNN JF,EJECT ;EJECTING?
00500 POPJ P, ;NO: JUST RETURN
00600 MOVE T5,LSTCNT
00700 ADD T5,PAGESZ ;GET COUNT LEFT
00800 SUBI T5,FULLPG ;EJECT TO TOP OF PAGE
00900 TRNN JF,WAIT ;IF NOT WAITING
01000 SUBI T5,1 ;ONE MORE LINE
01100 SUBI T5,1 ;HANDLE ZERO CASE
01200 MOVEI C,15 ;PUT OUT CR
01300 PUSHJ P,OCHR
01400 JRST PUTLN1
01500
01600 PUTLN: MOVEI C,12
01700 PUSHJ P,OCHR ;OUTPUT LF'S
01800 PUTLN1: CAMN T5,[-11] ;A BIT WEIRD
01900 PUSHJ P,PUTPG
02000 AOJL T5,PUTLN
02100 AOS LOGPG ;INCR LOGICAL PAGE
02200 PUSHJ P,FORCE ;OUTPUT
02300 POPJ P,
02400
02500 ;HERE TO WAIT FOR BOTTOM OF PAGE
02600
02700 PAGEWT: TRNN JF,WAIT ;WAITING?
02800 JRST NOWAIT ;NOPE!
02900 PGWT:
03000 OUTSTR [BYTE (7)10,10,10,10,0]
03100 READ1: PUSHJ P,GNCH ;GET NEXT CHAR
03200 CAIE C,"G"
03300 CAIN C,"g"
03400 TRZ JF,WAIT
03500 CAIE C,"Q"
03600 CAIN C,"q"
03700 JRST QPRINT
03800 CAIE C,12 ;LF?
03900 JRST READ1
04000 NOWAIT: MOVN T5,PAGESZ ;RESET LINE COUNT
04100 MOVEM T5,LSTCNT
04200 POPJ P,
04300
04400 QPRINT: PUSHJ P,GNCH
04500 CAIE C,12 ;SKIP TO LF
04600 JRST QPRINT
04700 JRST COMND
04800 ;;;; STILL IN IFN PPNTSW
00100 ;HERE ON END OF PAGE
00200
00300 PAGEND: PUSHJ P,PAGEJT ;EJECT A PAGE
00400 JRST PAGEWT ;AND GO WAIT
00500
00600 ;ROUTINE TO OUTPUT FUNNY PAGE NUMBERS
00700
00800 PUTPG: TRNN JF,PGNOS ;ARE WE?
00900 POPJ P,
01000 MOVE T1,RMAR
01100 ADD T1,LMAR
01200 ASH T1,-1 ;PUT OUT (R+L)/2 BLANKS
01300 PUTPG1:
01400 OUTCHR [" "]
01500 SOJG T1,PUTPG1
01600 OUTCHR ["-"]
01700 MOVE T2,CPG ;CURRENT PAGE
01800 PUSHJ P,DPRNT
01900 MOVE T2,LOGPG ;LOGICAL PAGE
02000 JUMPE T2,PUTPG2
02100 OUTCHR ["."]
02200 PUSHJ P,DPRNT ;SUB-PAGE
02300 PUTPG2:
02400 OUTSTR [BYTE (7)"-",15]
02500 POPJ P,
02600 > ;;; END IFN PPNTSW
00100 ;PRINT SWITCH SCANNER
00200
00250 IFE %SS042, <
00300 IFN PPNTSW,<
00400 PRNSCN: PUSHJ P,SCAN ;GET NEXT CHAR
00500 MOVS T1,ACCUM
00600 CAIN T1,(<SIXBIT /N />)
00700 TRO JF,PGNOS
00800 CAIN T1,(<SIXBIT /S />)
00900 TRO FL2,SUPN!IFN %SS063,<SPNRQT>
01000 CAIN T1,(<SIXBIT /W />)
01100 TRO JF,WAIT
01200 CAIN T1,(<SIXBIT /E />)
01300 TRO JF,EJECT
01400 CAIN T1,(<SIXBIT /F />)
01500 JRST [TRO JF,EJECT!WAIT
01600 TRO FL2,SUPN!IFN %SS063,<SPNRQT>
01700 JRST .+1]
01800 PUSHJ P,SCAN ;SCAN PAST IT
01900 TRNE FL,TERMF ;TERMINATOR
02000 JRST [TRNN JF,EJECT!WAIT!PGNOS
02100 TRNE FL2,SUPN
02200 POPJ P,
02300 NERROR ILC]
02400 CAIE C,"," ;MORE?
02500 NERROR ILC
02600 JRST PRNSCN ;YES - GET EM
02700 >
02800
02900 IFE PPNTSW,<
03000 PRNSCN: PUSHJ P,SCAN ;GET NEXT ATOM
03100 MOVS T1,ACCUM
03200 CAIE T1,(<SIXBIT /S />)
03300 NERROR ILC ;ONLY LEGAL SW IS S
03400 PUSHJ P,SCAN ;SCAN PAST IT
03500 TRNN FL,TERMF ;MUST BE END
03600 NERROR ILC
03700 TRO FL2,SUPN!IFN %SS063,<SPNRQT> ;SET FLAG
03800 POPJ P, ;RETURN
03900 >
04000 >; END OF IFE %SS042
04100
04200 IFN %SS042, <
04300
04400 PRNSCN: MOVEI SINDEX,[ ;POINT AT PARAMETER LIST
04600 SIXBIT /S/
04700 TRO FL2,SUPN!IFN %SS063,<SPNRQT>
04800 IFN PPNTSW, <
04900 SIXBIT /N/
05000 TRO JF,PGNOS
05100 SIXBIT /W/
05200 TRO JF,WAIT
05300 SIXBIT /E/
05400 TRO JF,EJECT
05500 SIXBIT /F/
05600 PUSHJ P,[
05700 TRO JF,EJECT!WAIT
05800 TRO FL2,SUPN!IFN %SS063,<SPNRQT>
05900 POPJ P,]
06000 >; END OF IFN PNTSW
06100 EXP 0]
06200 JRST SCNMOD ;JUMP TO SCAN FOR MODIFIERS & RETURN TO CALLER
06600 >; END OF IFN %SS042
00100 PGPRN: ;HERE TO PRINT A PAGE NUMBER ;** FIX **
00110 IFN PPNTSW, < ;** FIX **
00120 TRNE JF,PGNOS ;TEST FOR BOTTOM NUMBERING ;** FIX **
00130 POPJ P, ; YES, THEN NOT AT TOP, TOO ;** FIX **
00140 >; END OF IFN PPNTSW ;** FIX **
00150 TRNN FL,DPYF ;CHECK DPY MODE ;** FIX **
00200 OCRLF
00300 OUTSTR [ASCIZ /Page /]
00400 PUSHJ P,DPRNT ;PRINT THE NUMBER IN T2
00500 OCRLF
00550 TRNN FL,DPYF ;ONLY COUNT ONCE IF DPY MODE ;** FIX **
00600 AOS LSTCNT
00700 AOS LSTCNT ;PAGE N - TAKES 2 LINES
00800 POPJ P,
00900
01000 ;THE USUAL NUMBER PRINTER
01100
01200 DPRNT: JUMPGE T2,DPRNT0 ;OK IF NOT NEG.
01300 MOVN T2,T2 ;ELSE MAKE POSITIVE
01400 OUTCHR ["-"] ;AND OUTPUT A MINUS
01500 DPRNT0: IDIVI T2,^D10
01600 HRLM T3,(P)
01700 SKIPE T2
01800 PUSHJ P,DPRNT0
01900 HLRZ C,(P)
02000 ADDI C,"0"
02100 OUTCHR C
02200 POPJ P,
02300
02400
02500 ;CHARACTER OUTPUT
02600
02700 OCHR: JUMPE C,CPOPJ ;IGNORE NULLS
02800 MOVE CS,CTBL(C) ;GET THE MAJIC BITS
02890 IFE %SS010, <
02900 TLNE CS,LETF_16 ;CHECK FOR LETTER
03000 TDC C,CASEBT ;AND CHANGE CASE AS NECESSARY
03010 >; END OF IFE %SS010
03100 TRNE FL2,SUPN ;IS THIS A PRETTY PRINT? IF SO NO ' CONVERSION
03200 JRST OCH2
03300 PUSH P,C ;SAVE THE CHARACTER
03350 IFE %SS010, <
03360 IFN %SS025, <
03370 CAME C,CHR128 ;TEST FOR _C128 SPECIAL CHARACTER
03380 ; IF SO, ALWAYS TRANSLATES TO [SELF]
03390 >; END OF IFN %SS025
03400 LDB C,[POINT 7,CTBL(C),10] ;GET PRINT EQUIV.
03500 JUMPE C,OCH1 ;NONE, PRINT ORIGINAL
03510 >; END OF IFE %SS010
03600 TDNE CS,[XWD LETF_16,M37] ;IS THIS A LETTER OR SPECIAL
03700 TRNN FL,M37F ;AND A MODEL 37
03800 TLNE FL,QMODF
03900 JRST [MOVE C,(P) ;GET ORIG CHAR
03910 IFN %SS010, <
03920 TLNE CS,(<BYTE(4)0(7)-1,0>) ;SKIP IF NON-FOLDABLE CHAR
03930 >; END OF IFN %SS010
04000 CAIL C,40 ;CHECK FOR CONTROL CHAR
04100 JRST OCH1 ;NO - JUST PRINT IT
04200 ADDI C,100
04300 MOVEM C,(P) ;CONVERT TO PRINTING CHAR
04400 MOVEI C,"^"
04500 JRST OCH0]
04505 IFN %SS010, <
04510 TLNE CS,LETF_16 ;TEST FOR A LETTER
04515 TDC C,CASEBT ; YES, INVERT THE CASE
04520 MOVEM C,(P) ;STORE THE CHAR NOW
04525 IFN %SS025, <
04530 CAME C,CHR128 ;TEST FOR _C128 SPECIAL CHARACTER
04535 ; IF SO, ALWAYS TRANSLATES TO [SELF]
04540 >; END OF IFN %SS025
04545 LDB C,[POINT 7,CTBL(C),10] ;GET THE C128 TRANSLATION
04550 JUMPE C,OCH1 ; NONE, JUMP
04555 >; END OF IFN %SS010
04600 MOVEM C,(P) ;SAVE IN STACK
04690 IFE %SS025, <
04700 MOVEI C,"'"
04710 >; END OF IFE %SS025
04720 IFN %SS025, <
04730 MOVE C,CHR128 ;GET _C128 SPECIAL CHARACTER
04740 >; END OF IFN %SS025
04800 OCH0: PUSHJ P,OCH2 ;PUT OUT CHR
04900 OCH1: POP P,C ;GET CHAR TO PRINT
05000 OCH2: SOSG TTOCNT
05100 PUSHJ P,FORCE
05200 IDPB C,TTOPNT
05300 POPJ P, ;AND RETURN
05400
05500
05600
05700 OUTLIN: TRNE FL2,SUPN!NONUMF ;ARE WE SUPPRESSING LINE NUMBERS?
05800 AOS T1 ;YES, SKIP IT
05900 HRLI T1,(<POINT 7,0>);GET SET TO PRINT A LINE
06000 TRNE FL2,SUPN!NONUMF ;IF SUPPRESSING LINE NUMBERS
06100 IBP T1 ;ALSO SUPPRESS THE TAB WHICH FOLLOWS
06105 IFN %SS021, <
06110 MOVE C,1(T1) ;GET 1ST TEXT LINE FROM THE BUFFER
06115 TRNN FL2,SUPN!NONUMF ; TEST FOR SUPPRESSING SEQ #
06120 CAME C,[BYTE (7) 11,15,12,0,0] ;TEST FOR NULL LINE
06125 JRST OUTL1 ; JUMP IF LINE # SUPPRESSED OR NOT NULL
06130 MOVE T1,(T1) ;GET SEQUENCE NUMBER
06135 OUNTSN: MOVEM T1,SQTBUF ;STORE IN SPECIAL BUFFER (NO <HT>)
06140 OUTSTR SQTBUF ;TYPE THE BUFFER
06145 POPJ P, ; & RETURN TO CALLER
06150 >; END OF IFN %SS021
06200 OUTL1: ILDB C,T1 ;GET A CHR
06300 JUMPE C,FORCE ;QUIT ON NUL
06302 IFN %SS057, <
06304 TRNN FL2,INVFL ;TEST FOR INVERSION
06306 JRST OUTL4 ; NO, JUMP
06308 PUSH P,T3 ;SAVE AN AC
06310 MOVEI T3,(C) ;COPY THE CHARACTER
06312 ANDCMI T3,40 ;CONVERT TO UPPER CASE, POSSIBLY
06314 CAIL T3,"A" ;TEST FOR LETTER
06316 CAILE T3,"Z" ;TEST FOR LETTER
06318 JRST OUTL3 ; NO, JUMP (CAN'T INVERT)
06320 XORI C,40 ;INVERT THE LETTER
06322 TRNN FL2,INVFRC ;TEST FOR FORCED CASE
06324 JRST OUTL2 ; NO, JUMP
06326 ANDCMI C,40 ;ASSUME UPPER CASE
06328 TRNN FL2,INVUP ;TEST FOR FORCED UPPER-CASE
06330 IORI C,40 ; NO, THEN LOWER CASE
06332 IFN %SS006, <
06334 LDB T3,T1 ;GET ORIGINAL CHARACTER
06336 CAIN C,(T3) ;TEST FOR UNCHANGED
06338 JRST OUTL3 ; YES, THEN DON'T STORE
06340 >; END OF IFN %SS006
06342 OUTL2: DPB C,T1 ;STORE THE MODIFIED LETTER
06344 TLO FL2,ALLCHG ;SHOW THE FILE HAS CHANGED
06346 OUTL3: POP P,T3 ;RESTORE THE AC
06348 OUTL4: ;TO HERE IF NO CASE INVERSION
06350 >; END OF IFN %SS057
06400 PUSHJ P,OCHR ;AND PRINT IT
06500 CAIE C,12 ;IS IT LINE FEED
06600 JRST OUTL1 ;NO, CONTINUE
06700 ;;; ;FALLIN FORCE
06800
06900 ;ROUTINE TO DUMP TTY BUFFER AND SET UP FOR NEXT
07000
07100 FORCE: PUSH P,C ;SAVE CURRENT CHAR
07200 MOVEI C,0 ;GRNTEE NULL
07300 IDPB C,TTOPNT ;AT END OF STRING
07400 OUTSTR TTOBUF ;DUMP IT
07500 MOVEI C,^D80 ;NEW COUNT
07600 MOVEM C,TTOCNT
07700 MOVE C,[POINT 7,TTOBUF]
07800 MOVEM C,TTOPNT ;AND PNTR
07900 POP P,C ;RESTORE C
08000 POPJ P, ;AND RETURN
08100
08200 SUBTTL END ROUTINE
00100 ;CODE TO FINISH OFF EDIT
00200
00300 ;;*FIX* ASVINS: SKIPA T1,HILN ;LAST LINE INSERTED
00400 ;;*FIX* ASVREP: MOVE T1,LOLN ;...
00450 ASVINS: MOVE T1,HILN ;GET LAST LINE INSERTED ;** FIX **
00500 MOVEM T1,SVLNUM ;SAVE FOR RESTART
00600 TLO FL2,AUTOF ;SET TO DO AUTO SAVE
00700 SKIPE ALTSN ;NEED CRLF?
00800 OCRLF ;YEP
00810 IFN %SS024, <
00820 TRNE FL,EXTOG ;CHECK FOR EXPERT
00830 OUTSTR [ASCIZ "[Saving]"] ; YES, TYPE SHORT TEXT
00840 TRNN FL,EXTOG ;CHECK FOR NON-EXPERT
00850 >; END OF IFN %SS024
00900 OUTSTR [ASCIZ "[Doing auto-save, please wait.]"]
01000 OCRLF
01100 SVCOD: TLNE FL,SRCOP ;IF INSIDE COPY
01200 JRST DSCOP ;TREAT LIKE AN E
01210 IFN %SS006, <
01220 IFE %SS074, <
01230 TRNE FL,READOF ;TEST FOR READ-ONLY
01240 NERROR ILC ; YES, ERROR
01250 >; END OF IFE %SS074
01260 >; END OF IFN %SS006
01300 TRO FL2,SVIT ;SET TO DO A SAVE
01400 MOVE T1,SSAVEN ;RESET ALL CNTRS
01500 MOVEM T1,SAVEN
01600 JUMPN T1,[TLNN FL2,AUTOF
01700 AOS SAVEN ;FIX CMD COUNT IF NOT AUTO
01800 JRST .+1]
01900 MOVE T1,SISAVN
02000 MOVEM T1,ISAVEN ;...
02100 PUSH P,UNSEQF ;SAVE CURRENT VALUE
02110 IFN %SS034, <
02120 PUSH P,DELETF ;SAVE CURRENT VALUE
02130 SETZM DELETF ; & CLEAR IT
02140 PUSH P,[-1] ;SAVE ROOM FOR PROTECTION CODE
02150 >; END OF IFN %SS034
02200 SKIPN UNSEQF ;CHECK FOR UNSEQ
02300 JRST END0 ;PROCEDE
02400 OUTSTR [ASCIZ "[WARNING: Sequence numbers preserved.]
02450 "] ;** FIX **
02500 ;;*FIX* OCRLF
02600 SETZM UNSEQF
02700 JRST END0
00100 GEND: TLOA FL,GCOM ;GO
00200 ENDIT: TLZ FL,GCOM ;NORMAL TYPE END
00300 END0: TLNE FL,SRCOP
00400 JRST DSCOP ;FINISH UP THE COPY COMMAND
00500 TLO FL2,NORENT ;DISABLE REENTER
00600 TLZ FL2,RENTF!BELLF ;DISABLE REENTRY & <BEL><BEL>> ;** FIX **
00700 TRNE FL,READOF ;IF READ ONLY
00800 JRST ENDRO ;DO SPECIAL END CODE
00900 ;*FIX* TLZ FL2,BELLF ;DISABLE <BELL><BELL> ;** FIX **
01000 TRZ FL,NEWFL ;SET TO WANTS SAME OLD PROGRAM
01100 PUSHJ P,NSCAN ;SETUP NEWBLK
01200 NERROR ILC ;BAD SYNTAX
01210 IFN %SS012, <
01220 TRNN FL2,SVIT ;TEST FOR "W"
01230 PUSHJ P,CKCOMF ; NO, CHECK FOR @-FILE OPEN
01240 >; END OF IFN %SS012
01300 SKIPE DELETF ;WANT TO DELETE?
01400 JRST END1B ;YES - SKIP THIS STUFF
01500 SKIPN UNSEQF
01600 TRNE FL,NEWFL
01700 TLO FL2,PCHGF!FCHGF ;CHANGED IF UNSEQ OR NEW NAME
01800 TLNN FL2,FCHGF
01900 JRST [ ;;*FIX* OCRLF ;** FIX **
02000 OUTSTR [ASCIZ "
02025 [No changes.]
02050 "] ;** FIX **
02100 ;;*FIX* OCRLF ;** FIX **
02110 IFN %SS006, <
02120 TRZE FL2,SVIT ;TEST FOR "W" CMD & CLEAR BIT
02130 JRST ENDWNC ; YES, JUMP
02140 >; END OF IFN %SS006
02200 SETZB T1,T2 ;DELETE OUTPUT FILE
02300 RENAME OUT,T1
02400 JFCL
02500 JRST ENDEND]
02600 JRST END1
02610 IFN %SS006, <
02620 ENDWNC: ;HERE IF NO CHANGE ON "W" COMMAND
02630 IFN %SS034, <
02640 POP P,(P) ;CLEAR PROTECTION FROM THE STACK
02650 POP P,DELETF ;RESTORE THE DELETE FLAG
02660 >; END OF IFN %SS034
02670 POP P,UNSEQF ;RESTORE THE /SEQUENCE FLAG
02680 JRST COMND ; & GO GET NEXT COMMAND
02690 >; END OF IFN %SS034
02700
02800 ;CODE TO HANDLE 'E' COMMANDS IN R/O MODE
02900
03000 ENDRO: PUSHJ P,GNCH ;GET A CHAR
03100 ANDI C,137 ;FORCE UPPER
03200 CAIN C,"D" ;CHECK FOR DELETE REQ
03300 JRST [
03310 IFN %SS062, <
03320 PUSHJ P,CHKDEL ;CONFIRM THE DELETIONN
03330 >; END OF IFN %SS062
03340 SETOM DELETF
03400 MOVEI C,0 ;DON'T BACKUP SCAN
03500 JRST .+1]
03600 CAIE C,"Q" ;QUIT OK ALSO
03610 IFN %SS046, <
03620 CAIN C,"X" ;TEST FOR 'EX'
03630 SKIPA ;SKIP IF 'EX' OR 'EQ'
03640 >; END OF IFN %SS046
03700 MOVEM C,SAVC ;BACKUP IF NOT Q
03800 PUSHJ P,SCAN ;CHECK FOR EOL
03900 TRNN FL,TERMF
04000 NERROR ILC
04010 IFN %SS012, <
04020 PUSHJ P,CKCOMF ;CHECK FOR @-FILE OPEN
04030 >; END OF IFN %SS012
04100 SKIPN DELETF ;CHECK WHICH
04200 JRST ENDEND ;JUST QUIETLY EXIT
04300 JRST END1B ;GO DELETE
04400
04500 IFN %SS012!%SS066, <
04600 CKCOMF: TRZN FL2,COMFLF ;TEST FOR @-FILE & CLEAR IT
04700 POPJ P, ; NO, RETURN TO CALLER
04800 MOVE T1,SVCCIN ;RESET THE INPUT ROUTINE
04900 MOVEM T1,CHIN ; DITTO
05000 RELEAS IND, ;RELEASE THE @-FILE DEVICE
05100 POPJ P, ;RETURN TO CALLER
05200 >; END OF IFN %SS012!%SS066
00100 END1: PUSHJ P,OCOMPL ;COMPLETE FILE COPY
00200 RELEAS IN, ;AND CLOSE OFF INPUT CHL
00300 SKIPE AUXFIL ;IF NO AUX FILE
00400 TLNE FL2,PCHGF ; AND NO CHANGES
00500 JRST [PUSHJ P,OUTDO ;PURGE OUTPUT BUFFERS
00600 JRST END1A]
00700 MOVSI T1,'TMP' ;FIXUP CORRECT FILE
00800 HLLM T1,OCREXT
00900 SETZM AUXFIL ;NO AUX FILE ANYMORE
01000 SETZB T1,T2
01100 RENAME OUT,T1 ;DELETE OUTPUT FILE
01200 JFCL ;CAN'T HAPPEN
01300 END1A: CLOSE OUT, ; AND CLOSE CHL ALSO
01310 IFN %SS006, <
01320 MOVE T1,OCRDEV ;GET OUTPUT DEVICE (GUARANTEED NON-ERSATZ)
01330 MOVEM T1,OUDEVI+1 ; & STORE INTO OPEN BLOCK
01340 OPEN OUT,OUDEVI ;OPEN A REAL DEVICE NOW
01350 JRST NODSK ; ERROR, REALLY SICK
01360 >; END OF IFN %SS006
01400 MOVE T1,[ORGBLK,,ICRBLK]
01500 BLT T1,ICRBKE ;SET UP FOR BACKUP FILE
01600 END1B: MOVE T1,ORGDEV ;GET ORIGINAL INPUT DEVICE
01700 MOVEM T1,INDEVI+1
01800 OPEN IN,INDEVI ;AND RE-OPEN CHL
01900 JRST NODSK ;THIS CAN'T HAPPEN OFTEN
02000 SKIPE DELETF ;DELETING?
02100 JRST END3B ;YES -- SKIP MORE
02200
02300 END2: XLOOK OUT,NEWBLK ;SEE IF DEST FILE EXISTS
02400 JRST END4 ;NOT FOUND - OK
02410 IFN %SS006, <
02420 MOVEI T1,OUT ;GET CHANNEL NUMBER
02430 PUSHJ P,DOPATH ;GET PATH FOR THAT CHANNEL
02440 >; END OF IFN %SS006
02500 CLOSE OUT, ;RELEASE FILE NOW
02510 IFN %SS006, <
02520 MOVEI T3,NEWBLK ;GET ADDR OF FILE SPEC
02530 MOVEI T4,(T3) ; & COPY FOR OPATH0 CALL
02540 PUSHJ P,OPATH0 ;GO SET UP PATH IN FILESPEC
02550 PUSHJ P,CKPATH ;TEST FOR FOUND ON RIGHT PATH
02560 JRST END4 ; NO, TREAT AS NON-EXISTENT
02570 >; END OF IFN %SS006
02600 TRNN FL,NEWFL ;FOUND - IS THIS OK?
02610 IFN %SS036, <
02620 SKIPE CREATF ;TEST FOR CREATING
02630 SKIPA T4,[NEWBLK] ; GET BLK PTR & SKIP IF CREATING OR NEW FILE
02640 >; END OF IFN %SS036
02700 JRST END3 ;YES: WE SHOULD HAVE FOUND IT
02780 IFE %SS036, <
02790 PUSHJ P,CLRCTO ;CLEAR ^O BEFORE TYPING ;** FIX **
02800 OUTSTR [ASCIZ /
02900 Output file exists - delete? /]
02910 >; END OF IFE %SS036
02920 IFN %SS036, <
02930 OCRLF ;RETURN THE CARRIAGE
02940 PUSHJ P,CLRCTO ;CLEAR ^O BEFORE TYPING ;** FIX **
02950 PUSHJ P,GVNAM0 ;THE THE FILE NAME
02960 OUTSTR [ASCIZ / exists - Delete? /] ; & FINISH THE MSG
02970 >; END OF IFN %SS036
03000 PUSHJ P,CONFRM ;ASK HIM IF OK
03100 JRST ASKNAM ;HE SAID NO - ASK FOR NEW NAME
03190 IFE %SS006, <
03200 LDB T1,[POINT 9,XBLOCK+2,8]
03300 CAIL T1,400 ;BETTER CHECK IF OK
03400 JSP T1,FIU ;SAY ITS PROTECTED
03500 CAIGE T1,200 ;NEED TO CHANGE?
03600 JRST END2A ;NO - JUST DELETE
03700 PUSHJ P,FIXPRT ;CORRECT PROTECTION
03720 HRRZ T2,NEWPRT ;GET REQUESTED PROTECTION
03800 HRRM T1,NEWPRT
03805 >; END OF IFE %SS006
03810 IFN %SS006, <
03815 LDB T2,[POINT 9,XBLOCK+.RBPRV,8]
03820 MOVE T3,NEWPTH
03825 PUSHJ P,CHKRNM ;CAN WE DELETE IT?
03830 JSP T1,FIU ;NO
03835 JRST END2A ;YES - AS IS
03840 ;YES - W/ PROT CHANGE
03845 HLL T2,NEWPRT ;GET EXT'N FROM FILESPEC
03850 EXCH T2,NEWPRT ;STORE NEW PROTECTION, GET OLD
03855 >; END OF IFN %SS006
03900 XRENM OUT,NEWBLK
04000 JSP T1,FIU
04010 IFN %SS006, <
04020 HRRM T2,NEWPRT ;RESTORE ORIG PROTECTION
04030 >; END OF IFN %SS006
04100 END2A: SETZB T1,T2 ;HE SAID YES - DELETE IT
04200 RENAME OUT,T1 ;...
04300 JSP T1,FIU ;OOPS!
04400 JRST END4 ;NOW TREAT IT AS NOT THERE
00100 END3: HLRZ T1,ICREXT ;GET ORIGINAL EXTENSION
00200 ANDI T1,7777 ;SAVE LAST 2 CHARS
00300 IORI T1,'Q ' ;MAKE IT INTO QXX
00400 SKIPLE BAKF ;UNLESS OF CORSE WE NEEDED
00500 XORI T1,130000 ;THE OLD EXTENSION - ZXX
00600 HRLM T1,ICREXT ;STASH EXTENSION & GET PROT
00700 MOVE T1,ICREXT
00800 TRZ T1,700 ;CORRECT PROTECTION
00900 PUSH P,T1 ;AND SAVE FOR LATER
01000
01010 IFN %SS005, <
01020 SKIPE BAKF ;TEST FOR /NOBAK (PRESERVES *.BAK FILES)
01030 >; END OF IFN %SS005
01100 XLOOK IN,ICRBLK ;IS FILE THERE
01200 JRST END3B ;NO: JUST DO RENAME
01300
01400 SKIPG BAKF ;YES: NEED OLD ?
01500 JRST END3A ;NOPE - GO DO RENAME (DELETE FIRST)
01600 MOVSI T1,130000 ;YES - MAKE CORRECT EXTENSION
01700 XORB T1,0(P) ; TO BE QXX.
01800 HLLM T1,ICREXT
01900
02000 XLOOK IN,ICRBLK ;NOW LOOK FOR THIS ONE
02100 JRST END3B ;NOT THERE - IMAGINE THAT
02200
02290 IFE %SS006, <
02300 END3A: LDB T1,[POINT 9,XBLOCK+2,8]
02400 CAIL T1,400 ;CHECK IF OK
02500 JRST [OUTSTR [ASCIZ /% Backup file write protected - ignored/]
02600 OCRLF
02700 CLOSE IN,
02800 SETZM BAKF ;SAY NO BACKUP
02900 JRST END3B]
03000 HRRM T1,0(P) ;SAVE OLD FILE PROT.
03100 CAIGE T1,200 ;CHECK GOODNESS OF PROTECTION
03200 JRST END3R ;OK - JUST DELETE
03300 PUSHJ P,FIXPRT ;ADJUST INTO RANGE 1XX
03400 HRRM T1,ICRPRT ;STASH PROT
03500 XRENM IN,ICRBLK ;CHANGE PROT SO WE CAN DELETE
03600 JSP T1,FIU ;OH - WELL
03700 END3R: SETZB T1,T2 ;PREPARE FOR DELETE
03800 RENAME IN,T1 ;ZAP-A-ROO!
03900 JSP T1,FIU ;WHOOPS!
04000 ;;;; ;FALIN END3B
04100 >; END OF IFE %SS006
04200 IFN %SS006, <
04300 END3A: MOVEI T1,IN ;CHECK PATH TO BE SURE IT ISN'T FROM LIBRARY, ETC.
04400 MOVEI T4,ICRBLK ;POINT AT LOOKUP PARMS
04500 PUSHJ P,TSTPTH ;CHECK FOR RIGHT FILE FOUND
04600 JRST END3B ; NO, IGNORE IT
04700 LDB T2,[POINT 9,XBLOCK+.RBPRV,8]
04800 MOVE T3,ICRPTH
04900 PUSHJ P,CHKRNM ;CAN WE DELETE IT?
05000 JSP T1,BFIU ;NO
05100 JRST END3R ;YES - AS IS
05200 ;YES - W/ PROT CHANGE
05300 HRRM T2,ICRPRT
05400 XRENM IN,ICRBLK ;CHANGE PROT SO WE CAN DELETE
05500 JSP T1,BFIU ;OH - WELL
05600 END3R: SETZB T1,T2 ;PREPARE FOR DELETE
05700 RENAME IN,T1 ;ZAP-A-ROO!
05800 JSP T1,BFIU ;WHOOPS!
05900 ;;;; ;FALIN END3B
06000 >; END OF IFN %SS006
00100 END3B: MOVE T1,[ORGBLK,,TMPBLK]
00200 BLT T1,TMPBKE ;SET UP COPY OF ORIGINAL
00210 IFN %SS006, <
00220 TRNE FL,NEWFL ;TEST FOR NEW FILE .NE. OLD FILE
00230 SKIPN DELETF ;TEST FOR /DELETE
00240 SKIPA ; SKIP IF SAME FILE OR NO /DELETE
00250 JRST ENDDWF ; ELSE DON'T DELETE *ANY* FILE
00260 >; END OF IFN %SS006
00300
00400 XLOOK IN,TMPBLK ;LOOK FOR IT
00490 IFE %SS006, <
00500 JSP T1,FIU ;SOMEBODY'S CONFUSED
00600 HRRZ T1,ORGPRT ;GET ORIGINAL PROT.
00700 CAIGE T1,200 ;TOO LARGE?
00800 JRST END3C ;OK TO JUST RENAME
00900 PUSHJ P,FIXPRT ;MAKE GOOD
01000 HRRM T1,TMPPRT ;STASH IN THE RIGHT PLACE
01005 >; END OF IFE %SS006
01010 IFN %SS006, <
01015 JRST END3E ; LOOKUP ERROR, JUMP
01020 MOVEI T1,IN ;GET CHANNEL NUMBER
01025 MOVEI T4,TMPBLK ;POINT AT THE FILESPEC
01030 PUSHJ P,TSTPTH ;TEST FOR RIGHT FILE FOUND
01035 JRST END3E ; NO, TREAT AS NOTHING FOUND
01040 LDB T2,[POINT 9,XBLOCK+.RBPRV,8]
01045 MOVE T3,TMPPTH
01050 PUSHJ P,CHKRNM ;CAN WE RENAME IT?
01055 JSP T1,FIU ;NO
01060 JRST [ ;YES - JUMP TO SEE ABOUT REPROTECTING
01065 HRLI T2,0 ;GET CODE FOR CHANGE PROTECTION
01070 PUSHJ P,DOCKAC ;SEE ABOUT REPROTECTING, TOO
01075 HLLZS 0(P) ; CAN'T, CLEAR PROT TO PREVENT CHANGING
01080 JRST END3C]
01085 ;YES - W/ PROT CHANGE
01090 HRRM T2,TMPPRT
01095 >; END OF IFN %SS006
01100 XRENM IN,TMPBLK ;CHANGE PROT FOR LATER
01200 JSP T1,FIU ;BETTER NOT!
01300 END3C: SKIPE DELETF ;STILL DELETING?
01400 JRST ENDDEL ;YES -- FINISH UP
01500 POP P,TMPEXT ;RESTORE EXT & PROT
01600 SKIPN BAKF ;IS THIS NECESSARY?
01700 SETZM TMPNAM ;NO: JUST DELETE THE LOSER
01800 SETSTS IN,1 ;GIVE CORRECT I/O STATIS
01900
02000 XRENM IN,TMPBLK ;TRY RENAME
02100 JSP T1,FIU ;WHOOPS
02200
02210 IFN %SS006, <
02220 END3E: SKIPE DELETF ;TEST FOR DELETING
02230 JRST ENDDWF ; YES, JUMP
02240 ; NO, FALL THRU FOR 'END4'
02250 >; END OF IFN %SS006
02260
02300 END4: HRRZ T1,ORGPRT ;GIVE FILE ORIGINAL PROT
02310 IFN %SS006, <
02320 HRRZ T2,NEWPRT ;GET NEW PROTECTION
02330 SKIPN T2 ;DON'T SET FROM OLD IF DEFINED
02340 >; END OF IFN %SS006
02400 HRRM T1,NEWPRT ;...
02405 IFN %SS034, <
02410 TRNN FL2,SVIT ;TEST FOR "W" COMMAND
02415 JRST END5 ; NO, JUMP
02420 HRRZ T1,NEWPRT ;GET NEW PROTECTION
02425 MOVEM T1,(P) ; & STORE FOR LATER
02430 TRZN T1,400 ;TEST FOR PROTECTION TOO HIGH
02435 JRST END5 ; NO, JUMP
02440 TRO T1,300 ; YES, FORCE TO <3??>
02445 HRRM T1,NEWPRT ;STORE FOR THE RENAME
02450 END5: ;HERE AFTER PROTECTION ADJUSTED
02455 >; END OF IFN %SS034
02500 SKIPE UNSEQF ;SKIP LOOKUP IF UNSEQUENCING
02600 JRST UNSEQ
02700
02800 XLOOK OUT,OCRBLK ;LOOKUP TEMP FILE
02900 JRST EDFLIN ;GIVE UP
03000
03090 IFE %SS006, <
03100 PUSHJ P,ENDNAM ;PRINT FINAL NAME
03110 >; END OF IFE %SS006
03200 SETSTS OUT,1 ;CORRECT I/O STATUS
03300 XRENM OUT,NEWBLK ;RENAME TO DESIRED NAME
03400 JSP T1,FIU ;LOSE AGAIN
03410 IFN %SS006, <
03420 PUSHJ P,ENDNAM ;PRINT FINAL NAME
03430 >; END OF IFN %SS006
03500 JRST ENDEND ;AND FINISH UP
03600
03700 ENDNAM: OUTSTR [ASCIZ "
03800 ["]
03900 MOVEI T4,NEWBLK ;NEW FILE NAME
04000 PUSHJ P,GVNAM0 ;PRINT IT
04100 OUTSTR [ASCIZ "]
04200 "]
04300 POPJ P,
04400
04410 IFN %SS006, <
04420 ENDDWF: OPEN IN,INDEVI ;RE-OPEN THE INPUT, NOT TO DELETE ANYTHING
04430 JRST NODSK ; VERY STRANGE ERROR, JUMP
04440 >; END OF IFN %SS006
04450
04500 ENDDEL: SETZB T1,T2 ;SET FOR DELETE
04600 RENAME IN,T1 ;CAN EVERYTHING
04700 JFCL
04800 RENAME OUT,T1 ;...
04900 JFCL
05000 ;;;; ;FALIN ENDEND
00100 ENDEND: CLOSE IN, ;TERMINATE INPUT CHL
00200 RELEAS IN,
00300 CLOSE OUT,
00400 SKIPE AUXFIL ;AUX FILE IN USE?
00500 PUSHJ P,DELAUX ;YES: DETLETE IT
00600 RELEAS OUT, ;TERMINATE OUTPUT CHL
00700 TRNE FL2,SVIT ;CHECK FOR SAVE COMMAND
00800 JRST RESTRT ;YES - GO RESTART
00850 PUSHJ P,DISINT ;CLEAR ^C TRAP BEFORE EXITING ;** FIX **
00900 TLNE FL,GCOM ;IS THIS A 'GO'?
01000 JRST CREFIT ;YES - DO RUN UUO
01100 MONRET: ;HERE FOR TEMPORARY RETURN TO MONITOR LEVEL
01110 IFN %SS061, <
01120 PUSHJ P,RSTPDS ;RESET "DSKFUL" SETTING BEFORE EXIT
01130 >; END OF IFN %SS061
01140 EXIT 1,
01150 IFN %SS061, <
01160 PUSHJ P,SETPDS ;NOW RESET "DSKFUL PAUSE" AGAIN
01170 >; END OF IFN %SS061
01200 SKIPGE CNCLOK ;SEE IF FROM M OPTION
01300 JRST MONRET
01400 JRST CNCCON ;OK - IF FROM ^C
01500
01600 ;ROUTINE TO DELETE AUX FILE IF ANY
01700
01800 DELAUX: MOVSI T1,'TMP' ;GET EXTENSION
01900 HLLM T1,OCREXT ;IN PLACE
02000 SETZM AUXFIL ;SAY IT'S GONE
02100 XLOOK OUT,OCRBLK ;THERE?
02200 POPJ P, ;DON'T SWEAT IT
02300 SETZB T1,T2 ;SET TO DELETE
02400 RENAME OUT,T1 ;POW!
02500 JFCL ;DON'T CARE
02600 POPJ P, ;RETURN
02700
02800 ;HERE TO START WORLD OVER AFTER 'W'
02900
02990 IFE %SS034, <
03000 RESTRT: RESET ;A GOOD THING
03010 >; END OF IFE %SS034
03020 IFN %SS024, <
03030 RESTRT: HLRZ T1,.JBSA## ;GET INITIAL .JBFF
03040 MOVEM T1,.JBFF## ; & RESET IT
03050 POP P,T1 ;GET THE SAVED PROTECTION
03060 SKIPL T1 ;SKIP IF NOTHING SAVED
03070 HRRM T1,NEWPRT ; ELSE RESET IT
03080 POP P,DELETF ;RESTORE DELETE FLAG
03090 >; END OF IFN %SS034
03100 POP P,UNSEQF ;NOW RESTORE ALL GOOD THINGS
03200 SETZM RPGSW
03210 IFN %SS036, <
03220 SETZM CREATF ;CLEAR CREATE FLAG SINCE FILE NOW WRITTEN
03230 >; END OF IFN %SS036
03300 TDZ FL,[TECOF,,BOF!EOF!EOF2!NEWFL]
03400 MOVE T1,[NEWBLK,,ORGBLK]
03500 BLT T1,ORGBKE ;SET UP INPUT FILE NAME
03600 MOVE T1,OCRDEV ;GET CORRECT DEVICE
03700 MOVEM T1,ORGDEV
03800 PUSHJ P,ZERNEW ;CLEAR OUT OLD INFO
03900 JRST RPGRET ;AND START OVER
04000
04100 ;CODE FOR 'ED' COMMAND, CHECK PROPER TERM AND SET FLAG
04200
04300 ZAPIT: ;HERE ON 'ED' COMMAND
04350 PUSHJ P,SCAN ;CHECK EOL
04400 TRNN FL,TERMF ;
04500 POPJ P, ;ERROR RETURN FROM NSCAN
04510 IFN %SS062, <
04520 PUSHJ P,CHKDEL ;GET CONFIRMATION FOR "ED"
04530 >; END OF IFN %SS062
04540 IFN %SS006, <
04550 SKIPE CREATF ;TEST FOR CREATING A FILE
04560 JRST QUIT1 ; YES, DELETE MEANS QUIT
04570 >; END OF IFN %SS006
04600 SETOM DELETF ;SET FLAG
04700 JRST CPOPJ1 ;GOOD RETURN
04800
04890 IFE %SS006, <
04900 ;ROUTINE TO GET PROT INTO RANGE 1XX
05000
05100 FIXPRT: MOVEI T2,200 ;GENERATE XOR CONST
05200 CAIGE T1,300
05300 IORI T2,100
05400 XOR T1,T2 ;ZAP IT
05500 POPJ P, ;RETURN WITH PROT IN T1
05510 >; END OF IFE %SS006
05600
05700 IFN %SS062, <
05800
05900 ; ROUTINE TO CONFIM "ED" EXIT COMMANDS
06000
06100 CHKDEL: OUTSTR [ASCIZ /
06200 Really delete the file? /] ;ASK THE QUESTION
06300 PUSHJ P,CONFRM ;GET THE ANSWER
06400 JRST COMND ; "NO", IGNORE THE COMMAND
06500 POPJ P, ; "YES", GO DELETE & EXIT
06600 >; END OF IFN %SS062
00100 NSCAN: TLNE FL2,AUTOF ;SPECIAL IF AUTO MODE
00200 JRST NSCAN1
00300 NSCAN0: PUSHJ P,GNCH ;LOOK FOR ARGS
00400 CAIN C,":" ;IS IT A COLON
00500 JRST NSCAN2 ;YES: GO LOOK FOR FILE NAME
00510 IFN %SS006, <
00520 TRNE FL2,SVIT ;TEST FOR "W" CMD
00530 JRST NSCAN3 ; YES, SWITCHES ILLEGAL
00540 >; END OF IFN %SS006
00600 ANDI C,137 ;FORCE UPPER CASE
00700 MOVEI T1,0 ;INITIAL VALUE
00790 IFE %SS046, <
00800 MOVE T2,[POINT 7,[ASCIZ "SBQD"]]
00810 >; END OF IFE %SS046
00820 IFN %SS046, <
00830 MOVE T2,[POINT 7,[ASCIZ "SBQDNXT"]] ;GET OPTION BYTE PTR
00840 >; END OF IFN %SS046
00900 NSCNA: ILDB T3,T2 ;GET CHAR
01000 JUMPE T3,NSCAN3 ;NOT FOUND IF NULL
01100 CAIE C,(T3) ;MATCH?
01200 AOJA T1,NSCNA ;NO -- TRY NEXT
01300 XCT ENDTBL(T1) ;IF SW SEEN - DO ROUTINE
01400 JRST NSCAN0 ;LOOK FOR MORE
01500
01600 NSCAN2: PUSHJ P,SCAN ;GET A FILE NAME
01700 PUSHJ P,SETNM1 ;...
01800 POPJ P, ;ERROR RETURN
01900 SKIPE TMPDEV ;ERROR IF DEVICE SPECIFIED
02000 POPJ P,
02100 MOVE T1,[TMPBLK,,NEWBLK]
02200 BLT T1,NEWBKE ;PUT INFO IN NEWBLK
02300 NSCAN1: SKIPN NEWNAM ;IF NEW NAME
02400 JRST NSCN1A
02500 TRO FL,NEWFL ;THEN INDICATE NEW FILE
02600 HRRZ T1,ORGPRT ;GET CORRECT PROTECTION
02610 IFN %SS006, <
02620 HRRZ T2,NEWPRT ;GET THE NEW PROTECTION
02630 SKIPN T2 ;DON'T STORE IF ALREADY GIVEN
02640 >; END OF IFN %SS006
02700 HRRM T1,NEWPRT ;...
02800 MOVE T1,OCRDEV ; AND CORRECT STR NAME
02900 MOVEM T1,NEWDEV
02990 IFE %SS006, <
03000 MOVSI T2,-<PTH+SFDLVL+1>
03100 MOVE T1,NEWBLK(T2) ;COMPARE FILE SPECS
03200 CAMN T1,ORGBLK(T2) ;...
03300 AOBJN T2,.-2
03400 JUMPL T2,CPOPJ1 ;JUMP IF DIFFERENT
03405 >; END OF IFE %SS006
03410 IFN %SS006, <
03415 MOVEI T3,NEWBLK ;POINT AT NEW BLOCK
03420 MOVE T4,T3 ; DITTO
03425 PUSHJ P,OPATH ;CALL TO SET UP PATH INFO
03430 HRRZ T1,NEWPRT ;GET NEW PROTECTION
03435 HRRM T1,ORGPRT ; & STORE FOR COMPARISONS
03440 MOVSI T2,-EXT ;GET INITAL AOBJN PTR
03445 MOVE T1,NEWBLK(T2) ;GET WD FROM NEW FILESPEC
03450 CAMN T1,ORGBLK(T2) ;TEST FOR SAME AS ORIGINAL FILESPEC
03455 AOBJN T2,.-2 ; YES, INCR & REPEAT
03460 JUMPL T2,CPOPJ1 ; DONE, RETURN+1 IF DIFFERENT
03465 MOVEI T1,ORGBLK ;POINT AT ORIGINAL FILE SPEC
03470 MOVEI T4,NEWBLK ;POINT AT NEW FILE SPEC
03475 PUSHJ P,CKPTH0 ;TEST FOR SAME PATHS
03480 JRST CPOPJ1 ; NO, RETURN WITH BIT SET
03485 >; END OF IFN %SS006
03500 TRZ FL,NEWFL ;IT AINT NEW
03600 JRST CPOPJ1
03700
03800 NSCN1A: MOVE T1,[OCRBLK,,NEWBLK]
03900 BLT T1,NEWBKE ;SET UP NEWBLK FOR CORRECT
04000 HRROI T1,ORGEXT ;FILE SPEC
04100 POP T1,NEWEXT
04200 POP T1,NEWNAM
04300 JRST CPOPJ1
04400
04500 NSCAN3: MOVEM C,SAVC ;BACK UP SCANNER
04600 PUSHJ P,SCAN
04700 TRNE FL,TERMF ;CHECK FOR TERM
04800 JRST NSCAN1 ;PROPER - CHECK NEW NAME
04900 POPJ P, ;NO TERM - LOSE
00100 ENDTBL: SETOM UNSEQF ;'S'
00200 SETZM BAKF ;'B'
00300 JRST QUIT ;'Q'
00400 JRST ZAPIT ;'D'
00410 IFN %SS046, <
00420 SETOM UNSEQF ;'N', SAME AS 'S'
00430 JFCL ;'X', FOR TECO FREAKS
00440 HRRZM P,UNSEQF ;'T', SET + FOR /TEXT MODE
00450 >; END OF IFN %SS046
00500
00600 ASKNAM: OUTSTR [ASCIZ /File: /]
00700 SETZM SAVCHR ;RESET SCAN
00800 CLRBFI
00900 PUSHJ P,NSCAN2 ;GET A NEW NAME
01000 SKIPA
01100 JRST END2 ;TRY AGAIN
01200 OUTSTR [ASCIZ /? What?
01300 /]
01400 JRST ASKNAM ;WE CAN DO THIS UNTIL YOU GET IT CORRECT
01500
01590 IFE %SS006, <
01600 FIU: OUTSTR [ASCIZ /
01700 ? File write protected. Try another name
01800 /]
01900 JRST ASKNAM
01905 >; END OF IFE %SS006
01910
01915 IFN %SS006, <
01920 FIU: PUSHJ P,CLRCTO ;CLEAR ^O
01925 OUTSTR [ASCIZ /
01930 ? F/] ;START THE MESSAGE
01935 JRST FIUC ; & JUMP
01940
01945 BFIU: PUSHJ P,CLRCTO ;CLEAR ^O
01950 OUTSTR [ASCIZ /
01955 ? Backup f/] ;START THE MESSAGE
01960 FIUC: OUTSTR [ASCIZ /ile write protected. Try another name
01965 /] ;FINISH THE MESSAGE
01970 PUSHJ P,DISINT ;PERMIT ^C TRAP IF PANIC
01975 JRST ASKNAM ;GO READ THE NAME
01980 >; END OF IFN %SS006
02000
02100 ;CODE FOR 'EQ' COMMAND. JUST DELETE TEMPS AND EXIT
02200
02300 QUIT: POP P,0(P) ;PRUNE PDL
02310 IFN %SS022, <
02320 QCOM: ;HERE TO MAKE 'Q' EQUIV. TO 'EQ'
02330 >; END OF IFN %SS022
02400 PUSHJ P,SCAN ;MAKE SURE NO ARGS
02500 TRNN FL,TERMF
02600 NERROR ILC
02610 IFN %SS006, <
02620 QUIT1: ;TO HERE ON "ED" EXIT WHEN CREATING
02630 >; END OF IFN %SS006
02700 SETZB T1,T2 ;SET TO DELETE OUTPUT SIDE
02800 RENAME OUT,T1
02900 JFCL ;DON'T CARE
03000 JRST ENDEND
03100
03200
03290 IFE %SS022, <
03300 QCOM: PUSHJ P,SCAN ;CHECK THAT THIS IS REALLY JUST 'Q'
03400 TRNN FL,TERMF
03500 NERROR ILC
03600 OUTSTR [ASCIZ /% Type 'W' to save world - 'EQ' to quit
03700 /]
03800 JRST COMND
03900 >; END OF IFE %SS022
00100 ;HERE TO DO UNSEQUENCING
00200
00300 UNSEQ: RELEAS IN, ;PREPARE FOR NEW OPEN
00400 MOVE T1,OCRDEV ;GET OUTPUT DEVICE
00500 MOVEM T1,INDEVI+1
00600 OPEN IN,INDEVI ;OPEN CHL
00700 JRST NODSK ;SIGH!
00800 SETSTS IN,1 ;SET UP CORRECT I/O STATUS
00900 SETSTS OUT,1
00990 IFE %SS006, <
01000 MOVSI T1,(<1B0>) ;SET UP RING BUFFERS
01100 HLLM T1,OBUF
01200 HLLM T1,IBUF
01300 MOVSI T1,(<POINT 7,,>)
01400 HLLZM T1,OBUF+1
01500 HLLZM T1,IBUF+1
01600 SETZM OBUF+2
01700 SETZM IBUF+2
01705 >; END OF IFE %SS006
01710 IFN %SS006, <
01715 MOVE T1,BUFHD ;GET BUFFER ORIGIN
01720 MOVEM T1,.JBFF## ; & RESET .JBFF
01725 HLRZ T1,EDBUF ;GET DEFAULT # OF BUFFERS
01730 INBUF IN,(T1) ;REQUEST INPUT BUFFER ALLOCATION
01735 OUTBUF OUT,(T1) ;REQUEST OUTPUT BUFFER ALLOCATION
01740 MOVSI T1,(<POINT 7,>) ;GET ASCII B.P. (LH)
01745 HLLM T1,OBUF+1 ;RESET OUTPUT B.P.
01750 HLLM T1,IBUF+1 ;RESET INPUT B.P.
01755 >; END OF IFN %SS006
01800 IFN CRYPSW,<
01900 SETOM IBUF+3 ;INIT BLK CNTR
02000 MOVNI T1,2
02100 MOVEM T1,OBUF+3
02200 MOVE T1,NEWCOD ;GET CORRECT PSWS
02300 EXCH T1,OCRCOD
02400 MOVEM T1,ICRCOD ;...
02500 >
02600 XENTR OUT,NEWBLK ;CREATE NEW FILE
02700 JSP T1,FIU ;LOSAGE
02800 XLOOK IN,OCRBLK ;LOOKUP TEMP FILE
02900 JRST EDFLIN ;GROAN
03000 TDZ FL,[COPFIL,,EOF];CLR FLAGS
03100
03200 UNSEQL: PUSHJ P,GCHAR ;FETCH CHARACTER
03300 JUMPE T3,UNSEQ5 ;DONE IF ZERO RETURNED
03400 MOVE T1,@IBUF+1 ;SEE IF SEQ #
03500 TRNN T1,1
03600 JRST UNSEQ2
03610 IFN %SS046, <
03620 CAMN T1,PGMK ;TEST FOR A PAGE MARK
03630 SKIPG UNSEQF ;TEST FOR REMOVING <FF>'S
03640 JRST UNSEQ1 ; NO, JUMP
03650 PUSHJ P,GCHAR ;GET THE NEXT CHARACTER
03660 JRST UNSEQ3 ; & JUMP TO SKIP 5 MORE
03670 UNSEQ1: ;TO HERE IF NOT <FF>
03680 >; END OF IFN %SS046
03700 SKIPE BASICF ;CHECK BASIC MODE
03800 JRST UNSEQB
03810 IFN %SS046, <
03820 UNSEQ3: ;TO HERE TO SKIP PAGE MARK
03830 >; END OF IFN %SS046
03900 AOS IBUF+1 ;SKIP SEQ #
04000 MOVNI T3,5
04100 ADDM T3,IBUF+2
04200 JRST UNSEQL
04300
04400 UNSEQ2: PUSHJ P,PCHAR ;WRITE CHAR
04500 JRST UNSEQL ;LOOP UNTIL DONE
04600
04700 UNSEQ5: SETZB T1,T2 ;SET FOR DELETE
04800 RENAME IN,T1
04900 JFCL
05000 PUSHJ P,OUTDO ;DUMP LAST BUFFER
05100 PUSHJ P,ENDNAM ;PRINT FINAL NAME
05200 JRST ENDEND
05300
05400 ;HERE FOR SPECIAL BASIC UNSEQUENCE
05500
05600 UNSEQB: SKIPA T1,[5] ;DO 5 CHAR SEQ #
05700 PUSHJ P,GCHAR ;GET NEXT CHAR
05800 PUSHJ P,PCHAR ;OUTPUT CHAR
05900 SOJG T1,.-2
06000 PUSHJ P,GCHAR ;GET TAB
06100 CAIE T3,11 ;IT BETTER BE
06200 ERROR ICN
06300 MOVEI T3,40 ;PUT IN A SPACE
06400 JRST UNSEQ2
06500
06600 SUBTTL SOME GENERAL PURPOSE STUFF
00100 ;SOME MORE GENERAL ROUTINES
00200
00300
00400 RDLIN: SETZM LIBUF+1 ;READ IN A LINE. FIRST ZERO INPUT BUFFER
00500 MOVE T1,[XWD LIBUF+1,LIBUF+2]
00600 BLT T1,LIBUF+MXWPL+1
00700 MOVE T1,[POINT 7,LIBUF+1] ;SET UP POINTER
00800 MOVEI T2,5*MXWPL-2 ;SET FOR AVAILABLE SPACE
00900 MOVEI C,11 ;START WITH A TAB
01000 JRST RDL3
01100 RDL1: PUSHJ P,GNCH ;GET ANOTHER CHARACTER
01110 IFN %SS051, <
01120 PUSHJ P,CHKREN ;TEST FOR ^C TRAP
01130 POPJ P, ; YES, RETURN TO CALLER
01140 >; END OF IFN %SS051
01200 CAIN C,15 ;IGNORE RETURN
01300 JRST RDL1
01350 CAIE C,14 ;COUNT FF AS CRLF ;** DEC FIX **
01400 CAIN C,12 ;LINE FEED IS THE ONLY PROPER END
01500 JRST RDL2
01600 CAIE C,200 ;ALTMODE IS A SPECIAL CASE
01700 JRST RDL3 ;NOT ALTMODE
01800 SETOM ALTSN ;FLAG ALTMODE SEEN FOR I AND R
01900 CAIE T2,5*MXWPL-3
02000 JRST RDL2 ;DO END OF LINE STUFF
02100 POPJ P, ;EMPTY LINE RETURN
02200
02300 RDL3: IDPB C,T1 ;PUT IT IN THE BUFFER
02400 SOJGE T2,RDL1 ;CHECK FOR OVERFLOW AND CONTINUE
02500 RERROR LTL ;LINE IS TOO LONG
02600 POPJ P, ;NON-SKIP RETURN
02700 RDL2: MOVEI C,15 ;PUT IN A CR-LF
02800 IDPB C,T1
02900 MOVEI C,12
03000 IDPB C,T1
03100 HRRZS T1 ;NOW GET THE SIZE
03200 SUBI T1,LIBUF-1
03300 AOS (P) ;SKIP RETURN IF OK
03400 POPJ P, ;AND RETURN
03500
03600
03700
03800 GETLTH: MOVE T1,PNTR ;GET THE LENGTH OF THE LINE POINTED AT
03900 ADDI T1,1
04000 GETLN1: SKIPN T2,(T1) ;ANY END IS GOOD ENOUGH
04100 JRST GETLN2
04200 TRNN T2,1 ;SEQ-NUM?
04300 AOJA T1,GETLN1
04400 GETLN2: SUB T1,PNTR ;FIND LENGTH
04500 POPJ P, ;AND RETURN
04600
04700
04800 OUTSN: MOVEM T1,SQBUF ;PUT IT IN SPACE FOLLOWED BY A TAB
04900 OUTSTR SQBUF
05000 POPJ P,
00100 ASCIAD: AND T2,K2A ;CONVERT TO NUMBERS
00200 IOR T1,K4A ;MAKE SURE THIS IS IN DIGIT FORM
00300 ADD T1,K1A ;GET EACH DIGIT IN RANGE 166 TO 177 FOR CARRY
00400 ADD T2,T1 ;SUM
00500 AND T2,K3A ;GET RID OF 100 BITS IF THERE
00600 MOVE T1,K4A ;FIND OUT WHICH ONES NEED SUBTRACTING
00700 AND T1,T2
00800 ASH T1,-3 ;CONVIENIENTLY THEY NEED 6 SUBTRACTED
00900 SUBM T2,T1 ;SO DO IT
01000 IOR T1,K4A ;AND RECONVERT TO DIGITS
01100 POPJ P, ;WE HAVE ADDED THE ASCII IN T1 AND T2 RESULT IN T1
01200
01300 K1A: BYTE (7) 106,106,106,106,106
01400 K2A: BYTE (7) 17,17,17,17,17
01500 K3A: BYTE (7) 77,77,77,77,77
01600 K4A: <ASCII /00000/>!1
01700 K5A: BYTE (7) 7,7,7,7,7
01800 K6A: BYTE (1) 1 (7) 77,77,77,77,77
01900 K7A: BYTE (1) 0 (7) 106,106,106,106,106
02000
02100 ASCAV: AND T2,K2A
02200 IOR T1,K4A ;THIS ROUTINE AVERAGES 2 ASCII NUMERS
02300 LSH T1,-1
02400 ADD T1,K7A ;IT WORKS MOSTLY BY MAJIC
02500 LSH T2,-1
02600 ADD T2,T1
02700 AND T2,K6A
02800 MOVE T1,T2
02900 ANDCM T1,K3A
03000 AND T2,K3A
03100 MOVE T3,T2
03200 LSH T3,-3
03300 AND T3,K2A
03400 AND T2,K5A
03500 SUB T2,T3
03600 LSH T1,-4
03700 ADD T2,T1
03800 LSH T1,-2
03900 ADD T2,T1
04000 IOR T2,K4A
04100 POPJ P,
00100 ;CHECK TO SEE IF BUFFER TOO FULL AND DUMP IF NEEDED
00200
00300 FILLB: MOVE T1,WC ;GET WORD COUNT
00400 FILLB3: CAMGE T1,MAXWC ;AND COMPARE WITH MAX PERMISSIBLE
00500 POPJ P, ;OK, SO RETURN
00590 IFE %SS035, <
00600 MOVE T1,BUFP ;GET BUFFER POINTER
00700 ADDI T1,1
00800 FILLB1: SKIPN T2,(T1) ;FIND END OF FIRST LINE
00900 JRST FILLB2
01000 TRNN T2,1
01100 AOJA T1,FILLB1
01200 FILLB2: PUSHJ P,NOWFL ;PART OF GETN WILL DUMP AND ADJUST POINTERS
01300 JRST FILLB ;SEE IF IN LIMITS NOW
01310 >; END OF IFE %SS035
01320 IFN %SS035, <
01330 SUB T1,MAXWC ;COMPUTE AMOUNT TO DUMP
01340 ADD T1,BUFP ;POINT AT 1ST WORD TO DUMP
01350 AOJA T1,GETN1 ;INCR TO DUMP ALWAYS, GO DUMP & RETURN
01360 >; END OF IFN %SS035
01400
01500
01600
01700 ;INSERT A LINE (IN LIBUF) INTO PLACE POINTED AT BY PNTR
01800 ;WORD COUNT OF OLD LINE IN OCNT. OF NEW LINE IN NCNT
01900
02000 INSED: ;HERE TO MODIFY THE TEXT BUFFER
02010 IFE %SS006, <
02020 TLO FL2,ALLCHG ;CHANGES
02030 >; END OF IFE %SS006
02100 MOVE T1,NCNT ;SEE HOW THE COUNTS DIFFER
02200 SUB T1,OCNT
02290 IFE %SS006, <
02300 JUMPE T1,NOBLT ;THEY ARE SAME, NO MOVING NECESSARY
02310 >; END OF IFE %SS006
02320 IFN %SS006, <
02330 JUMPE T1,INSCHK ;JUMP IF SAME LTH, MORE TO DO
02340 >; END OF IFN %SS006
02400 JUMPG T1,BBLT ;NEW IS LARGER, BLT WILL NOT DO
02500 MOVE T2,PNTR ;SET UP BLT POINTER FROM PNTR+OCNT
02600 ADD T2,OCNT
02700 HRLS T2
02800 HRR T2,PNTR ;TO PNTR+NCNT
02900 ADD T2,NCNT
03000 ADDB T1,WC ;ADJUST WC TO OLD WORD COUNT +NCNT-OCNT
03100 ADD T1,BUFP ;LAST TRANSFERED IS BUFP+WC+NCNT-OCNT
03200 BLT T2,(T1)
03290 IFE %SS006, <
03300 NOBLT: SKIPN T1,NCNT ;CHECK FOR 0 NEW COUNT (WE ARE DELETING)
03310 >; END OF IFE %SS006
03320 IFN %SS006, <
03330 NOBLT: TLO FL2,ALLCHG ;SHOW FILE CHANGED NOW
03340 NOBLT0: SKIPN T1,NCNT ;CHECK FOR 0 NEW COUNT (DELETING)
03350 >; END OF IFN %SS006
03400 POPJ P, ;IF SO DONE
03500 MOVE T2,PNTR ;GET THE POINTER POSITION FOR BLT
03600 HRLI T2,LIBUF ;FROM LIBUF TO PNTR
03700 ADD T1,PNTR ;STOP AT PNTR+NCNT-1
03800 BLT T2,-1(T1)
03900 POPJ P, ;AND ALL DONE
04000 BBLT: MOVE T2,BUFP ;FAKE BACKWARDS BLT FROM BUFP+WC
04100 ADD T2,WC
04200 ADDB T1,WC ;TO BUFP+WC+NCNT-OCNT (ALSO FIX WC)
04300 ADD T1,BUFP
04390 IFE %SS035, <
04400 BBLT1: CAMGE T2,PNTR ;STOP HERE (COULD STOP SOONER BUT THIS IS EASIER)
04500 JRST NOBLT ;AND GO MOVE IN NEW STUF
04600 MOVE T3,(T2) ;TRANSFER A WORD
04700 MOVEM T3,(T1)
04800 SUBI T1,1
04900 SOJA T2,BBLT1 ;AND KEEP IT UP
04905 >; END OF IFE %SS035
04910 IFN %SS035, <
04915 CAMN T2,PNTR ;TEST FOR INSERTING AT END OF BUFFER
04920 JRST [ ; YES, JUMP
04925 SETZM (T1) ;STORE A ZERO AT NEW END
04930 JRST NOBLT ; & GO INSERT TEXT
04935 ]
04940 MOVE T3,PNTR ;GET CURRENT POINTER
04945 ADD T3,OCNT ;COMPUTE LAST WORD TO MOVE
04950 HRROS T2 ;PREVENT PDL UNDERFLOW
04955 BBLT1: CAILE T3,(T2) ;TEST FOR LAST WORD MOVED
04960 JRST NOBLT ; YES, THEN GO INSERT
04965 POP T2,(T1) ;MOVE 1 WORD UP IN CORE
04970 SOJA T1,BBLT1 ;DECR CORE ADDR & REPEAT
04975 >; END OF IFN %SS035
05000
05100 IFN %SS006, <
05200 INSCHK: TLNE FL2,CCHGF ;TEST FOR FILE PREVIOUSLY CHANGED THIS CMD
05300 JRST NOBLT0 ; YES, JUMP TO REPLACE DATA
05400 MOVN T1,NCNT ;GET -LTH OF CURRENT LINE
05500 JUMPE T1,CPOPJ ; & JUMP IF OLD=NEW=0 (NOTHING TO DO)
05600 TLNE FL2,PCHGF ;TEST FOR FILE PREVIOUSLY CHANGED THIS PASS
05700 JRST NOBLT ; YES, JUMP SINCE NO NEED TO COMPARE
05800 HRLZS T1 ;PUT -LTH INTO L.H.
05900 HRRI T1,(PNTR) ;GET ADDR OF OLD LINE IN R.H.
06000 SKIPA T2,[LIBUF] ;GET ADDR OF NEW LINE & SKIP
06100 INSCLP: ADDI T2,1 ;INCR ADDR OF NEW LINE
06200 MOVE T3,(T2) ;GET NEXT WD OF NEW DATA
06300 CAMN T3,(T1) ;TEST FOR SAME AS OLD DATA
06400 AOBJN T1,INSCLP ; YES, INCR & REPEAT
06500 JUMPGE T1,CPOPJ ;JUMP IF DONE, EXACTLY SAME, NOTHING TO DO
06600 JRST NOBLT ; ELSE JUMP TO SET BIT & REPLACE DATA
06700 >; END OF IFN %SS006
06800
06900 SUBTTL INSERT ROUTINE
00100 ;INSERT A LINE
00200
00300 CRTINS: ;;** FIX ** OCRLF ;TYPE <CR><LF> SOONER ;** FIX **
00400 MOVEI T1,1 ;SET TO START INSERTING AT LINE 100 PAGE 1
00500 MOVEM T1,HIPG
00590 IFE %SS027, <
00600 SKIPN T1,TECFST ;USE START IF GIVEN
00700 MOVE T1,[<ASCII /00100/>!1]
00710 >; END OF IFE %SS027
00720 IFN %SS027, <
00730 MOVE T1,TECINC ;GET DEFAULT INCREMENT
00740 EXCH T1,INCR ;STORE IT & SAVE ORIG INCREMENT
00750 MOVEM T1,TEMINC ;STORE ORIGINAL INCR FOR LATER
00760 MOVE T1,TECFST ;GET INITIAL LINE NUMBER
00770 >; END OF IFN %SS027
00800 MOVEM T1,HILN
00900 JRST INSGO ;AND AWAY WE GO
01000
01100 INSERT: ;HERE FOR INSERT COMMAND
01110 IFE %SS074, <
01120 TRNE FL,READOF ;ERROR IF READ-ONLY
01200 NERROR ILC
01250 >; END OF IFE %SS074
01300 PUSHJ P,SCAN
01400 TRNE FL,TERMF ;CHECK FOR NO ARGUMENTS
01500 JRST [MOVE T1,IPG
01600 MOVEM T1,HIPG
01700 MOVE T1,CURINS
01800 MOVEM T1,HILN
01810 IFN %SS017, <
01820 MOVE T1,IINCR ;GET SAVED INCR
01830 EXCH T1,INCR ;STORE IT & GET OLD VALUE
01840 MOVEM T1,TEMINC ;REMEMBER OLD VALUE
01850 >; END OF IFN %SS017
01900 JRST INSGO] ;GO BACK TO INSERTING WHERE YOU WERE
02000 PUSHJ P,GET1 ;GET ONE LINE/PAGE NUMBER
02100 TRNN FL,LINSN ;WAS /N GIVEN
02200 JRST INSMK ;YES: TREAT SPECIAL
02300 PUSHJ P,INSINC ;GET INCR IF ANY
02400 INSGO: PUSHJ P,DOINS ;DO THE INSERTS
02500 JRST COMND ;RETURN
02600
02700 INSINC: CAIN C,"," ;TRYING TO GIVE PERM INC?
02800 JRST GETINC ;YES - GO GET IT
02810 IFN %SS014, <
02820 CAIN C,"!" ;TEST FOR EXCLAMATION PT
02830 JRST [ ; YES, JUMP
02840 MOVE T1,INCR ;GET CURRENT INCR
02850 MOVEM T1,TEMINC ; & REMEMBER IT
02860 SETOM INCR ;SHOW # OF LINES GIVEN
02870 JRST GETINC ; & GO READ # OF LINES
02880 ]
02890 >; END OF IFN %SS014
02900 CAIE C,";" ;TEMP INC?
03000 JRST NOINC ;NOPE
03100 MOVE T1,INCR ;SAVE OLD INCR
03200 MOVEM T1,TEMINC
03300 PUSHJ P,GNCH ;LOOK AT NEXT CHAR
03400 CAIE C,"!" ;TRYING TO GIVE NUMBER OF LINES?
03500 JRST [MOVEM C,SAVC ;NO - BACK UP SCANNER
03600 JRST GETINC] ; AND READ INCR
03700 SETOM INCR ;YES - SET FLAG
03800 GETINC: PUSHJ P,SCAN ;GET THE NUMBER
03900 TRNE FL,NUMF ;WAS IT A NUMBER?
04000 CAMN T1,[<ASCII /00000/>!1] ;DO NOT PERMIT 0 INCR
04100 NERROR ILC ;HE WAS CONFUSED
04200 MOVEM T2,NLIN1 ;STASH DECIMAL
04300 SKIPL INCR ;SEE IF INCR WANTED
04400 MOVEM T1,INCR ;SET INCREMENT
04500 PUSHJ P,SCAN ;SCAN PAST IT
04600 NOINC: TRNN FL,TERMF ;TERMINATOR?
04700 NERROR ILC ;LOSE
04800 SETZM ALTSN ;CLEAR ALTMODE FLAG
04900 POPJ P, ;RETURN
05000
05100 DOINS: MOVE T1,HIPG ;GET THE PAGE TO GO TO
05200 MOVEM T1,DPG ;AND SET IT UP
05300 MOVE SINDEX,HILN ;ALSO LINE
05400 PUSHJ P,FIND ;GO GET UM
05500 MOVE T2,CPG ;DEMAND CORRECT PAGE MATCH
05600 CAME T2,HIPG
05700 NERROR NSP
05800 SKIPL INCR ;NEED TO COMPUTE ONE?
05900 JRST INSTRY ;NO -- JUST TRY TO INSERT
06000 MOVE T2,HILN ;YES -- SET UP FOR CALL
06100 MOVE T3,NLIN1
06110 IFN %SS031, <
06120 SETZM TRMFLG ;CLEAR FOR ROUNDED INCR
06130 >; END OF IFN %SS031
06200 PUSHJ P,GETDIF ;GET BEST FIT
06300 NERROR ILR ;WHOOPS
06400 MOVEM T1,HILN ;USE THESE VALUES
06500 MOVEM T2,INCR
06600 JRST INSLP
06690 IFE %SS054, <
06700 INSTRY: CAME T1,HILN ;DO THEY MATCH
06800 JRST INSLP ;YES - GO AHEAD
06900 MOVE T2,INCR ;NO - GO INVENT A NEW LINE
06905 >; END OF IFE %SS054
06910 IFN %SS054, <
06915 INSTRY: MOVE T2,HILN ;GET TARGET LINE #
06920 CAME T1,T2 ;TEST FOR ACTUAL .EQ. TARGET
06925 CAMN T2,[<ASCII /00000/>!1] ;TEST FOR TARGET .EQ. 00000
06930 SKIPA T2,INCR ; EITHER, SKIP & GET INCREMENT
06935 JRST INSLP ; ELSE START INSERTIONS
06940 CAME T1,HILN ;TEST FOR SAME LINE #
06945 SUBI PNTR,1 ; NO, BACK UP THE POINTER TO CANCEL
06950 ; THE CALL TO 'FINDN' IN 'FIXLIN'
06955 ; (LINE AT PRESENT POSITION FOUND)
06960 >; END OF IFN %SS054
07000 PUSHJ P,FIXLIN
07100 EXP HILN
07200 NERROR ILR ;NO ROOM
07300 MOVEM T2,HILN ;STORE NEW NUMBER
07400 INSLP: SETZM OCNT
07490 IFE %SS051, <
07500 SKIPE ALTSN ;ALTMODE SEEN?
07510 >; END OF IFE %SS051
07520 IFN %SS051, <
07530 SKIPN ALTSN ;TEST FOR ALTMODE SEEN
07540 PUSHJ P,CHKREN ;TEST FOR ^C TRAP
07550 ; EITHER MEANS END THE INSERT
07560 >; END OF IFN %SS051
07600 JRST LVINS ;YES: DONE
07700 MOVE T1,HILN ;TELL HIM THE LINE HE IS INSERTING
07800 MOVEM T1,LIBUF ;AND PUT IT IN THE BUFFER
07900 TRNN FL2,COMFLF!NONUMF ;IGNORE SQ # IF IN CMD FILE
08000 PUSHJ P,OUTSN ;PUT IT OUT
08100 PUSHJ P,RDLIN ;READ A LINE
08200 JRST LVINS ;YES, GET OUT OF INSERT MODE
08300 MOVEM T1,NCNT ;HERE IS THE COUNT OF THE NEW ONE
08400 PUSHJ P,INSED ;GO INSERT
08500 SOSN ISAVEN ;TIME TO SAVE?
08600 PUSHJ P,ASVINS ;YES: GO DO IT
08700 PUSHJ P,FINDN ;MOVE UP A LINE
08800 PUSHJ P,FILLB ;AND DUMP SOME IF NECESSARY
08900 MOVE T1,CPG ;SET CURRENT LINE AND PAGE TO LAST
09000 MOVEM T1,CPGL ;ONE REALLY INSERTED
09100 MOVE T1,HILN
09200 MOVEM T1,CLN
09300 MOVE T2,INCR ;GET NEXT LINE TO INSERT
09400 PUSHJ P,ASCIAD
09500 CAMG T1,INCR ;HAVE WE WRAPED AROUND
09600 JRST LVINS1 ;YES -- STOP
09700 MOVEM T1,HILN ;STORE FOR REFERENCE
09800 SKIPN T1,(PNTR) ;GET THE LINE POINTED TO
09900 JRST INSLP ;ALWAYS INSERT AT END OF FILE
10000 CAME T1,PGMK ;OR AT END OF PAGE
10100 CAMLE T1,HILN ;HAVE WE FOUND A MATCH OR PASSED OVER A LINE?
10200 JRST INSLP ;NO, INSERT
10300 JRST LVINS1 ;RETURN TO COMMAND LEVEL
10400
10500 LVINS: MOVE T1,HILN
10600 MOVEM T1,CURINS ;SET PLACE TO INSERT NEXT TIME
10700 MOVE T1,CPG
10800 MOVEM T1,IPG
10810 IFN %SS017, <
10820 MOVE T1,INCR ;GET CURRENT INCREMENT
10830 MOVEM T1,IINCR ; & REMEMBER IT
10840 >; END OF IFN %SS017
10900 LVINS1: TRNE FL2,COMFLF ;CMD FILE? ;** FIX **
11000 JRST LVINS2 ;YES SKIP CR
11100 SKIPE ALTSN ;ALT SEEN? ;** FIX **
11200 OCRLF ;YES -- OUTPUT CRLF
11300 LVINS2: SETZM ALTSN ;CLEAR ALTMODE FLAG
11400 POPJ P, ;RETURN
00100 ;ROUTINE TO COMPUTE INCREMENT AS DIFFERENCE OF
00200 ; TWO LINES / # OF LINES TO INSERT
00300 ;CALL:
00400 ; MOVE T1,<RESULT OF FIND>
00500 ; MOVE T2,<LINE TYPED(DESIRED)>
00600 ; MOVE T3,<# OF LINES TO INSERT>
00700 ; PUSHJ P,GETDIF
00800 ; <ERROR RETURN (IE NO ROOM)>
00900 ; <OK RETURN>
01000 ; C(T2) := COMPUTED INCR
01100 ; C(T1) := WHERE TO START INSERTING
01200
01300 GETDIF: PUSH P,T3 ;SAVE ARGS
01400 PUSH P,T2
01500 PUSH P,T1 ;SAVE RESULT OF FIND
01600 TLZE T3,(1B0) ;CHECK FOR SPECIAL
01700 JRST [MOVEM T3,-2(P) ;CORRECT ARG
01800 MOVEI T1,0 ;SAY EOF FOR FINDN
01900 JRST NOFND]
02000 CAMN T1,T2 ;ALREADY HAVE NEXT IF NOT EQUAL
02100 PUSHJ P,FINDN ;LOOK FOR NEXT LINE
02200 NOFND: SKIPE T3,T1 ;NONE IF EOF
02300 CAMN T1,PGMK ; OR PAGE MARK
02400 JRST [MOVEI T1,^D100000
02500 JRST NONXT] ;USE HIGHEST + 1
02600 PUSHJ P,NUMCON ;NEXT LINE # IN T1
02700 NONXT: PUSH P,T1 ;SAVE IT
02800 MOVE T3,-2(P) ;GET WHAT WAS TYPED
02900 CAMN T3,-1(P) ;DOES IT EXIST?
03000 SOS 0(P) ;YES - ALLOW FOR IT
03100 PUSHJ P,NUMCON ;CONVERT ARG
03190 IFE %SS054, <
03200 MOVE T2,T1 ;MOVE RESULT TO T2
03210 >; END OF IFE %SS054
03220 IFN %SS054, <
03230 SKIPN T2,T1 ;COPY STARTING LINE # & TEST FOR ZERO
03240 MOVEI T2,1 ; ZERO, SET TO 1 FOR COMPUTATIONS
03250 >; END OF IFN %SS054
03300 POP P,T1 ;RESTORE <NEXT>
03400 SUB T1,T2 ;GET DIFFERENCE
03500 IDIV T1,-2(P) ;(<NEXT>-<CURR>)/N
03590 IFE %SS031, <
03600 JUMPE T1,GOTZER ;DON'T FIT IF ZERO
03700 CAIGE T1,3 ;IF 1 OR 2 ITS THE BEST
03800 JRST GOTIT
03890 IFE %SS027, <
03900 MOVE T2,[-6,,[DEC 2,5,10,20,50,100,100001]]
03910 >; END OF IFE %SS027
03920 IFN %SS027, <
03930 MOVE T2,[-7,,[DEC 2,5,10,20,25,50,100,100001]]
03940 >; END OF IFN %SS027
04000 CAML T1,1(T2) ;LOOK FOR ITEM .GT. T1
04100 AOBJN T2,.-1
04200 JUMPGE T2,GOTZER ;CAN'T HAPPEN
04300 MOVE T1,0(T2) ;GET AESTHETIC INCR
04310 >; END OF IFE %SS031
04320 IFN %SS031, <
04330 MOVEM T1,BINCR ;STORE AS ACTUAL BINARY INCREMENT
04340 SKIPN TRMFLG ;TEST FOR ACTUAL INCREMENT REQUESTED
04350 PUSHJ P,TRIMNR ; NO, TRIM BACK TO SMOOTH VALUE
04360 JUMPE T1,GOTZER ;ERROR IF ZERO
04370 >; END OF IFN %SS031
04400 GOTIT: PUSHJ P,ASCON ;CONVERT TO INCR FORM
04405 IFN %SS027, <
04410 IFN %SS031, <
04415 SKIPE TRMFLG ;TEST FOR SMOOTH INCREMENT REQUESTED
04420 JRST GOTIT1 ; NO, JUMP
04425 >; END OF IFN %SS031
04430 SKIPN T2,TEMINC ;GET CURRENT DEFAULT INCR & TEST IT
04435 MOVE T2,INCR ; NONE, GET PERMANENT DEFAULT INCR
04440 CAMLE T3,T2 ;TEST FOR SMOOTH .GT. DEFAULT
04445 MOVE T3,T2 ; YES, JUST USE DEFAULT
04450 IFN %SS031, <
04455 GOTIT1:
04460 >; END OF IFN %SS031
04465 >; END OF IFN %SS027
04500 MOVE T2,T3 ;GET INTO CORRECT AC
04600 POP P,T1 ;GET BACK ARG
04700 MOVEM T2,-1(P) ;STORE COMPUTED INCR
04790 IFE %SS054, <
04800 CAME T1,0(P) ;FIGURE OUT START POINT
04900 JRST GETRET ;OK IF NOT FOUND
04910 >; END OF IFE %SS054
04920 IFN %SS054, <
04930 EXCH T1,0(P) ;SWAP FOUND & DESIRED SEQ #'S
04940 CAME T1,0(P) ;TEST FOR FOUND .EQ. DESIRED
04950 CAMN T1,[<ASCII /00000/>!1] ;TEST FOR DESIRED .EQ. 00000
04960 >; END OF IFN %SS054
05000 PUSHJ P,ASCIAD ;ELSE ADD INCR TO IT
05100 MOVEM T1,0(P) ; AND USE IT
05200 GETRET: POP P,T1 ;STARTING LINE #
05300 POP P,T2 ;INCR
05400 JRST CPOPJ1 ;GIVE GOOD RETURN
05500
05600 GOTZER: SUB P,[3,,3] ;PRUNE PDL
05700 POPJ P, ;ERROR RETURN
05800
05900 IFN %SS031, <
06000 TRIMNR: CAIGE T1,3 ;TEST FOR INCRMENT .LE. 2
06100 POPJ P, ; YES, RETURN (THE BEST ONE CAN DO)
06200 IFE %SS027, <
06300 MOVE T2,[-6,,[DEC 2,5,10,20,50,100,100001]]
06400 >; END OF IFE %SS027
06500 IFN %SS027, <
06600 MOVE T2,[-^D9,,[DEC 2,4,5,10,20,25,40,50,100,100001]]
06700 >; END OF IFN %SS027
06800 CAML T1,1(T2) ;LOOK FOR ITEM .GT. T1
06900 AOBJN T2,.-1
07000 SKIPL T2 ;TEST FOR INCRMENT FOUND
07100 TDZA T1,T1 ; NO, SET ZERO & SKIP
07200 MOVE T1,(T2) ; YES, GET IT
07300 POPJ P, ;RETURN TO CALLER
07400 >; END OF IFN %SS031
00100 ;ROUTINE TO GUESS AT A GOOD PLACE TO INSERT IF CURRENT LINE EXISTS
00200 ;CALL:
00300 ; MOVE T1,<CURRENT POSITION>
00400 ; MOVE T2,<INCREMENT TO USE>
00500 ; PUSHJ P,FIXLIN
00600 ; <LOC OF HIGH BOUND>
00700 ; <ERROR RETURN>
00800 ; <OK RETURN> ;NEW NUMBER IN T2
00900
01000 FIXLIN: AOS T4,0(P) ;SKIP OVER ARG
01100 PUSHJ P,ASCIAD ;ADD
01200 PUSH P,T1 ;SAVE RESULT
01300 PUSHJ P,FINDN ;GET THE NEXT ONE
01400 POP P,T2
01500 CAMG T2,@-1(T4) ;IS THERE A WAR PROBLEM
01600 JRST FIXBAD ;YES, WE MUST TRY TO COMPUTE ONE
01700 JUMPE T1,CPOPJ1 ;END OF FILE, ANY INC IS OK
01800 CAME T1,PGMK ;ALSO OK IF A PAGE MARK
01900 CAMGE T2,T1 ;OR IN CORRECT ORDER
02000 JRST CPOPJ1
02100 FIXBAD: CAME T1,PGMK
02200 SKIPN T1
02300 MOVE T1,[<ASCII /9999:/>!1] ;ONE OVER THE TOP OF THE WORLD
02400 MOVE T2,@-1(T4) ;GET CURRENT
02500 PUSHJ P,ASCAV ;FIND AVERAGE
02600 CAME T2,@-1(T4) ;THERE MAY HAVE ONLY BEEN A DIF OF 1
02700 AOS 0(P) ;SKIP RETURN
02800 POPJ P,
02900
03000 SUBTTL DELETE ROUTINE
00100 ;DELETE A LINE, A NUMBER OF LINES, OR A PAGE MARK
00200
00300 DELETE: SETZM LOLN ;JUST AS A START
00400 SETZM PGDELS ;NO PAGES DELETED
00490 IFE %SS074, <
00500 TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
00600 NERROR ILC
00610 >; END OF IFE %SS074
00700 PUSHJ P,GET2S ;GET TWO PAGE-LINE PAIRS
00800 TRZ FL,LINSN ;FOR NOW
00890 IFE %SS042, <
00900 CAIE C,"," ;CHECK SWITCH
01000 JRST DELT1
01100 PUSHJ P,SCAN
01200 MOVS T1,ACCUM
01300 TRNE FL,IDF
01400 CAIE T1,(<SIXBIT /Y />)
01500 NERROR ILC
01600 TRO FL,LINSN ;DON'T ASK
01700 PUSHJ P,SCAN
01710 >; END OF IFE %SS042
01720 IFN %SS042, <
01730 MOVEI SINDEX,[ ;POINT AT PARAMETER LIST
01740 SIXBIT /Y/
01750 TRO FL,LINSN
01760 EXP 0]
01770 PUSHJ P,SCNMOD ;SCAN FOR MODIFIER
01780 >; END OF IFN %SS042
01800 DELT1: TRNN FL,TERMF ;CHECK FOR TERMINATOR
01900 NERROR ILC
02000 PUSHJ P,DELSUB ;DO SOME DELETING
02090 IFE %SS053, <
02100 SKIPN PGDELS ;NEED TO DO ORDER CHECK
02200 JRST COMND ;NO - ALL OK
02300 JRST ORDCHK ;YES - DO IT
02310 >; END OF IFE %SS053
02320 IFN %SS053, <
02330 PUSHJ P,ORDCHK ;MAKE ORDER-CHECK
02340 NERROR ORDER ; ERROR, REPORT IT
02350 JRST COMND ;CONTINUE ON
02360 >; END OF IFN %SS053
02400
02500 ;SUBROUTINE TO DELETE LINES FROM A FILE - COUNTS NUMBER OF
02600 ;PAGE MARKS DELETED IN PGDELS
02700
02790 IFE %SS014, <
02800 DELSUB: TRNN FL,PGSN ;CHECK FOR MASSIVE DELETE
02810 >; END OF IFE %SS014
02820 IFN %SS014, <
02830 DELSUB: MOVE T1,HIPG ;GET ENDING PAGE #
02840 CAMN T1,LOPG ;TEST FOR SAME AS STARTING PAGE #
02850 >; END OF IFN %SS014
02900 SKIPN LOLN
03000 JRST [TRNN FL,EXTOG
03100 TRNE FL,LINSN
03200 JRST .+1
03300 OUTSTR [ASCIZ /Massive delete ok? /]
03400 PUSHJ P,CONFRM
03500 JRST COMND ;NO:
03600 JRST .+1] ;YES:
03700 TRZ FL,LINSN ;NONE SEEN YET
03800 MOVE T1,LOPG ;GET THE PAGE NUMBER
03900 MOVEM T1,DPG
04000 MOVE SINDEX,LOLN ;AND LINE
04100 PUSHJ P,FIND
04200 MOVE T2,CPG ;SEE WHERE WE ARE
04300 CAME T2,LOPG ;IS THIS OK
04400 NERROR NSP
04490 IFE %SS053, <
04500 SKIPN LOLN ;WANT WHOLE PAGE?
04600 TRO FL,LINSN ;YES - SAY WE DID IT
04605 >; END OF IFE %SS053
04610 IFN %SS053, <
04615 JUMPN SINDEX,DELSB1 ;JUMP IF 1ST LINE # SPECIFIED
04620 TRO FL,LINSN ;SHOW LINE SEEN IF "/N" RANGE
04625 SOJLE T2,DELSB1 ;JUMP IF PAGE 1 SPECIFIED
04630 PUSHJ P,FINDB ;FIND THE PRECEEDING PAGE-MARK
04635 CAME T1,PGMK ;TEST FOR PAGE-MARK FOUND
04640 NERROR ICN ; NO, INFERNAL CONFUSION
04645 SOS LOPG ;DECR 1ST PAGE # TO ACCOUNT FOR P/M
04650 >; END OF IFN %SS053
04700 DELSB1: PUSHJ P,ONMOV ;CHECK FOR RANGE
04800 JRST DELEND
04900 TRO FL,LINSN ;SEEN SOMETHING
05000 CAMN T1,PGMK ;PAGE MARK
05100 JRST DELPAG ;YES - DELETE PAGE
05200 MOVEM T1,CLN ;SAVE CURRENT LINE
05300 PUSHJ P,DODEL ;GO DO A LINE DELETE
05400 DELSB2: PUSHJ P,FINDN1 ;FIND NEXT BUT ACCEPT LINE IF ALREADY THERE
05500 JRST DELSB1 ;GO DO NEXT
05600
05700 DELPAG: MOVEI T1,2 ;SET TO DELETE PAGE
05800 MOVEM T1,OCNT
05900 SETZM NCNT ;NEW SIZE IS 0
06000 PUSHJ P,INSED ;ZAP
06100 AOS PGDELS ;INCR COUNT OF PAGES GONE
06200 AOS CPG ;BEWARE!!!
06300 SETZM LDELLN ;NO LINES ON THIS PAGE YET
06400 JRST DELSB2 ;CONTINUE
06500
06600 DELEND: TRNN FL,LINSN ;DO ANYTHING?
06700 NERROR NLN ;NO - GIVE ERROR
06800 MOVE T1,LOPG ;YES - SET CURRENT PAGE
06900 MOVEM T1,CPG ;AS THE ONE HE ASKED FOR
07000 MOVEM T1,CPGL ;...
07100 MOVN T1,PGDELS ;GET NEG # OF PAGES DELETED
07200 ADDM T1,BGPG ;ADJUST CNTRS
07300 ADDM T1,INPG ;TO SHOW CORRECT # OF PAGES
07400 POPJ P, ;RETURN
00090 IFE %SS053, <
00100 ;DELETE A PAGE MARK
00200
00300 KILL: SETZM LOLN ;A GOOD THING
00390 IFE %SS074, <
00400 TRNE FL,READOF
00500 NERROR ILC
00510 >; END OF IFE %SS074
00600 PUSHJ P,GET1S
00700 TRZN FL,LINSN
00800 TRNN FL,TERMF
00900 NERROR ILC
01000 DELPG: MOVE T1,HIPG ;GET THE DESIRED PAGE TO DELETE
01100 MOVEM T1,DPG ;SET IT
01200 SOJLE T1,DELER ;DO NOT TRY PAGE 1
01300 MOVEI SINDEX,0 ;GUARENTEED TO FIND LINE IMMEDIATELY AFTER PAGE MARK
01400 PUSHJ P,FIND ;GET IT
01500 MOVE T2,CPG ;CHECK FOR MATCH
01600 CAME T2,HIPG
01700 DELER: NERROR NSP ;NO SUCH PAGE
01750 MOVEM T2,CPGL ;STORE AS CURRENT PAGE ;** FIX **
01800 PUSHJ P,FINDB ;GO BACK ONE
01900 CAME T1,PGMK ;IS IT A PAGE MARK?
02000 NERROR ICN ;CONFUSED, GIVE FATAL ERROR
02100 MOVEI T1,2 ;COUNT IS 2
02200 MOVEM T1,OCNT
02300 SETZM NCNT ;AND NEW IS 0
02400 PUSHJ P,INSED
02500 SOS CPGL ;ONE LESS ALSO
02600 SOS BGPG ;MAX PAGE IS NOW 1 LOWER
02700 SOS INPG
02800 ORDCHK: PUSHJ P,FINDN1 ;GET THE NEXT LINE
02900 JUMPE T1,COMND ;IF EOF THERE IS NO ORDER ERROR
03000 CAMN T1,PGMK ;OR IF A PAGE MARK
03100 JRST COMND
03200 MOVEM T1,SVWD3 ;SAVE IT FOR COMPARE
03300 PUSHJ P,FINDB ;FIND THE PREVIOUS ONE
03400 JUMPE T1,COMND ;START OF FILE, ALL OK
03500 CAME T1,PGMK ;ANOTHER PAGE MARK
03600 CAMGE T1,SVWD3 ;CHECK THE ORDER
03700 JRST COMND ;ALL OK
03800 NERROR ORDER ;ALL WRONG
03900 >; END OF IFE %SS053
04000
04100 PAGE
04200
04300 IFN %SS053, <
04400
04500 ;DELETE ONE OR MORE PAGE MARKS
04600
04700 KILL: SETZM LOLN ;INIT THE 1ST LINE #
04800 IFE %SS074, <
04900 TRNE FL, READOF ;TEST FOR READ-ONLY
05000 NERROR ILC ; YES, ILLEGAL COMMAND
05100 >; END OF IFE %SS074
05200 PUSHJ P,GET2S ;READ THE RANGE
05300 SKIPN LOLN ;TEST FOR 1ST LINE # GIVEN
05400 TRNE FL,LINSN!CNTF ;TEST FOR 2D LINE #/LINE COUNT GIVEN
05500 NERROR ILC ; ANY LINE #, ILLEGAL COMMAND
05600 TRNN FL,TERMF ;TEST FOR END OF LINE
05700 NERROR ILC ; YES, ILLEGAL COMMAND
05800 TRZ FL,ORDF!LINSN ;CLEAR ORDER-ERROR & LINE-SEEN FLAGS
05900 MOVE T1,LOPG ;GET 1ST PAGE #
06000 MOVEM T1,DPG ;STORE AS DESIRED PAGE #
06100 SOJG T1,KIL010 ;JUMP IF NOT PAGE 1
06200 AOS DPG ; PAGE 1, INCR TO PAGE 2 SINCE
06300 AOS LOPG ; THERE IS NO PAGE 1 P/M
06400 KIL010: SETZ SINDEX, ;CLEAR LINE #
06500 PUSHJ P,FIND ;FIND LINE FOLLOWING P/M
06600 MOVE T2,CPG ;GET CURRENT PAGE
06700 CAME T2,LOPG ;TEST FOR RIGHT PAGE FOUND
06800 JRST KIL020 ; NO, DONE
06900 TRO FL,LINSN ; YES, SET A FLAG NOW (P/M SEEN)
07000 CAMG T2,HIPG ;TEST FOR RANGE EXCEEDED
07100 PUSHJ P,CHKREN ;TEST FOR RE-ENTRY
07200 JRST KIL020 ; EITHER, DONE NOW
07300 MOVEM T2,CPGL ;STORE AS LOGICAL PAGE #
07400 PUSHJ P,FINDB ;FIND THE PAGE-MARK
07500 CAME T1,PGMK ;TEST FOR PAGE-MARK
07600 NERROR ICN ; NO, INTERNAL CONFUSION ERROR
07700 MOVEI T1,2 ;GET COUNT OF 2
07800 MOVEM T1,OCNT ;STORE AS OLD COUNT
07900 SETZM NCNT ;CLEAR THE NEW COUNT
08000 PUSHJ P,INSED ;DELETE THE PAGE-MARK
08100 SOS CPGL ;DECR PAGE #'S
08200 SOS BGPG ; DITTO
08300 SOS INPG ; DITTO
08400 SOS HIPG ; DITTO
08500 AOS PGDELS ;INCR # OF DELETED PAGES
08600 PUSHJ P,ORDCHK ;CHECK FOR FILE MIS-ORDERED
08700 TRO FL,ORDF ; YES, SET A FLAG
08800 SKIPN T1,SVWD3 ;GET NEXT LINE # & TEST IT
08900 MOVE T1,TECFST ; ZERO, GET 'START' LINE #
09000 MOVEM T1,CLN ;SET FOR THE CURRENT LINE
09100 JRST KIL010 ; & REPEAT FOR THE NEXT PAGE
09200 KIL020: TRZE FL,ORDF ;TEST FOR ORDER ERROR
09300 NERROR ORDER ; YES, TELL THE USER
09400 TRZN FL,LINSN ;TEST FOR ANYTHING FOUND
09500 NERROR NSP ; NO, ERROR
09600 JRST COMND ;CONTINUE ON
09700
09800 ORDCHK: SETZM SVWD3 ;CLEAR THE NEXT SAVED LINE #
09900 SKIPN PGDELS ;TEST FOR PAGES DELETED
10000 JRST CPOPJ1 ; NONE, RETURN +1
10100 PUSHJ P,FINDN1 ;FIND THE NEXT/CURRENT LINE
10200 CAME T1,PGMK ;TEST FOR PAGE-MARK
10300 MOVEM T1,SVWD3 ; NO, STORE LINE # (OR 0)
10400 PUSHJ P,FINDB ;FIND THE PRECEEDING LINE
10500 SKIPE T1 ;TEST FOR BEGINNING OF FILE
10600 CAMN T1,PGMK ;TEST FOR PRECEEDING PAGE-MARK
10700 JRST CPOPJ1 ; EITHER, RETURN +1 SINCE IN ORDER
10800 SKIPN SVWD3 ;TEST FOR NEXT LINE # STORED
10900 JRST [ ; NO, JUMP
11000 MOVEM T1,SVWD3 ;STORE PRECEEDING LINE #
11100 JRST CPOPJ1] ; & RETURN +1
11200 CAMGE T1,SVWD3 ;TEST FOR ADJACENT LINES IN ORDER
11300 AOS (P) ; YES, INCR FOR +1 RETURN
11400 POPJ P, ;RETURN TO CALLER (+0 OR +1)
11500 >; END OF IFN %SS053
11600
11700 SUBTTL INSERT PAGE MARK
00100
00200 ;INSERT A PAGE MARK AT DESIGNATED LINE
00300
00400 MARK: SETZM HILN ;IN CASE OF /A
00490 IFE %SS074, <
00500 SKIPN BASICF ;ILLEGAL IN BASIC MODE
00600 TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
00610 >; END OF IFE %SS074
00620 IFN %SS074, <
00630 SKIPE BASICF ;ILLEGAL IN BASIC MODE
00640 >; END OF IFN %SS074
00700 NERROR ILC
00800 PUSHJ P,GET1S ;GET ONE LINE/PAGE NUMBER
00900 TRNN FL,TERMF ;CHECK FOR TERMINATOR
01000 NERROR ILC
01100 PUSHJ P,MARK0 ;INSERT PAGE MARK
01200 JRST COMND ;RETURN TO COMMAND LEVEL
01300
01400 MARK0: MOVE T1,HIPG ;GO LOOK FOR IT
01500 MOVEM T1,DPG
01600 MOVE SINDEX,HILN ;AND THE LINE
01700 PUSHJ P,FIND ;GET IT
01800 MOVE T1,CPG
01900 CAME T1,HIPG ;PAGE MUST MATCH
02000 NERROR NSP ;MUST MATCH
02010 IFN %SS055!%SS056, <
02020 MARKIT: ;S/R TO COMPLETELY INSERT A PAGE-MARK
02030 >; END OF IFN %SS055!%SS056
02100 AOS T1,CPG ;WILL BE ON HIGHER PAGE WHEN DONE
02200 MOVEM T1,CPGL ;SET UP LOGICAL PAGE
02300 AOS BGPG ;THERE IS NOW ONE MORE
02400 AOS INPG
02490 IFE %SS027, <
02500 MOVE T1,[<ASCII /00100/>!1]
02510 >; END OF IFE %SS027
02520 IFN %SS027, <
02530 MOVE T1,TECFST ;GET STARTING LINE #
02540 >; END OF IFN %SS027
02600 MOVEM T1,CLN ;FIRST LINE ON THAA PAGE
02610 IFN %SS056, <
02620 MARKER: ;S/R TO INSERT A PAGE-MARK
02630 >; END OF IFN %SS056
02700 MOVE T1,PGMK ;PUT A PAGE MARK IN LIBUF
02800 MOVEM T1,LIBUF
02900 MOVE T1,PGMKW2 ;TEXT OF A PAGE MARK
03000 MOVEM T1,LIBUF+1
03100 SETZM OCNT ;THIS IS A STRAIGHT INSEET
03200 MOVEI T1,2 ;OF 2 WORDS
03300 MOVEM T1,NCNT
03400 PUSHJ P,INSED ;GO DO IT
03500 PUSHJ P,FINDN ;SINCE FILLB MAY WANT TO DUMP THIS LINE
03600 JUMPE T1,FILLB ;SKIP IF EOF SEEN
03700 CAME T1,PGMK ;CHECK IF EMPTY
03800 MOVEM T1,CLN ;NO; USE THIS LINE
03900 JRST FILLB ;FILL BUFFER
04000
04100 INSMK: TRNN FL,TERMF ;GRNTEE TERM
04200 NERROR ILC
04300 SETZM ALTSN ;NO ESC SEEN YET
04400 MOVE T1,[<ASCII /9999:/>!1]
04500 MOVEM T1,HILN ;ONE PAST END OF WORLD
04600 PUSHJ P,MARK0 ;INSERT PAGE-MARK
04700 MOVE T1,CLN ;GET CURRENT LINE
04800 MOVEM T1,HILN
04900 MOVE T1,CPG ;AND CURRENT PAGE
05000 MOVEM T1,HIPG ;SET UP FOR INSERT
05100 JRST INSGO ;GO
05200
05300 SUBTTL RENUMBER
00100
00200 ;RENUMBER SELECTED LINES
00300
00390 IFE %SS027, <
00400 NUMBER: MOVE T1,[<ASCII /00100/>!1] ;IF NO INCR IS SEEN
00410 >; END OF IFE %SS027
00420 IFN %SS027, <
00430 NUMBER: MOVE T1,INCR ;GET DEFAULT INCREMENT
00440 >; END OF IFN %SS027
00500 MOVEM T1,REINC ;WE WILL USE 100
00590 IFE %SS026, <
00600 MOVEM T1,INCST
00700 MOVEM T1,REFST ;SAVE FOR NEW PAGE
00710 >; END OF IFE %SS026
00720 IFN %SS026, <
00730 SETZM INCST ;CLEAR STARTING LINE #'S
00740 SETZM REFST ; DITTO
00750 >; END OF IFN %SS026
00800 SETZM LOLN ;GET THIS SET TO START THINGS OFF
00890 IFE %SS074, <
00900 TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
01000 NERROR ILC
01010 >; END OF IFE %SS074
01020 IFN %SS047, <
01030 PUSHJ P,CHKBAS ;CHECK FOR /BASIC OPERATION
01040 >; END OF IFN %SS047
01100 TRZ FL2,ACONST!MONOF
01200 PUSHJ P,GNCH ;GET NEXT CHAR
01300 MOVEM C,SAVC ;SAVE IN CASE WE NEED IT
01400 ANDI C,137 ;FORCE UPPER
01500 CAIN C,"A"
01600 TRO FL2,ACONST ;ADD CONSTANT
01700 CAIN C,"P"
01800 TRO FL2,MONOF ;NO RESET ON PAGE MARK
01900 TRNE FL2,ACONST!MONOF
02000 SETZM SAVC ;GOT ONE - DON'T BACK UP SCANNER
02100 PUSHJ P,SCAN ;GET THE RENUMBER INCREMENT
02200 TRNE FL,NUMF ;WAS IT A NUMBER
02300 CAMN T1,[<ASCII /00000/>!1] ;NO 0 RENUMBER INCR
02400 JRST NUMBC ;NO NUMBER, CHECK FOR COMMA
02500 MOVEM T1,REINC ;THE INCREMENT TO USE
02590 IFE %SS026, <
02600 MOVEM T1,INCST ;LINE TO START WITH
02610 >; END OF IFE %SS026
02700 MOVEM T1,REFST
02800 PUSHJ P,SCAN ;SCAN PAST NUMBER
02900 NUMBC: ;HERE AFTER INCREMENT SCANNED
02910 IFE %SS014, <
02920 CAIN C,"," ;AND CHECK FOR COMMA
03000 JRST NUMB1 ;GET A RANGE
03010 >; END OF IFE %SS014
03100 MOVEI T1,1 ;NO RANGE, DO WHOLE FILE
03200 MOVEM T1,LOPG ;FROM PAGE 1
03300 MOVSI T1,1 ;TO IMPOSSIBLY HIGH
03400 MOVEM T1,HIPG
03500 TRZ FL,CNTF ;MAKE SURE THIS IS OFF
03510 IFN %SS014, <
03520 CAIE C,"," ;SKIP IF COMMA TO READ RANGE
03530 >; END OF IFN %SS014
03600 JRST NUMBL ;AND CHECK FOR TERMINATOR
03690 IFE %SS014, <
03700 NUMB1: PUSHJ P,GET2S ;GET A RANGE
03710 >; END OF IFE %SS014
03720 IFN %SS014, <
03730 PUSHJ P,SCAN ;PRE-SCAN FOR NEXT ATOM
03740 TRNE FL,TERMF ;TEST FOR END OF LINE
03750 JRST NUMBL ; YES, JUMP (RANGE DEFAULTS)
03760 CAIE C,"," ;TEST FOR 2D COMMA (NULL RANGE)
03770 PUSHJ P,GET2 ; NO, READ RANGE
03780 >; END OF IFN %SS014
03800 CAIE C,"," ;SEE IF THERE IS A FOURTH ARGUMENT
03900 JRST NUMBL ;NO
04000 PUSHJ P,SCAN ;YES, GET IT
04100 TRNN FL2,ACONST ;ILLEGAL IF ADD MODE
04200 TRNN FL,NUMF ;IS IT A NUMBER?
04300 NERROR ILC ;HE WOULD HAVE BEEN BETTER OFF WITHOUT IT
04360 IFE %SS026, <
04370 IFN %SS054, <
04380 CAME T1,[<ASCII /00000/>!1] ;SKIP IF 00000 STARTING LINE #
04390 >; END OF IFN %SS054
04400 MOVEM T1,REFST
04410 >; END OF IFE %SS026
04420 IFN %SS054, <
04430 CAME T1,[<ASCII /00000/>!1] ;SKIP IF 00000 STARTING LINE #
04440 >; END OF IFN %SS054
04500 MOVEM T1,INCST ;USS AS STARTING NUMBER
04600 PUSHJ P,SCAN ;SCAN PAST IT
04605 IFN %SS026, <
04610 CAIE C,"," ;TEST FOR 4TH ARGUMENT
04615 JRST NUMBL ; NO, JUMP
04620 PUSHJ P,SCAN ;SCAN FOR IT
04625 TRNN FL2,MONOF ;TEST FOR 'NP'
04630 TRNN FL,NUMF ;TEST FOR A NUMBER
04635 NERROR ILC ; ERROR IF 'NP' OR NOT A NUMBER
04640 IFN %SS054, <
04645 CAME T1,[<ASCII /00000/>!1] ;SKIP IF 00000 STARTING LINE #
04650 >; END OF IFN %SS054
04655 MOVEM T1,REFST ;STORE AS SUBSEQ PAGE STARTING LINE #
04660 PUSHJ P,SCAN ;FIND OUT WHAT COMES NEXT
04665 >; END OF IFN %SS026
04700 NUMBL: TRNN FL,TERMF ;ENDS PROPERLY?
04800 NERROR ILC ;LOSE
04900 MOVE T1,LOPG ;GET PLACE TO START
05000 MOVEM T1,DPG
05100 MOVE SINDEX,LOLN ;AND LINE
05200 PUSHJ P,FIND ;GET IT
05300 TRZ FL,LINSN!ORDF ;SET TO NONE SEEN AND NO ORDER ERROR
05400 PUSHJ P,FINDB ;BACK UP AND SEE HOW ORDER LOOKS
05500 JUMPE T1,NUMB5 ;START OF FILE IT MUST BE OK
05600 CAME T1,PGMK ;ALSO IF A PAGE MARK
05700 CAMGE T1,INCST ;OR IF IN CORRECT ORDER
05790 IFE %SS026, <
05800 SKIPA
05900 TRO FL,ORDF ;WRONG SET FLAG
06000 NUMB5: PUSHJ P,FIND ;GET THE CORRECT LINE BACK
06005 >; END OF IFE %SS026
06010 IFN %SS026, <
06015 JRST NUMB5 ;JUMP IF STARTING # IN CORRECT ORDER
06017 SKIPE INCST ;SKIP IF DEFAULTING STARTING LINE #
06020 NERROR ISLN ; ELSE GIVE 'ILLEGAL STARTING LINE NUMBER' ERROR
06025 NUMB5: MOVE T2,TECFST ;GET DEFAULT STARTING LINE #
06030 SKIPN REFST ;TEST FOR SUBSEQ. PAGE LINE # DEFINED
06035 MOVEM T2,REFST ; NO, THEN DEFAULT IT
06040 SKIPE INCST ;TEST FOR STARTING LINE # GIVEN
06045 JRST NUMB6 ; YES, JUMP
06050 SKIPN T2,LOLN ;GET 1ST LINE # IN RANGE
06055 MOVE T2,REFST ; FULL PAGE, GET 2D-PAGE STARTING #
06060 CAME T1,PGMK ;TEST FOR PAGE MARK
06065 SKIPN T1 ;TEST FOR BEGINNING OF FILE
06070 MOVE T2,REFST ; EITHER, USE SUBSEQ-PAGE STARTING #
06075 MOVEM T2,INCST ;STORE AS STARTING LINE #
06080 NUMB6: PUSHJ P,FIND ;FIND REQUESTED LINE
06085 >; END OF IFN %SS026
06100 NUMB2: PUSHJ P,ONMOV ;CHECK RANGE
06200 JRST NUMB3
06300 CAMN T1,PGMK ;PAGE MARK?
06400 JRST NUMB4 ;SPECIAL TREATMENT
06500 TRNE FL2,ACONST ;JUST ADD CONSTANT
06600 JRST [MOVE T1,(PNTR) ;YES - USE OLD LINE #
06700 TRO FL,LINSN ;SAY WE'VE SEEN ONE
06800 JRST NUMB2A]
06900 MOVE T1,INCST ;GET STAATING NUMBER
07000 NUMB2A: MOVE T2,REINC ;AND INCREMENT
07100 TRON FL,LINSN ;WAS A LINE SEEN?
07200 JRST FSTLIN ;NO, FIRST ONE IS SPECIAL
07300 PUSHJ P,ASCIAD ;SKIP THIS THE FFRST TIME
07400 CAMGE T1,REINC ;HAVE WE WRAPED
07500 JRST [RERROR WAR ;TELL HIM HE LOST
07600 MOVE T2,CPG ;PRINT THE PAGE
07700 PUSHJ P,PGPRN
07800 JRST .+1] ;RETURN
07900 FSTLIN: MOVEM T1,INCST ;SAVE FOR NEXT LINE
08000 MOVEM T1,CLN ;AND THE CURRENT LINE
08010 IFN %SS006, <
08020 CAME T1,(PNTR) ;TEST FOR LINE # CHANGING
08030 TLO FL2,ALLCHG ; YES, THEN FILE CHANGED
08040 >; END OF IFN %SS006
08100 MOVEM T1,(PNTR) ;PUT IT IN
08200 PUSHJ P,FINDN ;GET NEXT
08300 JRST NUMB2 ;AND GO RANGE CHECK
08400
08500 NUMB3: TRNN FL,LINSN ;DONE, WAS THERE SOMETHING THERE?
08600 NERROR NLN ;NO, NULL RANGE ERROR
08690 IFE %SS006, <
08700 TLO FL2,ALLCHG ;CHANGES
08710 >; END OF IFE %SS006
08800 MOVE T2,CPG ;SET UP CURRENT PAGE
08900 MOVEM T2,CPGL
08990 IFE %SS026, <
09000 TRNE FL,ORDF ;WAS THERE AN ORDER ERROR?
09100 NERROR ORDER ;YES, FLAG IT
09110 >; END OF IFE %SS026
09200 JUMPE T1,COMND ;CHECK TO SEE IF LOSAGE NOW
09300 CAME T1,PGMK
09400 CAMLE T1,INCST
09500 JRST COMND
09600 NERROR ORDER
09700
09800 NUMB4: ;PAGE MARK
09900 AOS CPG ;NOW ON A HIGHER PAGE
10000 MOVE T1,[<ASCII /00000/>!1]
10100 MOVEM T1,CLN ;SET TO FIRST LINE ON PAGE
10200 TRO FL,LINSN ;WE SAW ONE
10300 PUSHJ P,FINDN ;GET NEXT LINE
10400 PUSHJ P,ONMOV ;IN RANGE?
10500 JRST NUMB3 ;NO - FINISHED
10600 CAMN T1,PGMK ;ANOTHER P. M.
10700 JRST NUMB4
10800 MOVE T1,REFST ;FIRST LINE #
10900 TRNN FL2,ACONST!MONOF
11000 JRST FSTLIN ;IF NOT SPECIAL
11100 MOVE T1,REINC ;ELSE GET INC
11200 TRNN FL2,MONOF
11300 SKIPA T2,(PNTR) ;CURRENT LINE FOR "NA"
11400 MOVE T2,INCST ;ELSE LAST LINE FOR "NP"
11500 PUSHJ P,ASCIAD ;DO ARITHMETIC
11600 JRST FSTLIN ;STASH NUMBER
11700
11800 SUBTTL ALTER COMMAND
00100 ALTER: SETZM LOLN ;FOR START OF PAGE
00200 PUSHJ P,GET2S ;GET THE RANGE
00204 IFN %SS040, <
00208 TRZ FL2,DOEXCT ;ASSUME NOT EXACT
00212 SKIPE EXACTF ;TEST FOR /EXACT
00216 TRO FL2,DOEXCT ; YES, SET THE FLAG
00220 IFE %SS042, <
00224 CAIE C,"," ;TEST FOR A COMMA
00228 JRST ALT0 ; NO, JUMP
00232 PUSHJ P,SCAN ;GET THE NEXT ATOM
00236 MOVS T1,ACCUM ; & PUT IT INTO AN AC
00240 CAIE T1,'E ' ;TEST FOR ",E"
00244 NERROR ILC ; NO, ERROR
00248 TRC FL2,DOEXCT ; YES, INVERT THE DEFAULT
00252 PUSHJ P,SCAN ;GET THE NEXT ATOM
00256 ALT0: ;HERE AT (HOPEFULLY) END OF LINE
00260 >; END OF IFE %SS042
00264 IFN %SS042, <
00268 MOVEI SINDEX,[ ;POINT AT MODIFIER PARMS
00272 SIXBIT /E/
00276 TRC FL2,DOEXCT
00280 EXP 0
00284 ]
00288 PUSHJ P,SCNMOD ;SCAN FOR THE MODIFIER
00292 >; END OF IFN %SS042
00296 >; END OF IFN %SS040
00300 TRNN FL,TERMF ;CHECK FOR PROPER END
00400 NERROR ILC ;UNEND
00500 MOVE T1,LOPG ;START TO PROCESS
00600 MOVEM T1,DPG
00700 MOVE SINDEX,LOLN
00800 PUSHJ P,FIND ;GO GET IT
00900 TRZ FL,LINSN ;NOT SEEN YET
01000 ALT1: PUSHJ P,ONMOV ;CHECK FOR IN RANGE
01100 JRST ALT2 ;NO, FINISH UP
01200 TRO FL,LINSN ;WE DID SEE SOMETHING
01300 CAMN T1,PGMK ;CHEC FOR A PAGE
01400 JRST ALT3 ;DO NNT TRY TO CHANGE THIS
01500 MOVEM T1,CLN ;NOW, IN CASE WE SAID ALTMODE
01600 MOVE T1,CPG ;SAME FOR PAGE
01700 MOVEM T1,CPGL
01800 PUSHJ P,ALTLIN ;GO DO THE ALTER
01900 JRST LEVINS ;HE SAID ALTMODE
02000 PUSHJ P,INSED ;GO INSERT
02100 ALT4: PUSHJ P,FINDN ;GET THE NEXT LINE
02200 PUSHJ P,FILLB ;AND CHECK FOR BUFFER OVERFLOW
02300 MOVE T1,(PNTR) ;GET LINE FOR ONMOV
02400 JRST ALT1 ;CONTINUE LOOP
02500 ALT3: AOS T2,CPG ;WE ARE ON A LATER PAGE NOW
02600 MOVEM T2,CPGL ;SAVE AS .
02700 TRNN FL2,NONUMF ;SKIP IF IN NONUMBER MODE
02800 PUSHJ P,PGPRN ;PRINT HIM A MESSAGE
02900 MOVE T1,[<ASCII /00000/>!1] ;SET TO FIRST? LINE
03000 MOVEM T1,CLN ;FOR .
03100 JRST ALT4 ;CONTINUE PAST IT
03200 ALT2: TRNN FL,LINSN ;WAS THERE ANYTHING THERE?
03300 NERROR NLN ;NO, GIVE ERROR
03400 MOVE T1,CPG ;|ET CURRENT PAGEE
03500 MOVEM T1,CPGL ;SAVE AS .
03600 JRST COMND ;GO
00100 ALTLIN: PUSHJ P,SETALT ;SET UP LINE FOR ALTERATION
00200
00300 ALTN1:
00400 ALTLP2: MOVEI T2,0 ;ZERO REPEAT COUNT
00500 TLZ FL,NEGF ;TURN OFF "-" SEEN FLG
00600 ALTLP: TRZ FL2,ALTDUP ;TURN DUPLEXING BACK OFF
00700 PUSHJ P,GNCH1 ;GET ON CHR IN DDT SUBMODE
00710 IFN %SS005, <
00720 ANDI C,377 ;TRIM TO 8 BITS
00730 CAME ALTP,[POINT 7,LIBUF+1,13] ;TEST FOR BEGINNING OF THE LINE
00740 TRZ FL2,ALTBOL ; NO, THEN CLEAR THE BIT
00750 >; END OF IFN %SS005
00800 TLNE CS,LETF_16 ;CHECK FOR LETTER
00900 TRZ C,40 ;AND CONVERT TO UPPER CASE
01000 MOVSI T1,-ALTLG ;GET LENGTH OF COMMAND TABLE
01100 CAME C,ALTAB1(T1) ;CHECK FOR EQUAL
01200 AOBJN T1,.-1 ;NO, TRY AGAIN
01290 IFE %SS005, <
01300 JUMPGE T1,[CAIN C,15 ;IGNORE CR'S
01400 JRST ALTLP
01500 JRST ALTBEL]
01510 >; END OF IFE %SS005
01520 IFN %SS005, <
01530 JUMPGE T1,ALTBEL ;ERROR IF NOT FOUND
01540 >; END OF IFN %SS005
01600 MOVE T1,ALTAB2(T1) ;GET TABLE ENTRY IN T1
01700 JUMPL T1,ALTDSP ;"-" ALLOWED IF NEG.
01800 TLNN FL,NEGF ;NO: IS IT SET?
01900 JRST ALTDSP ;OK TO EXECUTE COMMAND
02000 ALTBEL: OUTCHR [7] ;BONG A GONG
02100 CLRBFI ;CLEAR TYPE AHEAD
02200 JRST ALTLP2 ;TRY AGAIN
02300
02400 ALTDSP: TLNN T1,(1B1) ;OK IN ALL MODES?
02500 TRNN FL,READOF ;NO -- CHECK R/O
02600 SKIPA ;YES -- DISPATCH
02700 JRST ALTBEL ;R/O RING BELL
02800 PUSHJ P,0(T1) ;DISPATCH
02900 JRST ALTLP2 ;RESET REPEAT COUNT AND GET NEW COMMAND
03000 JRST ALTLP ;SKIP RETURN FROM DIGITS NO COUNT RESET
03100
03190 IFE %SS005, <
03200 ALTAB1: EXP " ","I","D","S","K","Q",12
03300 EXP "C",177,"U"-100,"W","X"
03400 EXP "R","L","P","J","E","-",10,11
03410 IFN %SS057, <
03420 EXP "V"
03430 >; END OF IFN %SS057
03500 EXP "1","2","3","4","5","6","7","8","9","0" ;** FIX **
03600 ALTLG=.-ALTAB1
03700
03800 ALTAB2: EXP <1B1+ALTSP>,ALTIN
03900 EXP <1B0+ALTDL>,<3B1+ALTSR>,<1B0+ALTKL>
04000 EXP <1B1+ALTALT>,<1B1+ALTFN>,ALTCN
04100 EXP <1B1+ALTBS>,<1B1+ALTCU>,<1B1+ALTWD>,ALTWX,<1B0+ALTRP>
04200 EXP <1B1+ALTLN>,<1B1+APRINT>,AJOIN,<1B1+ALTEX>
04300 EXP <1B1+ALTNEG>,<1B1+ALTBS>,<3B1+ALTTB>
04310 IFN %SS057, <
04320 EXP ALTVER
04330 >; END OF IFN %SS057
04400 REPEAT ^D10,<<3B1+ALTDG>>
04410 >; END OF IFE %SS005
04500
04502 IFN %SS005, <
04504 ALTAB1: EXP " ","I","D","S","K","Q",15
04506 EXP "C",177,"U"-100,"W","T","U"
04508 EXP "R","L","P","J","E","-",10,11
04510 EXP "X","R"-100,"^",074,076,200,"B","@"
04512 IFN %SS057, <
04514 EXP "V"
04516 >; END OF IFN %SS057
04518 EXP "1","2","3","4","5","6","7","8","9","0"
04520 ALTLG==.-ALTAB1
04522
04524 OKNEG==(1B0) ;CMD PERMITTED AFTER NEGATIVE SIGN
04526 OKREAD==(1B1) ;CMD PERMITTED FOR /READONLY
04528 OKXCT==(1B2) ;CMD PERMITTED AS SUBJECT OF "@"
04530 OKXEOL==(1B3) ;CMD PERMITTED TO EXECUTE TO END OF LINE
04532
04534 ALTAB2: EXP <OKNEG!OKREAD!OKXCT!OKXEOL,,ALTSP>,ALTIN ;<SP>,I
04536 EXP <OKNEG!OKXCT,,ALTDL>,<OKNEG!OKREAD,,ALTSR> ;D,S
04538 EXP <OKNEG,,ALTKL>,<OKNEG!OKREAD,,ALTALT> ;K,Q
04540 EXP <OKNEG!OKREAD,,ALTFNZ>,<OKXCT,,ALTCN> ;<CR>,C
04542 EXP <OKNEG!OKREAD,,ALTBSS>,<OKNEG!OKREAD,,ALTCU> ;<RO>,^U
04544 EXP <OKREAD,,ALTWD>,ALTWX,ALTWK,<OKNEG,,ALTRP> ;W,T,U,R
04546 EXP <OKREAD,,ALTLN>,<OKREAD,,APRINT>,AJOIN ;L,P,J
04548 EXP <OKNEG!OKREAD,,ALTEX>,<OKREAD,,ALTNEG> ;E,-
04550 EXP <OKNEG!OKREAD,,ALTBSS>,<OKNEG!OKREAD,,ALTTB> ;<RO>,<HT>
04552 EXP <OKNEG,,ALTEOL>,<OKNEG!OKREAD,,ALTECH> ;X,^R
04554 EXP <OKNEG!OKXCT,,ALTCHG>,<OKNEG!OKXCT,,ALTUPS> ;^,<
04556 EXP <OKNEG!OKXCT,,ALTDWN>,<OKNEG!OKREAD,,ALTIGN> ;>,<ESC>
04558 EXP <OKNEG!OKREAD,,ALTNL>,<OKNEG!OKREAD,,ALTXCT> ;B,@
04560 IFN %SS057, <
04562 EXP <OKXCT,,ALTVER> ;V
04564 >; END OF IFN %SS057
04566 REPEAT ^D10,<<OKNEG!OKREAD,,ALTDG>> ;0-9
04568 IFN <ALTLG-<.-ALTAB2>>,<PRINTX ?ALTER BRANCH TABLE DEFINITION ERROR>
04570 >; END OF IFN %SS005
04572
04600 ALTNEG: TLO FL,NEGF
04610 IFN %SS005, <
04620 JUMPN T2,ALTXCE ;ERROR IF COUNT ALREADY GIVEN
04630 >; END OF IFN %SS005
04700 JRST CPOPJ1
00100
00200 SETALT: SETZM LIBUF ;ZERO OUT INTERNAL LINE BUFFER
00300 MOVE T1,[XWD LIBUF,LIBUF+1]
00400 BLT T1,LIBUF+MXWPL+1
00500 MOVEI T1,LIBUF ;SET POINTER TO TRANSFER
00600 MOVE T2,PNTR
00700 MOVE T3,(T2) ;GET THE FIRST WORD (SEQ NUM)
00800 JRST SALT3
00900 SALT2: SKIPE T3,(T2) ;PICK UP A WORD AND CHECK FOR 0
01000 TRNE T3,1 ;CHECK FOR SEQ NTM
01100 JRST SALT1 ;END OF THIS LINE
01200 SALT3: MOVEM T3,(T1) ;SAVE IT AWAY
01300 ADDI T1,1 ;INCREMENT POINTERS
01400 AOJA T2,SALT2
01500 SALT1: MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET UP POINTER
01510 IFN %SS005, <
01520 TRO FL2,ALTBOL ;SHOW AT BEGINNING OF LINE NOW
01530 >; END OF IFN %SS005
01600 SETZM ALTCNT ;SO FAR WE ARE 0 CHRS INTO LINE
01700 SUBI T1,LIBUF ;GET COUNT OF OLD LINE
01800 HRRZM T1,OCNT ;AND SAVE IT FOR INSED
01900 OFFECHO ;TURN OFF EHCO
02000 TRZ FL2,RUBF!ALTDUP!RUBF2 ;TURN OFF IN RUBOUT FALG AND NO DUPLEXING
02100 SETZM ALTFLG ;NOTHING INSERTED SO FAR
02200 TRNE FL2,NONUMF ;SKIP IF NORMAL
02300 POPJ P, ;ELSE RETURN
02400 MOVE T1,LIBUF ;PRINT LINE NUMBER AND TAB
02500 JRST OUTSN
02600
02700 RPSALT=SALT1
02800 DEFINE OFFRUB
02900 < TRZE FL2,RUBF2
03000 OUTSTR [ASCIZ /\\/]
03100 TRZE FL2,RUBF
03200 OUTCHR ["\"]>
03300
03400 DEFINE ONRUB
03500 < TRZE FL2,RUBF2
03600 OUTSTR [ASCII /\\/]
03700 TRON FL2,RUBF
03800 OUTCHR ["\"]>
03900
04000 IFN %SS005, <
04100
04200 ; SUBROUTINE VERSIONS OF OFFRUB/ONRUB (TO SAVE SPACE)
04300
04400 OFFTYP: OFFRUB
04500 POPJ P,
04600 ONTYP: ONRUB
04700 POPJ P,
04800
04900 DEFINE OFFRUB
05000 < PUSHJ P,OFFTYP>
05100 DEFINE ONRUB
05200 < PUSHJ P,ONTYP>
05300 >; END OF IFN %SS005
00100
00200 GNCH1A: ;HERE TO READ NEXT ALTER-MODE CHARACTER
00211 IFN %SS005, <
00221 SKIPE C,SAVC ;GET SAVED CHAR & TESTIT
00231 JRST [ ; NON-ZERO, JUMP
00241 SETZM SAVC ;CLEAR THE SAVED CHAR
00251 JRST GNCH1C] ; & CONTINUE
00261 >; END OF IFN %SS005
00270 TRNE FL2,COMFLF ;CMD FILE?
00300 JRST [PUSHJ P,RDCHAR
00400 JRST GNCH1C]
00500 INCHRW C
00600 ANDI C,177
00602 IFN %SS005, <
00604 TLZE FL2,BELLSN ;TEST FOR BELL SEEN
00606 JRST [ ; YES, JUMP
00608 CAIN C,7 ;TEST FOR 2D BELL
00610 JRST [ ; YES, TWO BELLS MEANS YOU'RE SORRY
00612 TRNN FL2,ALTDUP ;TEST FOR DUPLEXING
00614 OUTSTR [BYTE(7) 7,177,177,7,0] ; NO, ECHO BELLS
00616 OCRLF ;END THE LINE
00618 CLRBFI ;CLEAR TYPE-AHEAD
00620 ONECHO ;TURN ECHO ON
00622 SKIPN ALTFLG ;TEST FOR RE-INSERTION REQ'D
00624 JRST COMND ; NO, DONE NOW
00626 PUSHJ P,FINDN ;FIND NEXT LINE
00628 PUSHJ P,FILLB ; & CHECK FOR OVERFLOW
00630 JRST COMND ; & GO GET NEXT CMD
00632 ]
00634 MOVEM C,SAVC ;SAVE THE CHAR FOR LATER
00636 MOVEI C,7 ; & GET THE DEFERRED BELL
00638 JRST GNCH1C ;CONTIUE ON
00640 ]
00642 CAIN C,7 ;TEST FOR 1ST BELL
00644 JRST [ ; YES, JUMP
00646 TLO FL2,BELLSN ;SHOW WE'VE SEEN A BELL
00648 JRST GNCH1A ; & READ THE NEXT CHAR
00650 ]
00652 >; END OF IFN %SS005
00700 GNCH1C: CAME C,ESC ;NEVER DUPLEX ESC
00800 TRNN FL2,ALTDUP ;AND NOT UNLESS DESIRED
00900 POPJ P,
01000 CAIE C,12 ;NOT LINE FEED
01100 CAIN C,15 ;OR RETURN
01200 POPJ P,
01210 IFN %SS005, <
01220 CAIE C,"R"-100 ;TEST FOR ^R
01230 CAIN C,"U"-100 ;TEST FOR ^U
01240 POPJ P, ; EITHER, DON'T ECHO
01250 CAIE C,10 ;TEST FOR BACKSPACE
01260 >; END OF IFN %SS005
01300 CAIN C,177 ;AND FINALLY IGNORE RUBOUT
01400 POPJ P,
01500 OFFRUB ;IF WE ARE DUPLEXING WE ARE NOT DELETING
01505 IFN %SS005, <
01510 MOVE CS,CTBL(C) ;GET CHAR TABLE BITS FOR THIS LETTER
01515 TLNE CS,(<BYTE(4)0(7)-1,0>) ;TEST FOR NON-C128 CHAR
01520 CAIL C,40 ;TEST FOR CONTROL CHAR
01525 JRST GNCH1D ; JUMP UNLESS C128 CONTROL CHAR
01530 OUTCHR ["^"] ;TYPE A UP-ARROW
01535 ADDI C,100 ;CONVERT TO A LETTER
01540 OUTCHR C ; & TYPE IT
01545 SUBI C,100 ;RESTORE ORIGINAL VALUE
01550 POPJ P, ; & RETURN TO CALLER
01555 GNCH1D: ;HERE TO TYPE REAL CHAR
01560 >; END OF IFN %SS005
01600 OUTCHR C ;TYPE
01700 POPJ P,
01800
01900 GNCH1: PUSHJ P,GNCH1A ;GET A CHR IN DDT MODE
02000 CAMN C,ESC ;CONVERT ALTMODE TO 200
02100 MOVEI C,200
02200 TLNN FL,QMODF
02290 IFE %SS025, <
02300 CAIE C,"'" ;CHECK FOR QUOTE
02310 >; END OF IFE %SS025
02320 IFN %SS025, <
02330 CAME C,CHR128 ;TEST FOR _C128 SPECIAL CHARACTER
02340 >; END OF IFN %SS025
02400 JRST GNCH1B ;NO, THIS CHR IS OK
02500 PUSHJ P,GNCH1A ;GET ANOTHER
02510 IFN %SS025, <
02520 CAMN C,CHR128 ;TEST FOR _C128 SPECIAL CHARACTER
02530 JRST GNCH1E ; YES, ALWAYS TRANSLATES TO [SELF]
02540 >; END OF IFN %SS025
02600 SKIPE CTBL(C) ;IF 0 HN CTBL, KEEP IT
02700 MOVS C,CTBL(C) ;GET ALTERNATE CODE
02710 IFN %SS025, <
02720 GNCH1E: ;HERE WITH _C128 TRANSLATION
02730 >; END OF IFN %SS025
02800 ANDI C,177 ;GET RID OF EXTRA BITS
02805 IFN %SS005, <
02810 IFN %SS060, <
02815 CAIE C,177 ;TEST FOR /C128 RUBOUT
02820 >; END OF IFN %SS060
02825 CAIN C,10 ;TEST FOR C128 BACKSPACE
02830 TRO C,1B18 ; YES, TURN ON HIGH BIT TO FOIL COMPARES
02835 CAIE C,"R"-100 ;TEST FOR C128 ^R
02840 CAIN C,"U"-100 ;TEST FOR C128 ^U
02845 TRO C,1B18 ; YES, TURN ON HIGH BIT (AS ABOVE)
02850 >; END OF IFN %SS005
02900 GNCH1B: MOVE CS,CTBL(C) ;LOAD CS
02910 IFN %SS005, <
02920 TLNE FL,QMODF ;TEST FOR C128
02930 POPJ P, ; NO, RETURN TO CALLER
02940 >; END OF IFN %SS005
03000 TLNE CS,LETF_16 ;CHECK FOR LETTER
03100 TDC C,CASEBT ;AND APPLY CASE CONVERRION
03200 POPJ P, ;ALL DONE
03300
00100 ALTDG: IMULI T2,^D10 ;ACCUMULATE REPEAT COUNT
00200 ADDI T2,-"0"(C)
00300 JRST CPOPJ1 ;SKIP RETURN SO AT NOT TO 0 RPT. CNT.
00400
00500 ALTTB: MOVEI T2,^D1000 ;LOTS OF SPACES
00600 ALTSP: TLNE FL,NEGF ;CHECK BACKWARDS
00700 JRST ALTBS ;YES: BACK SPACE
00710 IFN %SS005, <
00720 ALTSP0: ;HERE TO SPACE FORWARDS
00730 >; END OF IFN %SS005
00800 OFFRUB
00900
01000 ALTSP2: LDB C,ALTP ;GET THE CHR WE ARE POINTING AT
01100 CAIN C,15 ;IF RETURN THEN AS FAR AS CAN GO
01200 JRST ALTSP1 ;SO QUIT
01300 TRNN FL2,SUPN ;SPECIAL HACK FOR XTEND
01400 PUSHJ P,OCHR ;PRINT IT
01500 IBP ALTP ;ADVANCE POINTER
01600 AOS ALTCNT ;AND COUNT
01700 SOJG T2,ALTSP2 ;DO CORRECT NUMBER OF TIMES
01800 ALTSP1: TRNN FL2,SUPN
01900 PUSHJ P,FORCE ;DUMP IT
02000 POPJ P,
02100
02200
02210 IFN %SS005, <
02220 ALTEOL: MOVEM T2,ALTINC ;STORE THE INCREMENT
02230 MOVSI T2,1 ;GET A VERY LARGE NUMBER
02240 PUSHJ P,ALTSP ; & SKIP TO END OF LINE
02250 MOVE T2,ALTINC ;RESTORE THE INCREMENT
02260 TLZ FL,NEGF ;CLEAR NEG FLAG & START INSERTING
02270 >; END OF IFN %SS005
02300
02400 ALTIN: TRO FL2,ALTDUP ;TURN ON DUPLEXING
02500 MOVEM T2,ALTINC ;SAVE IN CASE HE INSERTS A RETURN
02600 ALTIN1: PUSHJ P,GNCH1 ;GET A CHARACTER
02690 IFE %SS005, <
02700 CAIN C,15 ;FINISH ON CR
02800 JRST ALTFNZ
02900 CAIN C,12
03000 JRST INSCR ;GO INSERT A CRLF
03100 CAIN C,200 ;FINISH ON ALTMODE
03200 POPJ P, ;GO AWAY
03210 >; END OF IFE %SS005
03220 IFN %SS005, <
03230 CAIN C,12 ;TEST FOR LINE FEED
03240 JRST [ ; YES, JUMP
03250 PUSHJ P,INSCR ;INSERT A <CR><LF> (NEW LINE)
03260 JRST ALTIN1 ; & CONTINUE
03270 ]
03280 CAIE C,10 ;TEST FOR BACKSPACE
03290 >; END OF IFN %SS005
03300 CAIN C,177 ;CHECK FOR BACKSPACE
03400 JRST ALTIBS ;AND DELETE CHR TO LEFT
03410 IFN %SS005, <
03420 PUSHJ P,CKSPCL ;TEST FOR A SPECIAL CHARACTER
03430 JRST ALTIN1 ; ^R, CONTINUE INSERTION
03440 >; END OF IFN %SS005
03500 MOVE T3,ALTP ;GET SET TO SHIFT THINGS
03600 PUSH P,ALTCNT ;SAVE THIS FOR LATER
03700 LDB T1,T3 ;GET CHR FROM LINE
03800 ALTIN2: DPB C,T3 ;SHIFT LINE
03900 JUMPE C,ALTIN3 ;DONE
04000 AOS ALTCNT ;COUNT IT
04100 ILDB C,T3
04200 DPB T1,T3
04300 JUMPE T1,ALTIN3 ;DONE
04400 AOS ALTCNT ;COUNT
04500 ILDB T1,T3
04600 JRST ALTIN2
04700 ALTIN3: MOVE T2,ALTCNT ;SEE IF OVERFLOW HAPPENED
04800 CAIL T2,MXWPL*5
04900 NERROR LTL ;YES
05000 POP P,ALTCNT ;RESTORE OLD COUNT
05100 IBP ALTP ;ADVANCE POINTER
05200 AOS ALTCNT ;AND COUNT
05300 JRST ALTIN1 ;GO GET MORE
05400
00100 INSCR: OFFRUB
00200 OCRLF
00300 SKIPN T1,ALTINC ;DID HE SPECIFY AN INCREMENT?
00400 SKIPA T3,INCR ;NO, USE STANDARD
00500 PUSHJ P,ASCON ;CONVERT TO ASCII
00600 MOVE T2,T3 ;FIND THE NEW LINE NUMBER ;** FIX **
00700 MOVE T1,LIBUF ;CURRENT ONE ;** FIX **
00800 PUSHJ P,FIXLIN
00900 EXP LIBUF
01000 JRST [RERROR ORDER
01100 PUSHJ P,FINDB ;GET BACK WHERE WE BELONG
01190 IFE %SS005, <
01200 PUSHJ P,ERCOR ;TYPE OUT LINE TO CURRENT POINT
01300 JRST ALTIN1 ;AND CONTINUE INSERT
01310 >; END OF IFE %SS005
01320 IFN %SS005, <
01330 JRST ERCOR ;TYPE OUT LINE TO CURRENT POINT & RETURN
01340 >; END OF IFN %SS005
01350 ]
01400 MOVEM T2,LIBUF2 ;SAVE IT
01500 MOVEM T2,CLN ;AND SET AS CURRENT LINE
01600 PUSHJ P,FINDB ;BACK UP TO WHERE WE BELONG
01700 MOVE T1,[XWD LIBUF+1,LIBUF2+1]
01800 BLT T1,LIBUF2+MXWPL+1 ;SAVE OLD BUFFER
01900 PUSH P,ALTP ;SAVE POINTER
02000 MOVEI C,15
02100 DPB C,ALTP ;AND TERMINATE THIS LINE
02200 MOVEI C,12
02300 IDPB C,ALTP
02400 MOVEI C,0 ;FILL OUT LINE WITH NULLS
02500 AINSC2: TLNN ALTP,760000
02600 JRST AINSC3
02700 IDPB C,ALTP
02800 JRST AINSC2
02900 AINSC3: SUBI ALTP,LIBUF-1 ;FIND COUNT
03000 HRRZM ALTP,NCNT
03100 PUSHJ P,INSED ;REPLACE OLD LINE
03200 PUSHJ P,FINDN ;MOVE UP TO NEXT
03300 PUSHJ P,FILLB ;AND DUMP IF OVERFLOW
03400 SETZM OCNT ;THIS IS A NEW LINE GOING IN
03500 MOVE T1,LIBUF2 ;MOVE LINE NUMBER OVER
03600 MOVEM T1,LIBUF
03700 SETZM LIBUF+1
03800 MOVE T1,[XWD LIBUF+1,LIBUF+2]
03900 BLT T1,LIBUF+MXWPL+1 ;ZERO OUT REST
04000 POP P,T2 ;RESTORE POINTER TO REST OF LINE
04100 MOVE ALTP,[POINT 7,LIBUF+1] ;DEST POINTER
04200 ADD T2,[XWD 70000,LIBUF2-LIBUF] ;ADJUST INPUT POINTER
04300 MOVEI C,11 ;AND SET UP THE TAB
04400 MOVNEW: IDPB C,ALTP
04500 CAIN C,12
04600 JRST DONNEW ;FINISHED MOVING REST OF LINE
04700 ILDB C,T2 ;PICK UP ONE
04800 JRST MOVNEW
04900 DONNEW: SUBI ALTP,LIBUF ;GET COUNT
05000 MOVEI ALTP,1(ALTP) ;USED TO BE - MOVEI AC,1-LIBUF(AC)
05100 MOVEM ALTP,NCNT
05200 PUSH P,ALTP ;AND SAVE
05300 PUSHJ P,INSED ;INSERT
05400 MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET UP FOR ALTER
05410 IFN %SS005, <
05420 TRO FL2,ALTBOL ;TURN ON BEGINNING OF LINE FLAG
05430 >; END OF IFN %SS005
05500 SETZM ALTCNT
05600 POP P,OCNT ;SET FOR OLD COUNT
05700 MOVE T1,LIBUF
05800 TRNN FL2,NONUMF ;SKIP IF NOT PRINTING
05900 PUSHJ P,OUTSN
06000 SETOM ALTFLG ;WE HAVE INSERTED AND ALTALT SHOULD CALL FILLB
06090 IFE %SS005, <
06100 JRST ALTIN1 ;AND CONTINUE INSERTING
06110 >; END OF IFE %SS005
06120 IFN %SS005, <
06130 POPJ P, ;RETURN TO CALLER
06140 >; END OF IFN %SS005
06200
06300 ALTIBS: MOVEI T2,0 ;SET COUNT TO 0
06400 MOVEM ALTP,SVALTP ;SAVE POINTER
06500 PUSHJ P,ALTBS ;DO A BACKSPACE
06600 EXCH ALTP,SVALTP ;GET BACK AND SAVE CURRENT
06700 PUSHJ P,ALTDL3 ;DELETE THAT CHR
06800 JRST ALTIN1 ;GET MORE
06900
00100 ALTDL: TLNE FL,NEGF ;BACKWARDS?
00200 JRST ALTBDL ;YES:
00300 MOVEM ALTP,SVALTP ;SAVE CURRENT POINTER POSITHON
00400 ALTDL1: LDB C,ALTP ;GET CURRENT CHR
00500 CAIN C,15 ;AT END OF LINE?
00600 JRST ALTDL5 ;YES, GO FINISH OFF
00700 TRNN FL,EXTOG ;PRINT ONLY IF NON-EXPERT
00800 PUSHJ P,ALTDPN ;YES: PRINT CHAR
00900 IBP ALTP ;ADVANCE POINTER
01000 SOJG T2,ALTDL1 ;CHECK COUNT AND CONTINUE
01100 ALTDL5: PUSHJ P,FORCE ;FORCE OUTPUT
01200 ALTDL3: MOVE T3,SVALTP ;GET BACK POINTER
01300 ALTDL4: LDB C,ALTP ;MOVE LINE DOWN
01400 DPB C,T3
01500 JUMPE C,ALTDL2 ;DONE?
01600 IBP ALTP ;ADVANCE POINTERS
01700 IBP T3
01800 JRST ALTDL4
01900 ALTDL2: MOVE ALTP,SVALTP ;RESTORE POINTER AGAIN
02000 POPJ P, ;AND LEAVE
02100
02200
02300 APRINT: PUSH P,ALTCNT ;SAVE CURRENT COUNT
02400 PUSHJ P,ALTLN ;PRINT REST OF LINE AND START OVER
02500 POP P,T2 ;GET BACK COUNT
02600 CAILE T2,0 ;AND SPACE IF NOT 0
02700 JRST ALTSP
02800 POPJ P,
02900
03000 ALTDPN: PUSH P,C
03100 MOVEI C,"\"
03200 TRNN FL2,RUBF2
03300 PUSHJ P,OCHR
03400 TRZE FL2,RUBF
03500 PUSHJ P,OCHR
03600 TRON FL2,RUBF2
03700 PUSHJ P,OCHR
03800 POP P,C
03900 JRST OCHR
00100
00190 IFE %SS005, <
00200 ALTSR: OFFRUB
00300 PUSHJ P,GNCH1 ;GET THE CHARACTER TO SEARCH FOR
00400 ALTSR1: PUSH P,T2 ;SAVE NUMBER OF TIMES TO SEARCH
00500 PUSHJ P,ALTCS ;CALL COMMON SEARCH ROUTINE
00600 PUSH P,C ;SAVE THE CHARACTER
00700 PUSHJ P,ALTSP ;GO SPACE CORRECT NUMBER
00800 POP P,C ;RESTORE CHR
00900 POP P,T2 ;AND COUNT
01000 SOJG T2,ALTSR1 ;CONTINUE
01100 POPJ P,
01110 >; END OF IFE %SS005
01200
01300 ALTCS: MOVEI T2,1 ;CREATE A REPEAT COUNT
01310 IFN %SS005, <
01320 IFE %SS040, <
01330 ANDI C,377 ;TRIM CHAR TO 8 BITS
01340 >; END OF IFE %SS040
01350 >; END OF IFN %SS005
01400 TLNE FL,NEGF ;BACKWARDS?
01500 JRST ALTBCS ;YES: SEARCH BACKWARDS
01600 LDB T3,ALTP ;CHEC TO SEE IF AT END OF LINE
01700 CAIN T3,15
01800 POPJ P,
01900 MOVE T1,ALTP ;GET A COPY OF THE POINTER
01905 IFN %SS005, <
01910 TRZN FL2,ALTBOL ;TEST FOR BEGINNING OF LINE & CLEAR BIT
01915 JRST ALTCS1 ; NOT BEGINNING, JUMP
01920 IFE %SS040, <
01925 CAMN T3,C ;TEST FOR 1ST CHAR MATCHING
01930 >; END OF IFE %SS040
01935 IFN %SS040, <
01940 PUSHJ P,CHKCFL ;COMPARE, INCLUDING LETTER CASE-FOLDING
01945 >; END OF IFN %SS040
01950 CAME ALTP,[POINT 7,LIBUF+1,13] ;TEST FOR REAL BEGINING OFLINE
01955 JRST ALTCS1 ; NOT MATCH OR NOT 1ST, JUMP
01960 SETZ T2, ;SET ZERO COUNT
01965 POPJ P, ; & RETURN TO CALLER
01970 >; END OF IFN %SS005
02000 ALTCS1: ILDB T3,T1 ;GET A CHARACTER
02100 CAIE T3,15 ;DONE IF END OF LINE
02190 IFE %SS040, <
02200 CAMN T3,C ;OR A MATCH
02224 >; END OF IFE %SS040
02234 IFN %SS040, <
02244 PUSHJ P,CHKCFL ;COMPARE, INCLUDING LETTER CASE-FOLDING
02254 >; END OF IFN %SS040
02300 POPJ P,
02400 AOJA T2,ALTCS1 ;ELSE KEEP COUNT AND KEEP LOOKING
02500
02590 IFE %SS005, <
02600 ALTKL: PUSHJ P,GNCH1 ;ALMOST LINE ALTSR
02700 ALTKL1: PUSH P,T2
02800 PUSHJ P,ALTCS
02900 CAIE T3,0 ;OFF FRONT END - SKIP
03000 CAIN T3,15 ;BUT GIVE UP IF CHR NOT FOUND
03100 JRST T2POPJ
03200 PUSH P,C
03300 PUSHJ P,ALTDL ;DELETE THAT NUMBER
03400 POP P,C
03500 POP P,T2
03600 SOJG T2,ALTKL1
03700 POPJ P,
03710 >; END OF IFE %SS005
03720 IFN %SS005, <
03730
03740 ALTSR: SKIPA C,[" "] ;S, TREAT AS "@ " COMMAND
03750 ALTKL: MOVEI C,"D" ;K, TREAT AS "@D" COMMAND
03760 JRST ALTXC0 ; JUMP TO PROCESS
03770
03780 >; END OF IFN %SS005
03800 T2POPJ: POP P,T2 ;NEED TO CLEAR STACK
03900 POPJ P,
04000
00100 ALTALT: OFFRUB
00200 SKIPN ALTFLG ;SHOULD WE DO A FILLB?
00300 JRST ALTAL1
00400 PUSHJ P,FINDN
00500 PUSHJ P,FILLB ;YES, WE HAVE INSERTED SOMETHING
00600 ALTAL1:
00700 ONECHO ;DUMPLEXING BACK ON
00800 JRST T1POPJ ;AND RETURN
00900
01000
01100 ALTFNZ:
01200 PUSHJ P,GNCH1
01300 ALTFN:
01400 MOVEI T2,MXWPL*5+100 ;FINISH UP LINE
01500 PUSHJ P,ALTSP ;BY PRINTING A LARGE NUMBER OF SPCAES
01600 ALTFNX:
01700 OCRLF
01800 ONECHO ;GET OUT OF NON-DUPLEX MODE
01900 ALTFN1: ILDB C,ALTP ;LOOK ONE CHR OVER
02000 CAIE C,12 ;THIS SHOULD BE THE LINE FEED
02100 NERROR ILFMT ;SOMETHING IS WRONG
02200 MOVEI C,0 ;ZERO REMAINDER OF LINE
02300 ALTFN2: TLNN ALTP,760000 ;ALL DONE?
02400 JRST ALTFN3 ;YES
02500 IDPB C,ALTP ;NO, PUT IN ANOTHER 0
02600 JRST ALTFN2
02700 ALTFN3: SUBI ALTP,LIBUF-1 ;GET SIZE OF NEW LINE
02800 HRRZM ALTP,NCNT ;AND SAVE FOR INSED
02900 AOS -1(P) ;SET FOR SKIP RETURN
03000 JRST T1POPJ ;RETURN TO CALLER OF ALTLIN
03100
03200
03300 ALTCU: OFFRUB
03400 OUTSTR [ASCIZ /^U
03500 /]
03600 JRST SETALT ;GO RESTART LINE AND FORGET EDIT SO FAR
03700
03800 ALTRP: PUSHJ P,ALTDL ;REPLACE IS DELETE THEN INSERT
03900 TLZ FL,NEGF
04000 MOVEI T2,0
04100 JRST ALTIN
04200
04300
04400 ALTCN: OFFRUB
04500 TRO FL2,ALTDUP ;TURN ON DUPLEXING
04600 ALTCN2: LDB C,ALTP ;AT END OF LINE?
04700 CAIN C,15
04800 POPJ P, ;YES, STOP
04900 ALTCN1: PUSHJ P,GNCH1 ;GET A CHARACTER
04990 IFE %SS005, <
05000 CAIE C,177 ;DO NOT LET HIM INSERT A RUBOUT
05100 CAIN C,15 ;IGNORE CRET
05200 JRST ALTCN1
05300 CAIE C,200 ;STOP ON ALTMODE AND LINE FEED
05400 CAIN C,12
05500 POPJ P,
05504 >; END OF IFE %SS005
05508 IFN %SS005, <
05512 PUSHJ P,CKSPCL ;CHECK FOR SPECIAL CHAR HANDLING
05522 JRST ALTCN1 ; ^R MEANS TRY AGAIN
05564 CAIN C,12 ;TEST FOR <LF>
05568 JRST ALTCNL ; YES, INSERT <CR><LF>
05580 >; END OF IFN %SS005
05600 DPB C,ALTP ;REPLACE IT
05700 IBP ALTP ;ADVANCE POINTER
05800 AOS ALTCNT ;AND COUNT
05900 SOJG T2,ALTCN2 ;CONTINUE
06000 POPJ P,
06100
06105 IFN %SS005, <
06110 ALTCNL: PUSH P,T2 ;SAVE THE REPEAT COUNT
06115 PUSH P,FL ;SAVE THE FLAGS
06120 TRO FL,EXTOG ;SET 'EXPERT' NOT TO LIST DELETED CHAR
06125 SETZ T2, ;CLEAR THE REPEAT COUNT
06130 PUSHJ P,ALTDL ;DELETE THE CHARACTER
06135 POP P,FL ;RESTORE THE FLAGS
06140 SETZB T2,ALTINC ;CLEAR THE REPEAT COUNT AGAIN & INCREMENT
06145 PUSHJ P,INSCR ;INSERT A <CR><LF>
06150 POP P,T2 ;RESTORE THE REPEAT COUNT
06155 SOJG T2,ALTCN2 ;DECR REPEAT COUNT & LOOP
06160 POPJ P, ; DONE, RETURN
06165 >; END OF IFN %SS005
06200
06300
06400 ALTEX: OFFRUB
06500 ALTEX1: LDB C,ALTP
06600 CAIN C,15
06700 JRST ALTFNX
06800 IBP ALTP
06900 AOS ALTCNT
07000 JRST ALTEX1
07100
07200 IFN %SS005, <
07300 CKSPCL: CAIN C,"R"-100 ;TEST FOR ^R
07400 JRST ALTEC0 ; YES, TYPE LINE & RETURN TO CALLER
07500 POP P,T1 ;POP RETURN ADDRESS INTO T1
07600 CAIG C,200 ;TEST FOR RUBOUT / ALTMODE
07700 CAIGE C,177 ;TEST FOR RUBOUT / ALTMODE
07800 CAIN C,10 ;TEST FOR BACKSPACE
07900 POPJ P, ; YES, TERMINATE COMMAND
08000 CAIN C,"U"-100 ;TEST FOR ^U
08100 JRST ALTCU ; YES, RESTART THE LINE
08200 CAIN C,15 ;TEST FOR <CR>
08300 JRST ALTFNZ ; YES, END THE LINE
08400 JRST 1(T1) ;TAKE +1 RETURN IF NORMAL CHAR
08500 >; END OF IFN %SS005
08600
08700 IFN %SS057, <
08800
08900 ; STANFORD-TYPE CASE-INVERSION COMMAND ("V")
09000
09100 ALTVER: OFFRUB
09200 ALTVE1: LDB C,ALTP ;GET THE NEXT CHARACTER
09300 MOVEI T1,(C) ; & COPY INTO ANOTHER AC
09400 ANDCMI T1,40 ;IF LETTER, CONVERT TO UPPER CASE
09500 CAIL T1,"A" ;TEST FOR A LETTER
09600 CAILE T1,"Z" ;TEST FOR A LETTER
09700 JRST ALTVE2 ; NO, THEN DONE
09800 XORI C,40 ;INVERT CASE OF THE LETTER
09900 DPB C,ALTP ; & STORE BACK
10000 PUSHJ P,OCHR ;TYPE THE CHANGED CHAR
10100 IBP ALTP ;GET THE NEXT CHAR
10200 AOS ALTCNT ; & INCR THE COUNT
10300 SOJG T2,ALTVE1 ;DECR THE REPEAT COUNT & CONTINUE
10400 ALTVE2: ;HERE AT END OF COMMAND
10500 IFN %SS005, <
10600 SETZ T2, ;ASSURE T2 IS 0 FOR "@"
10700 >; END OF IFN %SS005
10800 JRST FORCE ;GO DUMP THE LINE SO FAR
10900 >; END OF IFN %SS057
00100
00200 AJOIN: OFFRUB
00300 PUSHJ P,FINDN ;GO SEE IF NEXT LINE IS REALLY THERE
00400 CAME T1,PGMK
00500 SKIPN T1
00600 JRST ILCER ;MAKE IT ILLEGAL IF NO LINE THERE
00700 MOVEM T1,LIBUF2 ;SAVE ITS NUMBER
00800 SETZM LIBUF2+1
00900 MOVE T1,[XWD LIBUF2+1,LIBUF2+2]
01000 BLT T1,LIBUF2+MXWPL+1 ;CLEAR OUT REST OF BUFFER
01100 PUSH P,ALTP ;SAVE POINTER TO THIS LINE
01200 ADD ALTP,[XWD 70000,0] ;BACK IT UP
01300 MOVE T2,[POINT 7,LIBUF2+1]
01400 MOVEI C,11
01500 MOVEI T1,6 ;COUNT THE CHARACTERS
01600 MOVLIN: IDPB C,T2
01700 ILDB C,ALTP
01800 CAIE C,15 ;END OF LINE?
01900 AOJA T1,MOVLIN ;KEEP COUNT
02000 MOVEI ALTP,1(PNTR) ;GET POINTER TO SECOND LINE
02100 HRLI ALTP,(<POINT 7,0,6>)
02200 ATRN1: ILDB C,ALTP
02300 IDPB C,T2
02400 ADDI T1,1
02500 CAIL T1,MXWPL*5+6 ;CHECK SIZE
02600 JRST LTLER
02700 CAIE C,12
02800 JRST ATRN1 ;NOT DONE YET
02900 EXCH T2,(P) ;SAVE OUTPUT POINTER AND GET OLD ALTP BACK
03000 SUBI ALTP,-1(PNTR) ;GET OLD COUNT OF SECOND LINE
03100 PUSH P,ALTP ;AND SAVE IT
03200 MOVEI C,15 ;FINISH CURRENT LINE
03300 DPB C,T2
03400 MOVEI C,12
03500 IDPB C,T2
03600 MOVEI C,0
03700 INSC2: TLNN T2,760000
03800 JRST INSC3 ;FILL WITH NULLS
03900 IDPB C,T2
04000 JRST INSC2
04100 INSC3: SUBI T2,LIBUF-1 ;GET COUNT
04200 HRRZM T2,NCNT
04210 IFN %SS005, <
04220 SKIPN ALTCNT ;TEST FOR BEGINNING OF LINE
04230 SETZM NCNT ; YES, DELETE OLD LINE
04240 >; END OF IFN %SS005
04300 PUSHJ P,FINDB ;BACK UP TO POINT TO IT
04400 PUSHJ P,INSED
04410 IFN %SS005, <
04420 SKIPE ALTCNT ;SKIP IF PREVIOUS LINE DELETED
04430 >; END OF IFN %SS005
04500 PUSHJ P,FINDN
04600 PUSHJ P,FILLB
04700 POP P,OCNT ;OLD CONT
04800 HRRZS OCNT
04900 POP P,ALTP ;GET OUTPUT POINTER BACK
05000 SUBI ALTP,LIBUF2-1
05100 HRRZM ALTP,NCNT
05200 MOVE T1,[XWD LIBUF2,LIBUF]
05300 BLT T1,LIBUF+MXWPL+1
05400 PUSHJ P,INSED
05500 SETOM ALTFLG ;MARK AS NEED TO DO FILLB
05600 MOVE T1,NCNT ;GET THE COUNT JUST USED
05700 MOVEM T1,OCNT ;AND SET AS THE OLD COUNT
05800 MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET UP
05810 IFN %SS005, <
05820 TRO FL2,ALTBOL ;SET AT BEGINNING OF LINE
05830 >; END OF IFN %SS005
05900 SETZM ALTCNT
06000 OCRLF
06100 MOVE T1,LIBUF
06200 MOVEM T1,CLN ;SET UP CURRENT LINE
06300 TRNE FL2,NONUMF ;SKIP IF NORMAL
06400 POPJ P,
06500 JRST OUTSN ;AND PRINT NUMBER
06600
06700 LTLER: RERROR LTL
06800 POP P,ALTP ;RESTORE ALTP
06900 SKIPA
07000 ILCER: RERROR NNN
07100 PUSHJ P,FINDB ;MOVE BACK TO RIGHT PLACE
07200 ERCOR: PUSH P,ALTCNT ;SAVE COUNT
07300 SETZM ALTCNT
07400 MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET BACK TO START
07410 IFN %SS005, <
07420 TRO FL2,ALTBOL ;SET AT BEGINNING OF LINE
07430 >; END OF IFN %SS005
07500 PUSHJ P,ALTCBS ;PRINT LINE NUMBER
07600 POP P,T2 ;COUNT
07700 JUMPN T2,ALTSP ;AND SPACE OVER
07800 POPJ P, ;NO SPACES TO DO
07900
00100
00200 ALTWD: OFFRUB
00300 ALTWD1: PUSH P,T2 ;SAVE COUNT IF ANY
00400 PUSHJ P,ALTWS ;SKIP OVER WORD
00500 ANDI T2,-1 ;CLR FLAG IN CASE
00600 PUSHJ P,ALTSP ;SPACE CORRECTLY
00700 POP P,T2 ;RESTORE COUNT
00800 SOJG T2,ALTWD1 ;CONTINUE
00900
01000 ;ROUTINE TO SKIP OVER NEXT WORD
01100
01200 ALTWS: HRROI T2,0 ;SET FLG AND COUNT
01300 MOVE T1,ALTP ;GET POINTER
01400 LDB T3,T1 ;AND FIRST CHAR
01500 JRST .+2 ;CHECK FOR CR & GO
01600 ALTWS1: ILDB T3,T1 ;GET A CHARACTER
01700 CAIN T3,15 ;DONE IF END OF LINE
01800 ALTWS2: POPJ P,
01900 MOVE T3,CTBL(T3);FETCH CHARATER TABLE ENTRY
02000 JUMPE T3,ALTWS4 ;SKIP BLANKS ETC...
02100 ANDI T2,-1 ;CLR FLAG
02200 JUMPG T3,ALTWS3 ;SKIP LETTERS & NUMBERS
02300 TRNN FL2,QSEPF ;SEPARATORS
02400 TRNN T3,NSEPF ;TODAY
02500 POPJ P, ;REAL BREAK - QUIT!
02600 ALTWS3: AOJA T2,ALTWS1 ;KEEP COUNT AND CONTINUE
02700 ALTWS4: JUMPL T2,ALTWS3 ;FIRST BLNKS
02800 AOS T2
02900 ALTWS5: ILDB T3,T1
03000 CAIE T3,15 ;QUIT ON CR
03100 SKIPE CTBL(T3) ;OR FIRST NON-BLANK
03200 POPJ P,
03300 AOJA T2,ALTWS5
03400
03500 ALTWX: PUSHJ P,ALTWS ;SKIP WORD
03600 ANDI T2,-1 ;CLR FLAG
03700 PUSHJ P,ALTDL ;DELETE CHARS
03800 MOVEI T2,0
03900 JRST ALTIN ;DO INSERT
04000
04100 IFN %SS005, <
04200 ALTWK: PUSHJ P,ALTWS ;FIND THE NEXT WORD
04300 ANDI T2,-1 ;CLEAR THE FLAG
04400 JRST ALTDL ;GO DELETE THE FOUND WORD
04500 >; END OF IFN %SS005
00060 IFN %SS005, <
00070 ALTBSS: TLNE FL,NEGF ;TEST FOR NEGATIVE BACKSPACE/RUBOUT
00080 JRST ALTSP0 ; YES, TREAT AS +SPACE
00090 >; END OF IFN %SS005
00100 ALTBS: ;HERE ON BACKSPACE/RUBOUT
00110 IFN %SS005, <
00120 TRNN FL,EXTOG ;TEST FOR EXPERT
00130 JRST ALTBS0 ; NO, JUMP (DO IT THE OLD WAY)
00140 CAMG T2,ALTCNT ;TEST FOR BACKING OVER THE FRONT OF THE LINE
00150 SKIPN ALTCNT ;TEST FOR NULL LINE POSITION
00160 JRST ALTNL ; YES, DON'T PRINT IF EXPERT & STARTING OVER
00170 ALTBS0: ;HERE TO SPACE BACK ONE CHAR
00180 >; END OF IFN %SS005
00190 PUSHJ P,ALTBAK ;GET PREVIOUS CHAR
00200 JUMPE T3,ALTCBS ;JUMP IF DONE
00300 ONRUB
00400 MOVE C,T3
00500 PUSHJ P,OCHR
00600 SOS ALTCNT ;DECREASE COUNT
00690 IFE %SS005, <
00700 SOJG T2,ALTBS ;MORE,MORE
00710 >; END OF IFE %SS005
00720 IFN %SS005, <
00730 SOJG T2,ALTBS0 ;DECR & REPEAT IF MORE
00740 >; END OF IFN %SS005
00800 PUSHJ P,FORCE
00900 POPJ P,
01000
01100 ALTCBS: PUSHJ P,FORCE ;FINISH BUFFER
01200 OFFRUB ;NO MORE RUB
01300 OCRLF
01400 TRNE FL2,NONUMF ;MORE NONUMBER STUFF
01500 POPJ P,
01600 MOVE T1,LIBUF ;ALSO PRINT SEQ NUM
01700 JRST OUTSN
01800
01900
02000 ALTLN: MOVEI T2,1000 ;FINISH PRINTING THE LINE
02100 PUSHJ P,ALTSP
02110 IFN %SS005, <
02120 ALTNL: TRO FL2,ALTBOL ;SET AT BEGINNING OF LINE
02130 >; END OF IFN %SS005
02200 MOVE ALTP,[POINT 7,LIBUF+1,13] ;POINTER TO START
02300 SETZM ALTCNT ;RESET COUNT
02400 JRST ALTCBS ;AND PRETEND A BACKSPACE
02500
02600 PAGE
02700 IFN %SS005, <
02800
02900 ALTEC0: SOS (P) ;SET +0 RETURN FOR 'ALTECH' & FALL THRU
03000 ALTECH: PUSHJ P,FORCE ;DUMP PRECEEDING BUFFER
03100 OFFRUB ;TERMINATE RUBOUT STATUS
03200 OCRLF ; & END THE LINE
03300 MOVE T1,LIBUF ;GET SEQUENCE NUMBER
03400 TRNN FL2,NONUMF ;TEST FOR NUMBER OUTPUT
03500 PUSHJ P,OUTSN ; YES, TYPE SEQ #
03600 MOVE ALTP,[POINT 7,LIBUF+1,13] ;GET BEGINNING BUFFER PTR
03700 PUSH P,T2 ;SAVE CURRENT DUPL COUNT
03800 MOVE T2,ALTCNT ;GET CURRENT CHAR COUNT
03900 SETZM ALTCNT ; & CLEAR IT
04000 SKIPE T2 ;TEST FOR ANYTHING TO TYPE
04100 PUSHJ P,ALTSP2 ; YES, TYPE TO PRESENT POSITION
04200 POP P,T2 ;RESTORE DUPL COUNT
04300 JRST CPOPJ1 ;RETURN, PRESERVING COUNTS
04400
04500
04600 ALTUPS: SKIPA T1,[ANDCMI C,.-.] ;GET INSTR TO CONVERT TO UPPER CASE
04700 ALTDWN: MOVSI T1,(<IORI C,.-.>) ;GET INSTR TO CONVERT TO LOWER CASE
04800 JRST ALTCG0 ; & JUMP TO COMMON ROUTINE
04900
05000 ALTCHG: MOVSI T1,(<XORI C,.-.>) ;GET INSTR TO INVERT CASES
05100 ALTCG0: HRRI T1,40 ;SUPPLY BIT TO MODIFY CASE
05200 MOVEM T1,ALTINC ; & STORE FOR LATER
05300 TLNE FL,NEGF ;TEST FOR BACKWARDS
05400 JRST ALTCHB ; YES, JUMP
05500 OFFRUB
05600 ALTCG1: LDB C,ALTP ;GET CURRENT CHARACTER
05700 CAIN C,15 ;TEST FOR END OF LINE
05800 JRST ALTCG2 ; YES, JUMP
05900 MOVE CS,CTBL(C) ;GET CHAR BITS
06000 TLNE CS,LETF_16 ;TEST FOR A LETTER
06100 XCT ALTINC ; YES, PERFORM CASE MODIFICATION
06200 DPB C,ALTP ;STORE LETTER BACK
06300 PUSHJ P,OCHR ;TYPE THE CHARACTER
06400 IBP ALTP ;INCR TO NEXT CHARACTER
06500 AOS ALTCNT ;INCR CHAR COUNT
06600 SOJG T2,ALTCG1 ;DECR COUNT & REPEAT
06700 ALTCG2: PUSHJ P,FORCE ;DUMP THE BUFFER
06800 POPJ P, ; & RETURN
06900
07000 ALTCHB: PUSHJ P,ALTBAK ;GET PREVIOUS CHARACTER
07100 JUMPE T3,ALTCBS ; DONE, RESTART THE LINE
07200 ONRUB
07300 MOVE C,T3 ;COPY THE CHARACTER
07400 MOVE CS,CTBL(C) ;GET CHAR BITS
07500 TLNE CS,LETF_16 ;TEST FOR A LETTER
07600 XCT ALTINC ; YES, PERFORM CASE MODIFICATION
07700 DPB C,ALTP ;STORE LETTER BACK
07800 PUSHJ P,OCHR ;TYPE THE CHARACTER
07900 SOS ALTCNT ;DECR THE CHAR COUNT
08000 SOJG T2,ALTCHB ;DECR COUNT & REPEAT
08100 JRST ALTCG2 ; DONE, END THE OPERATION
08200
08300
08400 ALTIGN=CPOPJ ;ALTMODE IS IGNORED, BUT CLEARS ACCUMULATED REPEAT COUNTS
08500
08600 ALTXCT: PUSHJ P,GNCH1 ;READ THE COMMAND CHARACTER
08700 ANDI C,377 ;MASK TO 8 BITS
08800 PUSHJ P,CKSPCL ;CHECK FOR SPECIAL CHARACTER
08900 JRST ALTXCT ; ^R, REPEAT
09000 TLNE CS,LETF_16 ;TEST FOR A LETTER
09100 TRZ C,40 ; YES, FOLD TO UPPER CASE
09200 ALTXC0: HRLM C,(P) ;STORE THE COMMAND CHARACTER
09300 IFN %SS040, <
09400 SETZM ALTSSG ;CLEAR THE SEARCH STRING
09500 MOVE T5,[POINT 7,ALTSSG] ;GET SEARCH STRING B.P.
09600 >; END OF IFN %SS040
09700 ALTXC1: PUSHJ P,GNCH1 ;READ THE SEARCH CHAR
09800 PUSHJ P,CKSPCL ;CHECK FOR SPECIAL FUNCTION
09900 JRST ALTXC1 ; ^R, REPEAT
10000 IFN %SS040, <
10100 LDB T1,T5 ;GET PRIOR CHAR (NULL IF 1ST)
10200 CAIN T1,.PTQOT ;TEST FOR QUOTED CHAR
10300 TRO C,1B18 ; YES, SET BIT TO VOID ALL COMPARES
10400 MOVEI T1,.PTQOT ;GET A QUOTE CHAR
10500 IFN %SS044, <
10600 CAIE C,.PT1MR ;TEST FOR '1 OR MORE'
10700 >; END OF IFN %SS044
10800 CAIN C,.PTINF ;TEST FOR 'ANY # OF'
10900 IDPB T1,T5 ; YES, QUOTE IT
11000 IDPB C,T5 ;STORE THE SEARCH CHAR
11100 CAIE C,.PTQOT ;TEST FOR 'QUOTE' CHAR
11200 CAIN C,.PTNOT ;TEST FOR 'NOT' CHAR
11300 JRST ALTXC1 ; EITHER, REPEAT FOR ACTUAL CHAR
11400 >; END OF IFN %SS040
11500 HLRZ T1,(P) ;RESTORE THE COMMAND CHAR
11600 MOVSI T5,-ALTLG ;GET TABLE AOBJN PTR
11700 CAME T1,ALTAB1(T5) ;TEST FOR SAME CHAR
11800 AOBJN T5,.-1 ; NO, INCR & REPEAT
11900 JUMPGE T5,ALTXCE ;NOT FOUND, GIVE ERROR
12000 MOVE T5,ALTAB2(T5) ;GET BRANCH TABLE ENTRY
12100 TLNN T5,OKREAD ;TEST FOR /READ PERMISSION
12200 TRNN FL,READOF ;TEST FOR /READONLY
12300 TLNN T5,OKXCT ;TEST FOR EXECUTE-CMD PERMISSION
12400 JRST ALTXCE ; ERROR IF NOT ALLOWED
12500 TLNN T5,OKNEG ;TEST FOR NEGATIVE PERMITTED
12600 TLNN FL,NEGF ;TEST FOR NEGATIVE
12700 JRST ALTXC2 ; JUMP IF +, OR IF - OK
12800 ALTXCE: POP P,(P) ;POP THE RETURN ADDRESS OFF THE STACK
12900 JRST ALTBEL ;GIVE ALTER-MODE ERROR MSG
13000 ALTXC2: PUSH P,T2 ;STORE THE REPEAT COUNT
13100 PUSH P,T5 ;STORE THE DISPATCH ADDRESS
13200 PUSHJ P,ALTCS ;DO THE CHARACTER SEARCH
13300 MOVE T5,(P) ;GET THE DISPATCH ADDRESS
13400 TLNE T5,OKXEOL ;TEST FOR EXECUTE-TO-EOL PERMITTED
13500 JRST ALTXC3 ; YES, JUMP
13600 CAIE T3,0 ;TEST FOR BEGINNING OF LINE
13700 CAIN T3,15 ;TEST FOR END OF LINE
13800 IFE %SS040, <
13900 CAIN C,12 ;TEST FOR BOL/EOL EXPECTED
14000 JRST ALTXC3 ; JUMP IF EXPECTED BOL/EOL FOUND
14100 >; END OF IFE %SS040
14200 IFN %SS040, <
14300 SKIPA ; SKIP IF END OF LINE FOUND
14400 JRST ALTXC3 ; ELSE JUMP IF NOT END OF LINE
14500 MOVS T1,ALTSSG ;GET SEARCH STRING
14600 CAIE T1,(BYTE (7) 12) ;TEST FOR LINE-FEED
14700 CAIN T1,(BYTE (7) .PTQOT, 12) ;TEST FOR QUOTED LINE-FEED
14800 JRST ALTXC3 ; EITHER, JUMP (END OF LINE EXPECTED)
14900 CAIE T1,(BYTE (7) .PTEOL) ;TEST FOR END OF LINE CHAR
15000 CAIN T1,(BYTE (7) .PTNOT, .PTANY) ;TEST FOR 'NOT ANY' CHAR
15100 JRST ALTXC3 ; EITHER, JUMP (END OF LINE EXPECTED)
15200 >; END OF IFN %SS040
15300 SUB P,[2,,2] ;TAKE JUNK OFF THE STACK
15400 JRST ALTXCE ; ELSE RING BELL FOR ERROR
15500 ALTXC3: ;HERE TO EXECUTE THE FUNCTION
15600 IFE %SS040, <
15700 PUSH P,C ;SAVE THE SEARCH CHAR
15800 >; END OF IFE %SS040
15900 SKIPE T2 ;SKIP IF NOTHING TO DO
16000 PUSHJ P,(T5) ;** EXECUTE THE FUNCTION **
16100 SKIPE T2 ;SKIP IF COUNT EXHAUSTED
16200 IFN %SS040, <
16300 SETZM -1(P) ;ELSE EXHAUST OUR COUNT
16400 >; END OF IFN %SS040
16500 IFE %SS040, <
16600 SETZM -2(P) ;ELSE EXHAUST OUR COUNT
16700 POP P,C ;RESTORE THE SEARCH CHAR
16800 >; END OF IFE %SS040
16900 POP P,T5 ;RESTORE THE DISPATCH ADDRESS
17000 POP P,T2 ;RESTORE OUR COUNT
17100 SOJG T2,ALTXC2 ;REPEAT UNTIL DONE
17200 POPJ P, ;RETURN TO CALLER
17300 >; END OF IFN %SS005
00100 ;COMMON ROUTINES TO MAKE LINE BACKUP
00200
00300 ALTBAK: CAMN ALTP,[POINT 7,LIBUF+1,13]
00400 JRST ALTRTZ ;RETURN ZERO IF AT BEGINNING
00500 ADD ALTP,[POINT 0,0,28]
00600 TLNE ALTP,(<1B0>) ;CHECK WORD OVERFLOW
00700 SUB ALTP,[POINT 0,1,0]
00800 LDB T3,ALTP ;GET CHAR
00900 POPJ P,
01000
01100 ALTRTZ: MOVEI T3,0 ;RETURN 0
01200 POPJ P,
01300
01400 ALTBCS: PUSH P,ALTP ;SAVE PNTR
01500 ALTBC1: PUSHJ P,ALTBAK ;PREV CHAR
01600 JUMPE T3,APOPJ ;END OF LINE
01690 IFE %SS040, <
01700 CAMN T3,C ;MATCH?
01710 >; END OF IFE %SS040
01720 IFN %SS040, <
01730 PUSHJ P,CHKCFL ;COMPARE, INCLUDING LETTER CASE-FOLDING
01740 >; END OF IFN %SS040
01800 JRST APOPJ ;YES: RETURN
01900 AOJA T2,ALTBC1 ;NO: COUNT AND CONTINUE
02000
02100 APOPJ: POP P,ALTP ;RESTORE PNTR
02200 POPJ P, ;RETURN
02205
02210 IFN %SS040, <
02215 CHKCFL: PUSH P,FL ;SAVE THE FLAGS
02220 PUSH P,T1 ;SAVE THE B.P. (FROM ALTCS)
02225 PUSH P,T2 ;SAVE THE REPEAT COUNT
02230 MOVE T2,[POINT 7,ARBBUF] ;GET UP ARBITRARY STRING PARMS
02235 MOVEI T4,MXWPL*^D10 ; DITTO
02240 SETZM ARBCNT ; DITTO
02245 MOVE T1,[POINT 7,ALTSSG] ;POINT AT SEARCH STRING
02250 MOVEI C,(T3) ;GET THE TEXT CHAR
02255 PUSHJ P,CHRMAT ;CALL TO DO THE CHARACTER MATCHING
02260 AOS -3(P) ; FAILED, SET SKIP RETURN
02265 POP P,T2 ;RESTORE REPEAT COUNT
02270 POP P,T1 ;RESTORE B.P.
02275 POP P,FL ;RESTORE FLAGS
02280 POPJ P, ;RETURN TO CALLER (+1 IF NO MATCH)
02285 >; END OF IFN %SS040
02300
02400 ALTBDL: MOVEM ALTP,SVALTP ;SAVE PNTR
02500 ALTBD1: PUSHJ P,ALTBAK ;BACK A CHAR
02600 JUMPE T3,ALTBD2 ;DONE IF NO MORE
02700 MOVE C,T3 ;FOR PRINTING
02800 TRNN FL,EXTOG ;PRINT IF NON-EXPERT
02900 PUSHJ P,ALTDPN
02950 SOS ALTCNT ;DECR CHAR POSITION ;** FIX **
03000 SOJG T2,ALTBD1
03100 ALTBD2: PUSHJ P,FORCE ;FORCE PRINTING
03200 PUSH P,ALTP ;SAVE NEW PNTR
03300 MOVE T3,SVALTP ;GET SET TO MOVE LINE
03400 ALTBD3: LDB C,T3
03500 DPB C,ALTP ;MOVE CHAR
03600 JUMPE C,APOPJ ;DONE IF ZERO
03700 IBP T3 ;ADVANCE PNTRS
03800 IBP ALTP
03900 JRST ALTBD3
04000
04100 SUBTTL THE _ COMMAND
00100 SET: PUSHJ P,SCAN ;GET THE THING TO SET TO
00200 TRNN FL,IDF ;MUST BE AN IDENT
00300 NERROR ILC
00400 PUSHJ P,DOSET ;CALL SUBROUTINE TO DO SET COMMAND
00500 NERROR ILC ;ERROR RETURN
00600 JRST COMND ;OK RETURN
00700
00800 DOSET: PUSHJ P,XCODE ;FETCH DISPATCH ARG
00890 IFE %SS025, <
00900 TLZ T1,477777 ;CLEAR GIVE ADDRS
00910 >; END OF IFE %SS025
00920 IFN %SS025, <
00930 TLZ T1,-1-XNUMF-XOPTF ;CLEAR 'GIVE' ADDRESS
00940 >; END OF IFN %SS025
01000 PUSH P,T1 ;SAVE DISPATCH
01100 TLNN FL2,INPARS ;SKIP TERM CHECK IF PARSE
01200 PUSHJ P,SCAN ;AND CHECK FOR TERMINATOR
01250 ;;*FIX* ;CODE TO PERMIT SWITCHES BEFORE = ON INITIAL CMD LINE
01300 ;;*FIX* CAIE C,":" ;COLON OK ALSO
01400 ;;*FIX* CAIN C,"=" ;IS IT AN =?
01410 MOVE T1,(P) ;GET THE SWITCH FLAGS ;** FIX **
01420 TLNN T1,XVARF ;TEST FOR VARIABLE REQ'D ;** FIX **
01430 TLNN FL2,INPARS ;TEST FOR SCANNING CMD LINE ;** FIX **
01440 CAIE C,"=" ;TEST FOR "=" ONLY IF NEEDED ;** FIX **
01450 CAIN C,":" ;TEST FOR COLON ;** FIX **
01500 JRST SETVAR ;YES: SET SOMETHING
01600 POP P,T1 ;GET DISPATCH ADDR
01610 IFN %SS025, <
01620 TLNE T1,XOPTF ;TEST FOR OPTIONAL ARGUMENT
01630 TLZA T1,XVARF ; YES, CLEAR VARIABLE BIT & SKIP
01640 >; END OF IFN %SS025
01700 TLNN T1,XVARF ;BETTER NOT REQUIRE ARG
01800 PUSHJ P,CKTERM ;CHECK LEGAL TERM
01900 POPJ P,
02000 HRRZ T1,T1
02100 JUMPE T1,CPOPJ
02200 PUSHJ P,0(T1) ;DO ROUTINE
02300 JRST CPOPJ1 ;GIVE OK RETURN
02400
02500 SETM33: TRZA FL,M37F!DPYF ;MODEL 33
02600 SETM37: TRO FL,M37F
02700 POPJ P,
02800
02900 CLRSEQ: TDZA T1,T1
03000 SETSEQ: MOVNI T1,1
03100 MOVEM T1,UNSEQF
03200 POPJ P,
03205
03210 IFN %SS046, <
03215 SETTXT: HRRZM P,UNSEQF ;SET + TO REMOVE SEQ #'S AND PAGE MARKS
03220 POPJ P, ;RETURN TO CALLER
03225 >; END OF IFN %SS046
03230
03235 IFN 5SS047, <
03240 CLRBAS: PUSHJ P,SETBAS ;SET BASICF & TEST FOR PARSE SWITCH
03245 HRRZS BASICF ;NOW SET BASICF 0,,-1 FOR /NOBASIC
03250 POPJ P, ;RETURN TO CALLER
03255 >; END OF IFN %SS047
03300
03400 SETBAS: TLNN FL2,INPARS!IFN %SS047,<INOPTF> ;ILLEGAL IF NOT INITIAL
03500 NERROR ILC
03600 SETOM BASICF
03700 POPJ P,
03800
03805 IFN %SS036, <
03810 CLRCRE: TDZA T1,T1 ;GET ZERO & SKIP
03815 SETCRE: SETO T1, ;GET -1 FOR CREATE
03820 TLNN FL2,INPARS!INOPTF ;TEST FOR COMMAND SCANNING
03825 NERROR ILC ; ILLEGAL IF USER CMD
03830 MOVEM T1,CREATF ;SET THE CREATE FLAG
03835 TRZ FL,READOF ;CLEAR /READONLY
03840 POPJ P, ;RETURN TO CALLER
03845 >; END OF IFN %SS036
03850
03900 SETRED: TLNN FL2,INPARS!IFN %SS036, <INOPTF> ;ILLEGAL IF NOT INITIAL
04000 NERROR ILC
04100 TRO FL,READOF
04110 IFN %SS036, <
04120 SETZM CREATF ;ASSUME NOT /CREATE
04130 >; END OF IFN %SS036
04200 POPJ P,
04300
04400 SETDPY: TRO FL,DPYF ;SET TO A DISPLAY
04500 POPJ P,
04600
04690 IFE %SS025, <
04700 QON: TLZA FL,QMODF
04704 >; END OF IFE %SS025
04708 IFN %SS025, <
04712 QON: JRST QON1 ;JUMP IF NO ARGUMENT
04716 ; ENTRY AT QON+1 IF VARIABLE ARGUMENT GIVEN
04720 ANDI C,377 ;TRIM TO 8 BITS
04724 CAILE C,040 ;TEST FOR CONTROL CHAR
04728 CAILE C,176 ;TEST FOR PRINTABLE CHAR
04732 JRST SETV2 ; GIVE ERROR IF NOT PRINTABLE
04736 SKIPGE CS ;TEST FOR SPECIAL CHARACTER
04740 TRNE FL,TERMF!NUMF!IDF ;TEST FOR ANY TEXT
04744 JRST SETV2 ; ERROR IF NOT SPECIAL CHARACTER
04748 HRLM C,(P) ;STORE CHARACTER FOR NOW
04752 PUSHJ P,SCAN ;SCAN FOR NEXT CHARACTER
04756 PUSHJ P,CKTERM ;NOW CHECK FOR TERMINATOR
04760 JRST SETV2 ; ERROR, GIVE ERROR RETURN
04764 HLRZ C,(P) ;RESTORE _C128 CHARACTER
04768 MOVEM C,CHR128 ;SET NEW _C128 CHARACTER
04772 QON1: TLZA FL,QMODF ;SET _C128 MODE & SKIP
04776 >; END OF IFN %SS025
04800 QOFF: TLO FL,QMODF
04900 POPJ P,
05000
05100 SETDCD: TLOA FL2,PDECID
05200 CLRDCD: TLZ FL2,PDECID
05300 POPJ P,
05310
05320 IFN %SS040, <
05330 CLREXT: TDZA T1,T1 ;GET 0 FOR /NOEXACT
05340 SETEXT: SETO T1, ;GET -1 FOR /EXACT
05350 MOVEM T1,EXACTF ;SET /EXACT FLAG
05360 POPJ P, ;RETURN TO CALLER
05370 >; END OF IFN %SS040
05400
05500 SETOLD: MOVEI T1,1
05600 JRST STOBAK
05700 CLRBAK: TDZA T1,T1
05800 SETBAK: MOVNI T1,1
05900 STOBAK: MOVEM T1,BAKF
06000 POPJ P,
06100
06200 QSON: TROA FL2,QSEPF
06300 QSOFF: TRZ FL2,QSEPF
06400 POPJ P,
06500
06600 SETCHK: TLOA FL2,DSKCK
06700 CLRCHK: TLZ FL2,DSKCK
06800 POPJ P,
06900
07000 SETNOV: TRZA FL,EXTOG
07100 SETEXP: TRO FL,EXTOG
07200 POPJ P,
07300
07400 SETUPP: TDZA T1,T1
07500 SETLOW: MOVEI T1,40
07600 MOVEM T1,CASEBT
07700 POPJ P,
07800
07900 SETNUM: TRZA FL2,NONUMF
08000 CLRNUM: TRO FL2,NONUMF
08100 POPJ P,
08200
08300 CLRZAP: TDZA T1,T1
08400 SETZAP: MOVNI T1,1
08500 MOVEM T1,DELETF
08600 POPJ P,
00100 SETVAR: TLNN FL2,INPARS
00200 JRST SETV0 ;SKIP OVER EXTRA IF NOT PARSE
00300 TRZ FL,F.LAHD ;CLEAR LOOK-AHEAD
00400 SETZM SAVCHR ;...
00500 SETZM SAVC ;...
00600 SETV0: PUSHJ P,SCAN ;GET AN ARG
00700 MOVE T3,0(P) ;GET WHAT TO DO
00800 TLNN T3,XVARF ;NEED ARG
00900 JRST SETV2 ;NO: ERROR
00910 IFN %SS025, <
00920 TLNE T3,XOPTF ;TEST FOR OPTIONAL ARGUMENT
00930 TRNN T3,-1 ;TEST FOR DISPATCH ADDRESS
00940 SKIPA ; SKIP IF NOT OPTIONAL OR NO ADDRESS
00950 AOS (P) ; ELSE INCR ADDRESS BY 1 TO SHOW ARGUMENT GIVEN
00960 >; END OF IFN %SS025
01000 TLNN T3,XNUMF-XVARF ;NEED NUMERIC ARG?
01100 JRST SETV1 ;NO: JUST DISPATCH
01200 TRNN FL,NUMF ;YES: IS IT?
01300 JRST SETV2 ;NOPE - LOSE
01400 TLNE FL2,INPARS
01500 JRST SETV1 ;SKIP TERM CHECK IN PARSE
01600 PUSH P,T2 ;SAVE IT
01700 PUSH P,T1 ;IN BINARY AND ASCII
01800 PUSHJ P,SCAN ;CHECK FOR TERMINATOR
01900 POP P,T1 ;GET BACK ASCID
02000 POP P,T2 ;BINARY
02100 PUSHJ P,CKTERM ;WHICH HAD BETTER BE THERE
02200 JRST SETV2
02300 SETV1: POP P,T3 ;GET DISPATCH
02400 HRRZ T3,T3
02500 JUMPE T3,CPOPJ
02600 PUSHJ P,0(T3) ;DISPATCH
02700 JRST CPOPJ1 ;AND RETURN TO CMD LOOP
02800
02900 SETV2: POP P,0(P) ;PRUNE PDL
03000 POPJ P, ;AND GIVE ERROR RETURN
03100
03200 SETPLN: MOVEM T2,PLINES ;PLINES FOR P
03300 POPJ P,
03400
03490 IFN JUSTSW!PPNTSW, <
03500 SETRMR: MOVEM T2,RMAR ;RIGHT MARGIN FOR JUSTIFY
03600 POPJ P,
03700
03800 SETLMR: MOVEM T2,LMAR ;LEFT MARGIN
03900 POPJ P,
03910 >; END OF IFN JUSTSW!PPNTSW
04000
04090 IFN JUSTSW, <
04100 SETPMR: MOVEM T2,PMAR ;PARAGRAPH MARGIN
04200 POPJ P,
04210 >; END OF IFN JUSTSW
04300
04400 SETINC: ;HERE TO SET THE INCREMENT
04410 IFN %SS027, <
04420 JSP T2,CKZERO ;CHECK FOR ZERO VALUE
04430 >; END OF IFN %SS027
04440 MOVEM T1,INCR ;PERM INCREMENT
04490 IFE %SS027, <
04500 MOVEM T1,TECINC ;SETUP OTHER INCR
04550 >; END OF IFE %SS027
04600 POPJ P,
04700
04790 IFN JUSTSW, <
04800 SETMLN: MOVEM T1,MAXLN ;MAXIMUM LINE NUMBER
04900 POPJ P,
04910 >; END OF IFN JUSTSW
05000
05100 SETSAV: MOVEM T2,SSAVEN ;STORE IN RESET PLACE TOO
05200 MOVEM T2,SAVEN
05300 POPJ P,
05400
05500 SETISV: MOVEM T2,SISAVN
05600 MOVEM T2,ISAVEN
05700 POPJ P,
05800
05890 IFN JUSTSW!PPNTSW, <
05900 SETLEN: MOVEM T2,PAGESZ
06000 POPJ P,
06010 >; END OF IFN JUSTSW!PPNTSW
06100
06200 IFN %SS050, <
06300 SETCOR: TLNN FL2,INPARS!INOPTF ;TEST FOR PARSE SWITCH
06400 NERROR ILC ; NO, ILLEGAL CMD
06500 IMULI T2,^D1024 ;CONVERT K TO WORDS
06600 SKIPE T2 ;SKIP IF ZERO, RETAINING DEFAULT VALUE
06700 MOVEM T2,CORSIZ ;STORE AS REQUESTED CORE SIZE
06800 POPJ P, ;RETURN
06900 >; END OF IFN %SS050
00100 SETNM1: PUSHJ P,READN0 ;GET A FILE SPEC
00200 POPJ P, ;ERROR RETURN
00300 SKIPN RSW ;ERROR IF SWITCHES SEEN
00400 SKIPE SSW
00500 POPJ P,
00600 PUSHJ P,CKTERM ;GRNTEE EOL
00700 POPJ P, ;NOPE
00800 JRST CPOPJ1 ;YEP
00900
01000 SETNAM: ;HERE FOR /NAME:... COMMAND
01010 IFN %SS006*%SS074, <
01020 TRNE FL,READOF ;TEST FOR /READONLY
01030 NERROR IRO ; YES, ERROR
01040 >; END OF IFN %SS006*%SS074
01050 TLNN FL2,INPARS!INOPTF ;TEST FOR COMMAND SCANNING ;** FIX **
01060 PUSHJ P,SETNM1 ;GET FILE SPEC , CHECK ERRORS
01100 NERROR ILC
01110 IFN %SS006, <
01120 IFE %SS074, <
01130 TRNN FL,READOF ;TEST FOR /READONLY
01140 >; END OF IFE %SS074
01150 >; END OF IFN %SS006
01200 SKIPE TMPDEV ;DEVICES ILLEGAL
01300 NERROR ILC
01400 MOVE T1,[TMPBLK,,NEWBLK]
01500 BLT T1,NEWBKE ;SET UP NEW BLOCK
01600 POPJ P, ;RETURN
01700
01800 SETRUN: PUSHJ P,SETNM1 ;GET FILE SPEC - CHECK ERRORS
01900 NERROR ILC
02000 SKIPN T1,TMPDEV ;SEE IF DEVICE SPECIFIED
02100 MOVSI T1,'SYS' ;NO: USE SYS
02200 MOVEM T1,TMPDEV ;SAVE IT
02300 MOVE T1,[TMPBLK,,RUNBLK]
02400 BLT T1,RUNBKE ;SET UP FILE ARGS FOR RUN UUO
02500 POPJ P, ;RETURN
02600
02700 ;ROUTINE TO CHECK PROPER TERMINATION
02800
02900 CKTERM: TLNE FL2,INOPTF ;CHECK IF OPTION FILE
03000 JRST CKTRM1
03100 TLNE FL2,INPARS ;SEE IF CMD STRING
03200 JRST CPOPJ1 ;ALWAYS SAY PROPER TERM - PARSE WILL CHECK
03300 CKTRM0: TRNE FL,TERMF ;PROPER LINE TERM?
03400 AOS (P) ;YES
03500 POPJ P, ;NON-SKIP IF NO
03600
03700 CKTRM1: CAIE C,"/" ;ALLOW SPECIAL CHARS
03800 CAIN C,"," ;IF IN OPTION FILE
03900 JRST CPOPJ1
04000 CAIN C,"-" ;IF NO SPEC CHRS FOUND
04100 JRST CPOPJ1
04200 JRST CKTRM0 ;ALSO CHECK EOL
04300
04400 ;HANDLE OPTION FILES
04500
04600 SETOPT: TRNE FL,IDF ;CHECK FOR IDENT
04700 SKIPN T1,ACCUM ;AND NON-ZERO ATOM
04800 NERROR ILC
04900 MOVEM T1,OPTION ;SET UP OPTION
05000 TLNE FL2,INPARS ;INITIAL
05100 JRST OPTSWT ;YES: USE SPECIIAL ROUTINE
05200 PUSHJ P,SCAN ;CHECK TERM
05300 PUSHJ P,CKTERM
05400 NERROR ILC ;LOSE
05500 PUSHJ P,DOOPT
05600 JRST SETOP1 ;NOT FOUND
05700 JRST SETOP2 ;GROSS ERROR
05800 POPJ P, ;OK RETURN
05900
06000 SETOP1: OUTSTR [ASCIZ /? Option not found
06100 /]
06200 POPJ P,
06300 SETOP2: OUTSTR [ASCIZ /? Syntax error in option file
06400 /]
06500 POPJ P,
06600
06700 SETSTP: ;HERE TO SET THE INITIAL STEP
06710 IFN %SS027, <
06720 JSP T2,CKZERO ;CHECK FOR ZERO VALUE
06730 >; END OF IFN %SS027
06740 MOVEM T1,TECINC ;SET UP INCRS
06790 IFE %SS027, <
06800 MOVEM T1,INCR
06900 POPJ P,
06950 >; END OF IFE %SS027
07000
07100 SETFST: ;HERE TO SET STARTING LINE #
07110 IFN %SS027, <
07120 JSP T2,CKZERO ;CHECK FOR ZERO VALUE
07130 >; END OF IFN %SS027
07140 MOVEM T1,TECFST ;SET UP START
07200 POPJ P,
07210
07220 IFN %SS027, <
07230 CKZERO: CAME T1,[<ASCII /00000/>!1] ;CHECK FOR ZERO VALUE
07240 JRST (T2) ; NO, RETURN TO CALLER
07250 JRST SETV2 ; YES, TAKE ERROR RETURN
07260 >; END OF IFN %SS027
07300
07400 IFN %SS052, <
07500 CLRBLK: SKIPA T1,[2] ;GET MINIMUM SPACE REQ'D, COMPRESSED FILE
07600 SETBLK: HRRZI T1,-1 ;GET MINIMUM SPACE REQ'D, LINE BLOCKED FILE
07700 TLNN FL2,INPARS!INOPTF;TEST FOR COMMAND LINE
07800 NERROR ILC ; NO, ERROR
07900 MOVEM T1,FILFMT ;STORE FOR FILE TESTING
08000 POPJ P, ;RETURN TO CALLER
08100 >; END OF IFN %SS052
08200
08300 SUBTTL = COMMAND
00100
00200 GIVE: PUSHJ P,SCAN ;FIND OUT WHAT HE WANTS TO KNOW
00300 CAIN C,"." ;CURRENT LINE/PAGE?
00400 JRST GVDOT ;YES
00500 TRNN FL,IDF ;IF NOT, MUST BE AN IDENT
00600 NERROR ILC
00700 PUSHJ P,XCODE ;FETCH ACTUAL SIXBIT ARG
00800 HLRZ T1,T1 ;GET GIVE ADDRS
00900 TRZ T1,XNUMF!IFN %SS025,<XOPTF> ;CLEAR FUNNY BITS
01000 JUMPE T1,XERR
01100 PUSH P,T1 ;SAVE DISPATCH
01200 PUSHJ P,SCAN ;CHECK FOR TERM
01300 TRNN FL,TERMF
01400 NERROR ILC
01405 IFN %SS012, <
01410 TRNE FL2,COMFLF ;TEST FOR @-FILE
01415 SKIPN ACCUM ;TEST FOR SOMETHING TO TYPE
01420 JRST GIVE3 ; JUMP IF NON-@ OR NOTHING THERE
01425 MOVE T4,[POINT 6,ACCUM] ;POINT AT KEYWORD TEXT
01430 GIVE1: ILDB C,T4 ;GET THE NEXT CHARACTER
01435 JUMPE C,GIVE2 ; NULL, JUMP
01440 ADDI C,40 ;CONVERT TO ASCII
01445 OUTCHR C ; & TYPE IT
01450 TLNE T4,770000 ;TEST FOR DONE
01455 JRST GIVE1 ; NO, REPEAT
01460 GIVE2: OUTCHR ["="] ;TYPE AN EQUAL SIGN
01465 GIVE3: ;TO HERE IF NOTHING TO TYPE
01470 >; END OF IFN %SS012
01500 POP P,T1 ;NOW FIND OUT WHAT HE WANTS
01600 PUSHJ P,0(T1) ;GIV INFO
01700 JRST COMND ;AND RETURN
01800
01900 GIVBIG: TRNE FL,BGSN ;HAVE WE SEEN THAT PAGE
02000 JRST GVBG1 ;YES, ALL IS OK
02100 MOVSI T1,1 ;WILL HAVE TO SEARCH FOR IT
02200 MOVEM T1,DPG
02300 MOVEI SINDEX,0
02400 PUSHJ P,FIND
02500 TRNN FL,BGSN ;SHOULD HAVE SEEN IT NOW
02600 ERROR ICN ;WE ARE IN TROUBLE
02700 GVBG1: MOVE T1,BGPG ;GET IT
02800 GIV2: MOVEI T3,OCHR ;ROUTINE FOR DECIMAL PRINTER TO OUTPUT TO
02900 PUSHJ P,DECPR ;PRINT DECIMAL
03000 GIV3: PUSHJ P,FORCE ;FORCE OUTPUT
03100 GIV1:
03200 OCRLF
03300 POPJ P,
03400
03500 GVCASE:
03600 TRNE FL,DPYF
03700 OUTSTR [ASCIZ /Display /]
03800 TRNE FL,M37F
03900 OUTSTR [ASCIZ /Model 37 /]
03910 IFN %SS025, <
03920 TRNN FL,M37F ;TEST FOR M33
03930 OUTSTR [ASCIZ /Model 33 /] ; YES, SAY SO
03940 >; END OF IFN %SS025
04000 TLNE FL,QMODF
04100 OUTSTR [ASCIZ /C64 /]
04110 IFN %SS025, <
04120 TLNN FL,QMODF ;TEST FOR _C128 MODE
04130 JRST [ ; YES, JUMP
04140 OUTSTR [ASCIZ /C128:/] ;TELL THE USER
04150 OUTCHR CHR128 ; TYPE THE CURRENT _C128 CHAR
04160 OUTCHR [" "] ; & DELIMIT BY A BLANK
04170 JRST .+1 ;CONTINUE
04180 ]
04190 >; END OF IFN %SS025
04200 TRNE FL2,QSEPF
04300 OUTSTR [ASCIZ /Separators /]
04400 MOVEI T1,[ASCIZ /Lower
04500 /]
04600 SKIPN CASEBT
04700 MOVEI T1,[ASCIZ /Upper
04800 /]
04900 ;PRINT CURRENT CASE
05000 OUTSTR @T1
05100 POPJ P,
05200 GIVER: SKIPN T1,SVERN
05300 POPJ P,
05350 OUTCHR [" "] ;TYPE LEADING BLANK TO GET "?" OUT OF COL 1 FOR MPB ;** FIX **
05400 OUTSTR @ETBL2-1(T1)
05500 POPJ P,
05590 IFN JUSTSW!PPNTSW, <
05600 GVRM: MOVE T1,RMAR ;RIGHT MARGIN
05700 JRST GIV2
05710 >; END OF IFN JUSTSW!PPNTSW
05720 IFN %SS021, <
05730 IFN JUSTSW, <
05740 GVMLN: SKIPA T1,MAXLN ;GET MAXIMUM LINE # & SKIP
05750 >; END OF IFN JUSTSW
05760 GVINC: MOVE T1,INCR ;GET CURRENT INCREMENT
05770 JRST OUNTSN ; GO TYPE IT & RETURN TO CALLER
05780 >; END OF IFN %SS021
05790 IFE %SS021, <
05800 GVMLN: MOVE T1,MAXLN ;MAXIMUM LINE NUMBER
05900 PUSHJ P,OUTSN
06000 JRST GIV1
06010 >; END OF IFE %SS021
06080 IFN JUSTSW!PPNTSW, <
06090 GVPG: SKIPA T1,PAGESZ ;GET PAGE SIZE & SKIP
06100 GVLM: MOVE T1,LMAR ;LEFT MARGIN
06200 JRST GIV2
06210 >; END OF IFN JUSTSW!PPNTSW
06290 IFN JUSTSW, <
06300 GVPM: MOVE T1,PMAR ;PARAGRAPH LEFT MARGIN
06400 JRST GIV2
06410 >; END OF IFN JUSTSW
06500 ;*FIX* GVPG: MOVE T1,PAGESZ
06600 ;*FIX* JRST GIV2
06700
06800 GVPLN: MOVE T1,PLINES
06900 JRST GIV2
07000
07100 GVSAV: SKIPGE T1,SAVEN ;SAVE LEFT
07200 MOVEI T1,0
07300 JRST GIV2
07400 GVISAV: SKIPGE T1,ISAVEN ;ISAVE LEFT
07500 MOVEI T1,0
07600 JRST GIV2
07700
07800 GIVDSK: PUSHJ P,TELSPC
07900 POPJ P,
08000
08100 GIVCHK: TLNN FL2,DSKCK
08200 OUTSTR [ASCIZ "No "]
08300 OUTSTR [ASCIZ "disk check
08400 "]
08500 POPJ P,
08600
08700 GIVDCD: TLNN FL2,PDECID
08800 OUTSTR [ASCIZ "No "]
08900 OUTSTR [ASCIZ "auto decide
09000 "]
09100 POPJ P,
09105
09110 IFN %SS040, <
09115 GIVEXT: SKIPE EXACTF ;TEST FOR /EXACT
09120 OUTSTR [ASCIZ /Exact/] ; YES, TYPE IT
09125 SKIPN EXACTF ;TEST FOR /NOEXACT
09130 OUTSTR [ASCIZ /Folded/]; YES, TYPE IT
09135 OUTSTR [ASCIZ / letter comparison
09140 /] ;FINISH THE MESSAGE
09145 POPJ P, ;RETURN
09150 >; END OF IFN %SS040
09200
09300 GIVBAK: SKIPN BAKF
09400 OUTSTR [ASCIZ "No "]
09410 SKIPLE BAKF ;TEST FOR /OLD OPTION ;** FIX **
09420 OUTSTR [ASCIZ "Old "] ; YES, TYPE IT ;** FIX **
09500 OUTSTR [ASCIZ "backup file will be created
09600 "]
09700 POPJ P,
09800
09900 GIVSEQ: SKIPE UNSEQF
10000 OUTSTR [ASCIZ "No "]
10100 OUTSTR [ASCIZ "sequence numbers will be on output file
10200 "]
10210 IFN %SS046, <
10220 SKIPLE UNSEQF ;TEST FOR /TEXT
10230 OUTSTR [ASCIZ "Page marks will be removed
10240 "] ; YES, TELL THE USER
10250 >; END OF IFN %SS046
10300 POPJ P,
10400
10500 IFN %SS052, <
10600 GIVBLK: MOVE T1,FILFMT ;GET THE FILE-FORMAT WORD
10700 CAIN T1,2 ;TEST FOR COMPRESSED-FORMAT
10800 OUTSTR [ASCIZ "No "] ; YES, TYPE THAT INFO
10900 OUTSTR [ASCIZ "Line-blocking
11000 "] ;TYPE THE TEXT
11100 POPJ P, ;RETURN TO CALLER
11200 >; END OF IFN %SS052
11300
11400 IFN %SS073, <
11500 GIVCOL: MOVE T1,[2,,T2] ;POINT AT ARG LIST
11600 MOVEI T2,.TOWID ;GET TRMOP. FTN FOR TTY WIDTH
11700 MOVE T3,TTYUDX ;GET TTY UDX
11800 TRMOP. T1, ;GET CARRIAGE WIDTH FOR MY TTY
11900 MOVEI T1,^D72 ; FAILED, ASSUME 72
12000 IFN %SS012, <
12100 TRNE FL2,COMFLF ;TEST FOR @-FILE
12200 OCRLF ; YES, RETURN THE CARRIAGE
12300 >; END OF IFN %SS012
12400 TRNE FL2,NONUMF!COMFLF ;TEST FOR /NONUMBER OR @-FILE
12500 JRST GVCOL1 ; EITHER, JUMP
12600 OUTCHR [" "] ;TYPE A HORIZ. TAB
12700 SUBI T1,^D8 ; & ACCOUNT FOR IT
12800 GVCOL1: MOVNI T2,^D9 ;GET INNER-LOOP COUNTER
12900 GVCOL2: MOVEI C,"1"+^D9(T2) ;GET A CHAR TO TYPE
13000 OUTCHR C ; & TYPE IT
13100 SOJLE T1,GIV1 ;DECR CARR WIDTH & TEST FOR DONE
13200 AOJL T2,GVCOL2 ;INCR LOOP CTR & JUMP IF MORE TO DO
13300 SOJLE T1,GIV1 ;DECR CARR WIDTH & TEST FOR DONE
13400 OUTCHR [" "] ; NO, TYPE A BLANK
13500 JRST GVCOL1 ;REPEAT THE LOOP ("123456789 ")
13600 >; END OF IFN %SS073
00090 IFE %SS021, <
00100 GVINC: MOVE T1,INCR ;GET CURRENT INCREMENT
00200 PUSHJ P,OUTSN ;GO PRINT IT
00300 JRST GIV1 ;AND A CRRET
00310 >; END OF IFE %SS021
00400
00500 GVDOT: PUSHJ P,SCAN ;SEE IF A TERMINATOR IS THERE
00600 TRNN FL,TERMF
00700 NERROR ILC ;NO TERMINATOR
00710 IFN %SS012, <
00720 TRNE FL2,COMFLF ;TEST FOR @-FILE
00730 OUTSTR [ASCIZ /.=/] ; YES, LABEL THE OUTPUT
00740 >; END OF IFN %SS012
00800 MOVE T2,CLN ;GET CURRENT LINE
00900 MOVE T1,CPGL ;AND CURRENT PAGE
01000 GVDOT1: MOVEM T2,LINOUT
01100 OUTSTR LINOUT ;PRINT IT
01200 PUSHJ P,GIV2 ;PRINT PAGE
01300 JRST COMND ;AND RETURN
01400
01500 OCTPR: SKIPA CS,[^O10]
01600 DECPR: MOVEI CS,^D10
01700 RDXPR: IDIVI T1,0(CS)
01800 HRLM T2,(P)
01900 SKIPE T1
02000 PUSHJ P,RDXPR
02100 HLRZ C,(P)
02200 ADDI C,"0"
02300 JRST (T3) ;EXCEPT HAS ARBITRARY OUTPUT ROUTINE
02400
02500 GVSTR: MOVEI T1,SRPNT ;GET THE POINTER TO POINTER BLOCK
02600 HRLI T1,-SRNUM ;SET COUNT
02610 IFN %SS043, <
02620 SKIPE SRPNT ;SKIP IF NOTHING TO PRINT
02630 >; END OF IFN %SS043
02700 OUTSTR [ASCIZ / Find:
02800 /]
02900 PUSHJ P,GVSTR3
03000 MOVEI T1,R2PNT
03100 HRLI T1,-SRNUM
03110 IFN %SS043, <
03120 SKIPN R1PNT ;SKIP IF SOMETHING TO PRINT
03130 IFN EXTEND, <
03140 JRST GVSTR0 ; ELSE, JUMP
03150 >; END OF IFN EXTEND
03160 IFE EXTEND, <
03170 POPJ P, ; ELSE, RETURN
03180 >; END OF IFE EXTEND
03190 >; END OF IFN %SS043
03200 OUTSTR [ASCIZ / Substitute:
03300 /]
03400 PUSHJ P,GVSTR3
03500 MOVEI T1,R1PNT
03600 HRLI T1,-SRNUM
03700 OUTSTR [ASCIZ / For:
03800 /]
03900 PUSHJ P,GVSTR3
04000 IFN EXTEND,<
04010 IFN %SS043, <
04020 GVSTR0: SKIPE @LSPTT+LSNUM-1 ;SKIP IF NOTHING TO PRINT
04030 >; END OF IFN %SS043
04100 OUTSTR [ASCIZ / Line-contents:
04200 /]
04300 MOVEI T4,0
04400 MOVEI T5,LSNUM
04500 MOVEI T3,OCHR
04600 GVST1: ;HERE TO PRINT NEXT LINE-SEARCH STRING
04610 IFN %SS043, <
04620 SKIPN @LSPTT-1(T5) ;TEST FOR NOTHING MORE TO PRINT
04630 POPJ P, ; YES, THEN RETURN
04640 >; END OF IFN %SS043
04650 MOVEI T1,1(T4)
04700 PUSHJ P,DECPR
04800 MOVEI C,":"
04900 PUSHJ P,OCHR
05000 PUSHJ P,FORCE
05100 OCRLF
05200 MOVEI T1,-1(T5)
05300 IMULI T1,SRNUM
05400 ADDI T1,LSPNT
05500 HRLI T1,-SRNUM
05600 PUSHJ P,GVSTR3
05700 ADDI T4,1
05800 SOJG T5,GVST1
05900 >
06000 POPJ P,
06100
06190 IFE %SS021, <
06200 GIVFST: MOVE T1,TECFST ;GET CURRENT START
06300 PUSHJ P,OUTSN ;PRINT IT
06400 JRST GIV1 ;CRLF AND RETURN
06410 >; END OF IFE %SS021
06500
06510 IFN %SS021, <
06520 GIVFST: SKIPA T1,TECFST ;GET STARTING # & SKIP
06530 >; END OF IFN %SS021
06600 GIVSTP: MOVE T1,TECINC ;GET INPUT INCR
06690 IFE %SS021, <
06700 PUSHJ P,OUTSN ;PRINT
06800 JRST GIV1 ;AND RETURN
06810 >; END OF IFE %SS021
06820 IFN %SS021, <
06830 JRST OUNTSN ;TYPE #, END THE LINE, AND RETURN
06840 >; END OF IFN %SS021
06900
07000 GIVLOC: MOVE T2,BUFP ;GIVE HIM FIRST LOC IN BUFFER
07100 SKIPN T2,0(T2) ;IF ANYTHING THERE
07200 MOVE T2,[ASCII /00000/]
07300 MOVE T1,OPG ;OUTPUT PAGE -1
07400 AOJA T1,GVDOT1
07500
07600 GIVZAP: OUTSTR [ASCIZ "Input file will "]
07700 SKIPN DELETF ;GIVE CORRECT MESSAGE
07800 OUTSTR [ASCIZ "NOT "]
07900 OUTSTR [ASCIZ "be deleted.
08000 "]
08100 POPJ P,
00100 GVSTR3: SKIPN T2,(T1) ;IS THERE ONE THERE?
00200 POPJ P, ;NO, DONE
00300 GVSTR2: ILDB C,T2 ;NEXT CHR
00400 JUMPE C,GVSTR1 ;DONE
00500 PUSHJ P,OCHR ;PRINT IT
00600 JRST GVSTR2 ;AND CONTINUE
00700 GVSTR1: PUSHJ P,FORCE ;CLEAR OUTPUT DEVICE
00800 OCRLF
00900 AOBJN T1,GVSTR3 ;IF THERE IS ONE
01000 POPJ P,
01100
01200 GVNAM: MOVEI T4,ORGBLK
01300 SKIPE NEWNAM ;NEW NAME GIVEN?
01400 MOVEI T4,NEWBLK ;YES - USE IT
01405 IFN %SS036, <
01410 SKIPE CREATF ;TEST FOR CREATING
01415 OUTSTR [ASCIZ /Creating /] ; YES, SAY SO
01420 >; END OF IFN %SS036
01425 IFN %SS006, <
01430 TRNE FL,READOF ;TEST FOR READONLY
01435 TLNE FL,COPFIL ;TEST FOR COPYING FROM A FILE
01440 SKIPA ; SKIP IF COPYING OR NOT /READONLY
01445 OUTSTR [ASCIZ /Reading /] ; /READONLY & NOT COPYING, TELL THE USER
01450 >; END OF IFN %SS006
01500 GVNM1: PUSHJ P,GVNAM0
01600 JRST GIV1
01700
01800 ;;*FIX*GVRUN: SKIPN RUNNAM ;NEW NAME GIVEN?
01900 ;;*FIX* JRST GVRUN1 ;NO - JUST TELL HIM OLD INFO
02000 ;;*FIX* MOVEI T4,RUNBLK ;YES - USE NEW INFO
02100 ;;*FIX* JRST GVNM1 ;PRINT & RETURN
02200
02300 ;;*FIX*GVRUN1: OUTSTR [ASCIZ "SYS:COMPIL"]
02400 ;;*FIX* JRST GIV1
02410
02420 GVRUN: MOVEI T4,RPGR ;ASSUME DEFAULT RUNBLOCK USED ;** FIX **
02430 SKIPE RUNNAM ;TEST FOR SPECIFIED RUN BLOCK ;** FIX **
02440 MOVEI T4,RUNBLK ; YES, POINT AT IT ;** FIX **
02450 JRST GVNM1 ;TYPE THE RUN BLOCK ;** FIX **
02500
02600 ;ROUTINE TO PRINT FILE NAME INFO POINTED TO BY T4
02700
02800 GVNAM0: SKIPE T2,DEV(T4) ;SEE IF A DEVICE
02900 CAMN T2,[SIXBIT "DSK"]
03000 JRST GVNAM1 ;DON'T PRINT IT IF 'DSK'
03002
03004 IFN %SS006, <
03006
03008 ; HERE TO SEE OF SPECIFIED FILE STRUCTURE IS AN EQUIVALENT FOR 'DSK',
03010 ; I.E., (A) THE ONLY F/S IN THE USER'S ACTIVE S/L, (B) WITH NORMAL
03012 ; F/S STATUS BITS (/CREATE,/WRITE), AND (C) IN THE SYSTEM SEARCH
03014 ; LIST. IF IT IS, THEN WE DON'T TYPE THE STRUCTURE NAME.
03016
03018 SETOM PTHADR ;SET JOB -1 FOR [SELF]
03020 SETOM PTHADR+1 ;SET PPN -1 FOR [SELF]
03022 SETOM PTHADR+2 ;SET STR -1 TO START THE S/L
03024 MOVE T1,[5,,PTHADR] ;GET GOBSTR PARMS
03026 GOBSTR T1, ;FIND 1ST STR IN S/L
03028 JRST GVNM0A ; FAILED, TYPE THE F/S NAME
03030 MOVE T3,PTHADR+4 ;GET THE F/S STATUS BITS
03032 CAMN T2,PTHADR+2 ;TEST FOR F/S 1ST IN S/L
03034 TLNE T3,(3B1) ;TEST FOR NORMAL STATUS
03036 JRST GVNM0A ; NOT 1ST OR NOR NORMAL, GO TYPE
03038 GOBSTR T1, ;FIND NEXT F/S IN S/L
03040 JRST GVNM0A ; FAILED, TYPE THE F/S NAME
03042 SKIPE T3,PTHADR+2 ;GET THE NEXT F/S NAME & TEST IT
03044 AOJN T3,GVNM0A ; IF NON-NULL, GO TYPE IF NOT -1
03046 SETZM PTHADR ;SET JOB 0 FOR SYSTEM S/L
03048 MOVEM T2,PTHADR+2 ;STORE F/S NAME
03050 GOBSTR T1, ;FIND OUT IF F/S IN SYSTEM S/L
03052 JRST GVNM0A ; NO, TYPE IT
03054 JRST GVNAM1 ; YES, THEN DON'T TYPE ANYTING
03056 GVNM0A: ;HERE TO TYPE THE F/S NAME
03058 >; END OF IFN %SS006
03100 PUSHJ P,PRTSX6 ;PRINT DEVICE NAME IN T2
03200 MOVEI C,":" ;AND A COLON
03300 PUSHJ P,OCHR
03400
03500 GVNAM1: MOVE T2,NAM(T4) ;GET A NAME
03600 PUSHJ P,PRTSX6
03700 HLLZ T2,EXT(T4) ;SEE IF THERE IS AN EXTENSION
03800 JUMPE T2,GVNAM2 ;JUMP IF THERE ISN'T
03900 MOVEI C,"." ;A PERIOD
04000 PUSHJ P,OCHR
04100 PUSHJ P,PRTSX3
04200
04300 GVNAM2: ;HERE AFTER FILENAME TYPED
04304 IFN %SS006, <
04308 HRRZ T1,PRT(T4) ;GET THE PROTECTION FIELD
04312 CAIE T4,ORGBLK ;TEST FOR ORIGINAL FILE SPEC
04316 CAIN T4,NEWBLK ;TEST FOR FINAL FILE SPEC
04320 SKIPN T1 ;TEST FOR NON-ZERO PROTECTION
04324 JRST GVNAM5 ; JUMP IF WRONG FILE OR NOTHING TO TYPE
04328 CAMN T1,DEFPRT ;TEST FOR DEFAULT PROTECTION
04332 JRST GVNAM5 ; YES, DON'T PRINT (SAME AS ZERO)
04336 MOVEI C,074 ;GET A LEFT ANGLE BRACKET
04340 PUSHJ P,OCHR ; & TYPE IT
04344 MOVEI C,"0" ;GET A ZERO
04348 TRNN T1,700 ;TEST FOR LEADING ZERO
04352 PUSHJ P,OCHR ; YES, TYPE IT
04356 TRNN T1,770 ;TEST FOR TWO LEADING ZERO'S
04360 PUSHJ P,OCHR ; YES, TYPE AGAIN
04364 MOVEI T3,OCHR ;GET ADDR OF OUTPUT ROUTINE
04368 PUSHJ P,OCTPR ;TYPE THE PROTECTION
04372 MOVEI C,076 ;GET A RIGHT ANGLE BRACKET
04376 PUSHJ P,OCHR ; & TYPE IT
04380 GVNAM5: ;HERE AFTER PROTECTION TYPED
04384 >; END OF IFN %SS005
04388 SKIPN PTH(T4) ;LOOK FOR PATH INFO
04400 JRST FORCE ;NONE - DUMP BUFFER & RETURN
04405 IFN %SS006, <
04410 MOVEI T3,(T4) ;SAVE FILESPEC PTR IN ANOTHER AC
04415 MOVE T1,[-<SFDLVL+1>,,DEFPTH+2-PTH] ;GET AOBJN PTR FOR
04420 ; DEFAULT PATH
04425 PUSHJ P,CKPTH1 ;TEST FOR COMPLETE DEFAULT PATH
04430 SKIPA T4,T3 ; NO, RESTORE FILESPEC PTR & SKIP
04435 JRST FORCE ; YES, DONE, SO DUMP BUFFER & RETURN
04440 MOVE T1,DEV(T4) ;GET THE DEVICE
04445 PUSHJ P,DOPATH ;GET PATH FOR THAT DEVICE
04450 MOVE T1,PTHADR+1 ;GET SCAN SWITCHES
04455 TRNE T1,1B30 ;TEST FOR NON-OVERRIDEABLE PPN
04460 JRST FORCE ; YES, THEN DONt PRINT PPN
04465 >; END OF IFN %SS006
04500 MOVEI C,"[" ;OPEN BRACKET
04600 PUSHJ P,OCHR
04700 MOVEI T3,OCHR ;SETUP FOR OCTPR
04800 HLRZ T1,PTH(T4) ;GET PROJ #
04900 PUSHJ P,OCTPR
05000 MOVEI C,"," ;A COMMA SEPARATOR
05100 PUSHJ P,OCHR
05200 HRRZ T1,PTH(T4) ;GET PROG #
05300 PUSHJ P,OCTPR ;PRINT IT
05400 HRLI T4,-<SFDLVL+1> ;SET UP FOR FULL PATH
05500 JRST GVNAM4
05600
05700 GVNAM3: MOVEI C,","
05800 PUSHJ P,OCHR ;DUMP A COMMA
05900 PUSHJ P,PRTSX6 ;PRINT ATOM IN T2
06000 GVNAM4: SKIPE T2,PTH+1(T4) ;IS THERE MORE?
06100 AOBJN T4,GVNAM3 ;YES - SEE IF COUNT EXPIRED
06200 MOVEI C,"]" ;CLOSING BRACKET
06300 PUSHJ P,OCHR
06400 JRST FORCE ;DUMP BUFFER & EXIT
06500
06600 PRTSX3: MOVEI T3,3 ;3 CHARS
06700 TRZA T2,-1 ;CLEAR RH
06800 PRTSX6: MOVEI T3,6 ;6 CHARS
06900 MOVEI T5,GVOSX ;OUTPUT ROUTINE
07000 JRST PRTSX
07100
07200 GVOSX: MOVE C,T1 ;COPY CHAR INTO C
07300 JRST OCH2 ;AND OUTPUT IT ;** FIX **
07400 ;CHANGED TO CIRCUMVENT /LOWER ;** FIX **
07500 ;CASE TRANSLATION ;** FIX **
00100
00200 COMMENT ! THIS HERE IS THE UNIQUE INITIAL SEGMENT DECODER
00300 STOLEN FROM THE PDP10 T-S MONITOR (SEE COMCON).
00400 IT TAKES THE ARGUMENT IN LOC 'ACCUM' AND RETURNS THE
00500 FULL SIXBIT VALUE IN SAME. !
00600
00700 DECODE:
00800 MOVE T1,ACCUM ;FETCH ARG
00900 MOVNI T2,1 ;SET MASK ALL ONES
01000 LSH T2,-6 ;CLEAR OUT ONE MORE CHAR
01100 LSH T1,6 ;SHIFT 1 COMMAND CHAR OFF
01200 JUMPN T1,.-2 ;LUP UNTIL ALL GONE
01300 EXCH T2,ACCUM ;FETCH ARG IN T2 & SAVE MASK
01400 MOVNI T3,1 ;CLEAR FOUND COUNT
01500 LUP: MOVE T4,@S1 ;FETCH TABLE ENTRY
01600 TDZ T4,ACCUM ;MASK OUT CHARS NOT TYPED
01700 CAMN T2,@S1 ;EXACT MATCH?
01800 JRST FOUND ;YES: THIS IS IT
01900 CAME T2,T4 ;CLOSE MATCH?
02000 JRST LNEXT ;NO: KEEP TRYING
02100 AOJG T3,LNEXT ;FIRST TIME?
02200 HRRZ T5,S2 ;YES: REMBER INDEX
02300
02400 LNEXT: AOBJN S2,LUP ;NO: KEEP LOOKING
02500 SKIPN T3 ;FIND ONLY ONE?
02600 MOVE S2,T5 ;YES: OK TO USE SAVED VALUE
02700 FOUND: POPJ P, ;RETURN
02800
02900 XCODE: PUSH P,S1 ;SAVE SPECIAL ACS
03000 PUSH P,S2
03100 MOVE S1,[S2,,NAMTAB]
03200 MOVSI S2,-NAMLEN
03300 PUSHJ P,DECODE
03310 IFN %SS012, <
03320 MOVE T1,NAMTAB(S2) ;GET COMPLETE SWITCH NAME
03330 MOVEM T1,ACCUM ; & PUT BACK FOR TYPING
03340 >; END OF IFN %SS005
03400 MOVE T1,NAMDSP(S2) ;GET DISPATCH ENTRY
03500 POP P,S2 ;RESTORE SPECIAL ACS
03600 POP P,S1
03700 POPJ P,
00100 ;THIS IS THE FULL NAME TABLE
00200
00300 DEFINE NAMES <
00400 X (R,SETRED,0,0)
00500 X (RONLY,SETRED,0,0)
00600 X (READONLY,SETRED,0,0)
00700 X (UPPER,SETUPP,0,0)
00800 X (LOWER,SETLOW,0,0)
00900 X (M37,SETM37,0,0)
01000 X (M33,SETM33,0,0)
01100 X (DPY,SETDPY,0,0)
01200 X (NOVICE,SETNOV,0,0)
01300 X (EXPERT,SETEXP,0,0)
01390 IFE %SS025, <
01400 X (C128,QON,0,0)
01410 >; END OF IFE %SS025
01420 IFN %SS025, <
01430 X (C128,QON,0,<XOPTF!XVARF>)
01440 >; END OF IFN %SS025
01500 X (C64,QOFF,0,0)
01600 X (SEPARATORS,QSON,0,0)
01700 X (NONSEPARATORS,QSOFF,0,0)
01790 IFN JUSTSW!PPNTSW, <
01800 X (RMAR,SETRMR,GVRM,XNUMF)
01900 X (LMAR,SETLMR,GVLM,XNUMF)
01910 >; END OF IFN JUSTSW!PPNTSW
01990 IFN JUSTSW, <
02000 X (PMAR,SETPMR,GVPM,XNUMF)
02100 X (MAXLN,SETMLN,GVMLN,XNUMF)
02110 >; END OF IFN JUSTSW
02200 X (INCREMENT,SETINC,GVINC,XNUMF)
02300 X (ERROR,0,GIVER,0)
02400 X (CASE,0,GVCASE,0)
02500 X (STRING,0,GVSTR,0)
02600 X (BIG,0,GIVBIG,0)
02700 X (LOCATION,0,GIVLOC,0)
02800 X (NAME,SETNAM,GVNAM,XVARF)
02900 X (RUN,SETRUN,GVRUN,XVARF)
02990 IFN JUSTSW!PPNTSW, <
03000 X (LENGTH,SETLEN,GVPG,XNUMF)
03010 >; END OF IFN JUSTSW!PPNTSW
03100 X (SAVE,SETSAV,GVSAV,XNUMF)
03200 X (ISAVE,SETISV,GVISAV,XNUMF)
03300 X (CHECK,SETCHK,GIVCHK,0)
03400 X (NOCHECK,CLRCHK,0,0)
03410 IFN %SS036, <
03420 X (CREATE,SETCRE,0,0)
03430 X (EDIT,CLRCRE,0,0)
03440 >; END OF IFN %SS036
03500 X (NUMBER,SETNUM,0,0)
03600 X (NONUMBER,CLRNUM,0,0)
03700 X (DISK,0,GIVDSK,0)
03800 X (DSK,0,GIVDSK,0)
03900 X (DECIDE,SETDCD,GIVDCD,0)
04000 X (NODECIDE,CLRDCD,0,0)
04010 IFN %SS040, <
04020 X (EXACT,SETEXT,GIVEXT,0)
04030 X (NOEXACT,CLREXT,0,0)
04040 >; END OF IFN %SS040
04100 X (DELETE,SETZAP,GIVZAP,0)
04200 X (NODELETE,CLRZAP,0,0)
04300 X (BAK,SETBAK,GIVBAK,0)
04400 X (NOBAK,CLRBAK,0,0)
04410 IFN %SS006, <
04420 X (N,CLRBAK,0,0)
04430 >; END OF IFN %SS006
04500 X (OLD,SETOLD,0,0)
04600 X (OPTION,SETOPT,0,XVARF)
04700 X (BASIC,SETBAS,0,0)
04710 IFN %SS047, <
04720 X (NOBASIC,CLRBAS,0,0)
04730 >; END OF IFN %SS047
04800 X (UNSEQUENCE,SETSEQ,0,0)
04900 X (SEQUENCE,CLRSEQ,GIVSEQ,0)
04910 IFN %SS046, <
04920 X (TEXT,SETTXT,0,0)
04930 >; END OF IFN %SS046
05000 X (START,SETFST,GIVFST,XNUMF)
05100 X (STEP,SETSTP,GIVSTP,XNUMF)
05200 X (PLINES,SETPLN,GVPLN,XNUMF)
05205 IFN %SS050, <
05210 X (CORE,SETCOR,0,XNUMF)
05215 >; END OF IFN %SS050
05220 IFN %SS052, <
05225 X (BLOCK,SETBLK,GIVBLK,0)
05230 X (COMPRESS,CLRBLK,0,0)
05235 >; END OF IFN %SS052
05240 IFN %SS073, <
05245 X (COLUMN,0,GIVCOL,0)
05250 >; END OF IFN %SS073
05300 >
00100 DEFINE X(A,B,C,D) <
00200 EXP <SIXBIT /A/>>
00300
00400 NAMTAB:
00500 NAMES
00600
00700 NAMLEN==.-NAMTAB
00800
00900 DEFINE X(A,B,C,D) <
01000 D+C,,B
01100 >
01200
01300 XNUMF==3B20 ;SET NEEDS NUMERIC ARG
01400 XVARF==1B19 ;SET NEEDS ARG
01410 IFN %SS025, <
01420 XOPTF==1B21 ;SET MIGHT NEED ARGUMENT (TEST C)
01430 >; END OF IFN %SS025
01500
01600 NAMDSP:
01700 NAMES
01800
01900 XERR,,XERR
02000
02100 XERR: NERROR ILC
02200
02300 SUBTTL LIST COMMAND
00100
00200 IFN LSTSW,<
00300 LIST: ;THE LIST COMMAND
00350 ;;*FIX* TRZ FL2,SUPN ;ASSUME WE ARE GOING TO LIST LINE NUMBERS
00400 SETZM LOLN ;FOR START OF PAGE
00500 PUSHJ P,SCAN ;GET SOME INFORMATION
00590 IFE %SS042, <
00600 CAIE C,"," ;IS THERE A SWITCH?
00700 JRST LIST9 ;NO
00800 PUSHJ P,SCAN ;YES, SCAN FOR IT
00900 MOVS T1,ACCUM
01000 CAIE T1,(<SIXBIT /S />) ;IS IT S?
01100 NERROR ILC ;NO, LOSE
01200 TRO FL2,SUPN ;YES, SUPPRESS LINE NUMBERS
01300 PUSHJ P,SCAN ;AND SCAN PAST IT
01310 >; END OF IFE %SS042
01320 IFN %SS042, <
01330 PUSHJ P,CHKCMS ;CHECK FOR ",S"
01340 >; END OF IFN %SS042
01400 LIST9: TRNN FL,TERMF ;JUST A TERMINATOR
01500 JRST LIST7 ;NO, GO LOOK FOR A COMMAND STRING
01600 MOVEI T1,1 ;LIST ENTIRE FILE
01700 MOVEM T1,LOPG
01800 MOVSI T1,1 ;FROM 1 TO IMPOSSIBLY HIGH
01900 MOVEM T1,HIPG
02000 TRZ FL,CNTF ;MAKE SURE THAT THIS FLAG IS OFF
02100 JRST LIST8 ;GO START WORK
02200 LIST7: PUSHJ P,GET2 ;HAVE ALREADY SCANNED, GET 2 NUMBERS
02290 IFE %SS042, <
02300 CAIE C,"," ;IS THERE A SWITCH?
02400 JRST LIST10 ;NO
02500 PUSHJ P,SCAN ;YES, SCAN FOR IT
02600 MOVS T1,ACCUM
02700 CAIE T1,(<SIXBIT /S />) ;IS IT S?
02800 NERROR ILC ;NO, LOSE
02900 TRO FL2,SUPN ;YES, SUPPRESS LINE NUMBERS
03000 PUSHJ P,SCAN ;AND SCAN PAST IT
03010 >; END OF IFE %SS042
03020 IFN %SS042, <
03030 PUSHJ P,CHKCMS ;CHECK FOR ",S"
03040 >; END OF IFN %SS042
03100 LIST10: TRNN FL,TERMF ;END OK?
03200 NERROR ILC
03300 LIST8: TRZ FL,LINSN ;NONE SEEN YET
03400 MOVEI T1,LPTBUF ;GET SET TO INIT THE LPT
03500 EXCH T1,.JBFF##
03600 PUSH P,T1 ;SAVE OLD
03700 MOVSI T1,'LPT' ;DEFAULT DEVICE NAME
03800 MOVEM T1,LPDEVI+1
03900 OPEN LPT,LPDEVI ;GET IT
04000 SKIPA ;FAILED - TRY DSK
04100 JRST LIST8A ;LPT OK - USE IT
04200 MOVE T1,OUDEVI+1 ;GET DSK NAME
04300 MOVEM T1,LPDEVI+1
04400 OPEN LPT,LPDEVI
04500 NERROR UNA
04600 LIST8A: OUTBUF LPT,1 ;ASK FOR ONE BUFFER
04700 MOVEI T2,LPTBUF ;FIND OUT HOW BIG IT IS
04800 EXCH T2,.JBFF##
04900 SUBI T2,LPTBUF ;THE SIZE
05000 MOVEI T1,203 ;THE SPACE RESERVED FOR IT
05100 IDIV T1,T2 ;GET NUMBER THAT WILL FIT THERE
05200 OUTBUF LPT,(T1) ;AND ASK FOR THAT MANY
05300 POP P,.JBFF## ;RESTORE JOBFF
05400 MOVE T1,[OCRBLK,,TMPBLK]
05500 BLT T1,TMPBKE ;SETUP OUTPUT SPECS
05600 SKIPN T1,NEWNAM ;SEE IF NEW NAME
05700 MOVE T1,ORGNAM ;ELSE USE ORIGINAL
05800 MOVEM T1,TMPNAM
05900 MOVSI T1,'LPT' ;USE THIS EXTENSION
06000 HRR T1,ORGPRT ;AND THIS PROTECTION
06100 MOVEM T1,TMPEXT
06200 XENTR LPT,TMPBLK ;GO CREATE FILE
06300 NERROR UNA ;NOPE!
06400 MOVE T1,[XWD PGHS,PGHD] ;GET A COPY OF THE BLANK HEADER
06500 BLT T1,PGHD+7
06600 MOVE C,[POINT 7,PGHD,27] ;START TO FILL IT
06700 MOVEI T3,6 ;6 CHRS IN FILE NAME
06800 MOVEI T5,HDOSX ;OUTPUT ROUTINE
06900 MOVE T2,ORGNAM ;USE THE ORIGINAL NAME
07000 PUSHJ P,PRTSX ;PUT IT IN THE HEADER
07100 SKIPN T2,ORGEXT ;GET THE EXTENSION
07200 JRST LIST1 ;NONE THERE, IGNORE
07300 MOVEI T1,"." ;A DOT BETWEEN
07400 IDPB T1,C
07500 MOVEI T3,3 ;ONLY 3 CHRS HERE
07600 TRZ T2,-1 ;CLEAR RH
07700 PUSHJ P,PRTSX
07800 LIST1: MOVE ALTP,[POINT 7,PGHD+3] ;TIME+DATE (ALTP IS FREE)
07900 DATE T1, ;GET DATE
08000 IDIVI T1,^D31 ;LEAVES DAY IN T2
08100 PUSH P,T1 ;SAVE PARTIAL
08200 MOVEI T1,1(T2) ;GET DAY (MUST ADD 1)
08300 MOVEI T3,HDOCH ;PLACE FOR DECPR TO PUT THINGS
08400 PUSHJ P,DECPR
00100 MOVEI C,"-" ;SEPARATE
00200 IDPB C,ALTP
00300 POP P,T1 ;GET MONTH-YEAR BACK
00400 IDIVI T1,^D12 ;MONTH-1 IN T2
00500 SKIPA T4,[POINT 7,MONTAB(T2)]
00600 IDPB C,ALTP
00700 ILDB C,T4
00800 JUMPN C,.-2 ;LOOP UNTIL NULL
00900 MOVEI C,"-" ;SEPARATE
01000 IDPB C,ALTP
01100 ADDI T1,^D64 ;CONVERT TO REAL YEAR
01200 PUSHJ P,DECPR
01300 IBP ALTP ;SKIP OVER A SPACE
01400 MSTIME T1, ;GET THE TIME
01500 IDIVI T1,^D60000 ;CONVERT TO MINUTES
01600 IDIVI T1,^D60 ;NOW TO HOURS
01700 PUSH P,T2 ;SAVE MINUTES
01800 PUSHJ P,DECPR ;PRINT
01900 MOVEI T1,":"
02000 IDPB T1,ALTP
02100 POP P,T1 ;GET MINUTES BACK
02200 MOVEI T2,"0" ;MAKE SURE THERE ARE 2 DIGITS
02300 CAIG T1,^D9
02400 IDPB T2,ALTP
02500 PUSHJ P,DECPR
02600 SETOM LOGPG ;LOGICAL PAGE TO 0
02700 MOVE T1,LOPG ;GET SET TO PRINT
02800 MOVEM T1,DPG
02900 MOVE SINDEX,LOLN
03000 PUSHJ P,FIND ;GO FIND IT
03100 SETZM LSTCNT ;COUNT OF NUMBER OF LINES PER PAGE
03200 LST2: PUSHJ P,ONMOV ;CHECK RANGE
03300 JRST LST6 ;FINISH UP
03400 TRO FL,LINSN ;YEP, WE HAVE SEEN ONE
03500 CAMN T1,PGMK ;CHECK FOR PAGE MARK AND HANDLE SPECIAL
03600 JRST LST4
03700 MOVEM T1,CLN ;THE CURRENT LINE
03800 MOVEI T2,0 ;COUNT OF NUMBER OF CHRS SEEN
03900 SOSLE LSTCNT ;CHECK TO SEE IF RUN OUT
04000 JRST LST2A ;NO - PROCEED
04100 MOVEI C,14 ;OUTPUT A FORM-FEED
04200 PUSHJ P,POCHR
04300 PUSHJ P,HDPRNT ;GO PRINT HEADING
04400 LST2A: MOVE T1,PNTR ;GET THE POINTER
04500 TRNN FL2,SUPN ;DO WE WANT TO SUPPRESS LINE NUMBERS?
04600 JRST LST3A ;NO
04700 AOS T1 ;YES, SKIP A WORD
04800 HRLI T1,(<POINT 7,0,6>) ;AND A CHARACTER
04900 ADDI T2,6 ;AND TELL PEOPLE WE HAVE DONE SO
05000 JRST LST3 ;BEFORE GOING ON OUR WAY
05100 LST3A: HRLI T1,(<POINT 7,0>) ;AND SET UP BYTE POINTER
05200 LST3: ILDB C,T1 ;GET CHR
05300 CAIGE C,11 ;CHECK ALL SPECIAL CASES
05400 JRST LST3B
05500 CAIGE C,15
05600 JRST SPHD
05700 CAIN C,15
05800 JRST LST5
05890 IFE %SS025, <
05900 CAIE C,"'"
05910 >; END OF IFE %SS025
05920 IFN %SS025, <
05930 CAME C,CHR128 ;TEST FOR _C128 ESCAPE CHAR
05940 >; END OF IFN %SS025
06000 CAIGE C,40
06100 JRST LST3B
06200 CAIGE C,140
06300 JRST LST5
06400 LST3B: TLNE FL,QMODF ;CHECK QUOTE MODE
06500 JRST LST5
06600 PUSH P,C
06690 IFE %SS025, <
06700 MOVEI C,"'"
06710 >; END OF IFE %SS025
06720 IFN %SS025, <
06730 MOVE C,CHR128 ;GET _C128 ESCAPE CHAR
06740 >; END OF IFN %SS025
06800 PUSHJ P,POCHR
06900 ADDI T2,1
07000 POP P,C
07010 IFN %SS025, <
07020 CAME C,CHR128 ;TEST FOR _C128 ESCAPE CHAR
07030 ; YES, THEN ALWAYS TRANSLATES TO [SELF]
07040 >; END OF IFN %SS025
07100 LDB C,[POINT 7,CTBL(C),10]
07200 LST5: PUSHJ P,POCHR ;PRINT IT
07300 AOJA T2,LST3 ;COUNT AND CONTINUE
07400
07500 IFN %SS042, <
07600 CHKCMS: MOVEI SINDEX,[ ;POINT AT PARM LIST
07700 SIXBIT /S/
07800 TRO FL2,SUPN
07900 EXP 0
08000 ]
08100 JRST SCNMOD ;GO SCAN FOR THE ",S" MODIFIER
08200 >; END OF IFN %SS042
00100 SPHD: CAIN C,12 ;LINE FEED IS END OF LINE
00200 JRST [PUSHJ P,POCHR ;PRINT IT
00300 PUSHJ P,FINDN ;GET NEXT
00400 JRST LST2] ;AND GO
00500 CAIN C,11 ;COUNT SPECIAL FOR TAB
00600 JRST [ADDI T2,10
00700 ANDCMI T2,7
00800 PUSHJ P,POCHR
00900 JRST LST3]
01000 CAIN C,14
01100 JRST [PUSHJ P,POCHR ;FORM FEED GETS A HEADING
01200 PUSHJ P,HDPRNT
01300 JRST LST3]
01400 CAIN C,"\" ;NEEDS DELETE,DELETE
01500 JRST [MOVEI C,177
01600 PUSHJ P,POCHR
01700 JRST LST5] ;AND AGAIN
01800 CAIE C,13 ;VERT.TAB
01900 ERROR ICN ;CONFUSED
02000 PUSHJ P,POCHR
02100 MOVE T3,LSTCNT
02200 CAIG T3,<%LPP+2>/3
02300 JRST [PUSHJ P,HDPRNT
02400 JRST LST3]
02500 CAIG T3,<2*<%LPP+2>>/3
02600 MOVEI T3,<%LPP+2>/3
02700 CAIL T3,<2*<%LPP+2>>/3
02800 MOVEI T3,<2*<%LPP+2>>/3
02900 MOVEM T3,LSTCNT
03000 JRST LST3
03100
03200 LST4: MOVEI C,14 ;PRINT A FORM FEED
03300 ;;*FIX* SOSLE LSTCNT ;BUT ONLY IF WE ARE NOT ALREADY THERE ;** FIX **
03400 PUSHJ P,POCHR
03500 AOS T1,CPG ;GET PAGE CORRECTLY
03600 MOVEM T1,CPGL
03700 SETOM LOGPG ;ZERO LOGICAL PAGE AGAIN
03800 MOVEI T2,0 ;THIS MUST BE ZERO SO GET IT THAT WAY
03900 PUSHJ P,HDPRNT ;PRINT A HEADER
04000 AOS LSTCNT ;INCREASE BY 1 TO MAKE IT COME OUT RIGHT
04100 PUSHJ P,FINDN ;ADVANCE
04200 JRST LST2 ;AND CONTINUE
04300
04400 LST6: RELEAS LPT,0 ;GET RID OF IT
04500 TRZ FL2,SUPN ;TURN THIS OFF SO * PRINTS
04600 TRNN FL,LINSN ;WERE ANY SEEN?
04700 NERROR NLN ;NO, ERROR
04800 MOVE T1,CPG ;SET UP PAGE
04900 MOVEM T1,CPGL
05000 JRST COMND ;AND GET MORE COMMANDS
00100 POCHR: SOSG LOBUF+2 ;ROOM FOR MORE?
00200 OUTPUT LPT,0
00300 IDPB C,LOBUF+1
00400 POPJ P,
00500
00600 HDPRNT: PUSH P,T1 ;SAVE POINTER
00700 TRNE FL2,SUPN ;IF PRETTY PRINTING
00800 JRST HDPR3 ;WE DON'T REALLY WANT TO DO THIS
00900 MOVEI C,15 ;GET TO LEFT OF PAGE
01000 PUSHJ P,POCHR
01100 MOVE T1,[POINT 7,PGHD] ;GET SET TO PRINT HEADER
01200 HDPR1: ILDB C,T1 ;GET A CHARACTER
01300 JUMPE C,HDPR2 ;DONE?
01400 PUSHJ P,POCHR ;PRINT IT
01500 JRST HDPR1 ;CONTINUE
01600 HDPR2: PUSH P,T2 ;SAVE CHARACTER COUNT
01700 MOVE T1,CPG ;GET CURRENT PAGE
01800 MOVEI T3,POCHR ;WHERE TO PRINT IT
01900 PUSHJ P,DECPR ;PRINT
02000 AOSG T1,LOGPG ;SEE IF OK TO PRINT
02100 JRST HDPR3
02200 MOVEI C,"-"
02300 PUSHJ P,POCHR
02400 PUSHJ P,DECPR
02500 HDPR3: MOVEI C,15 ;NOW RET AND 2 LFDS
02600 PUSHJ P,POCHR
02700 MOVEI C,12
02800 PUSHJ P,POCHR
02900 PUSHJ P,POCHR
03000 MOVEI T1,%LPP ;RESET LINE COUNT
03100 MOVEM T1,LSTCNT
03200 TRNN FL2,SUPN ;IF IN SUPPRESS MODE WE DID NOT SAVE
03300 POP P,T2 ;GET BACK COUNT OF CHRS
03400 JUMPE T2,T1POPJ ;IF 0 THEN ALL OK
03500 MOVE T3,T2 ;GET COPY
03600 MOVEI C," " ;PRINT CORRECT NUMBER OF SPACES
03700 PUSHJ P,POCHR
03800 SOJG T3,.-1
03900 T1POPJ: POP P,T1 ;RESTORE POINTER
04000 POPJ P,
04100
00100 ;ROUTINE TO PRINT IN SIXBIT THE ATOM FOUND IN T2
00200 ; T5 CONTAINS THE OUTPUT ROUTINE ADDRS
00300 ; T3 CONTAINS THE MAX NUMBER TO OUTPUT
00400
00500 PRTSX: MOVEI T1,0 ;SET TO RECIEVE A CHR
00600 LSHC T1,6 ;GQT ONE
00700 ADDI T1,40 ;CONVERT
00800 PUSHJ P,(T5) ;DUMP A CHAR
00900 SKIPE T2 ;ONLY SPACES LEFT?
01000 SOJG T3,PRTSX ;OR COUNT RUN OUT?
01100 POPJ P, ;RETURN
01200
01300 HDOCH: IDPB C,ALTP ;PUT CHRS FROM DECPR INTO HEADER
01400 POPJ P,
01500
01600 HDOSX: IDPB T1,C
01700 POPJ P,
01800
01900 MONTAB: ASCII "Jan"
02000 ASCII "Feb"
02100 ASCII "Mar"
02200 ASCII "Apr"
02300 ASCII "May"
02400 ASCII "Jun"
02500 ASCII "Jul"
02600 ASCII "Aug"
02700 ASCII "Sep"
02800 ASCII "Oct"
02900 ASCII "Nov"
03000 ASCII "Dec"
03100
03200 >
03300 IFE LSTSW,<
03400 LIST: NERROR ILC
03500 >
03600
03700 SUBTTL REPLACE COMMAND
00100 ;RE-TYPE (REPLACE) COMMAND
00200
00290 IFE %SS053, <
00300 REPLAC: SETZM LOLN ;I REALLY SHOULD PUT THIS ELSEWHERE
00310 >; END OF IFE %SS053
00320 IFN %SS053, <
00330 REPLAC: MOVE T1,[<ASCII /00000/>!1] ;GET A ZERO LINE #
00340 MOVEM T1,LOLN ;INITIALIZE 1ST LINE #
00350 >; END OF IFN %SS053
00400 SETZM PGDELS ;INIT PAGE DELETED COUNTER
00490 IFE %SS074, <
00500 TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
00600 NERROR ILC
00610 >; END OF IFE %SS074
00700 PUSHJ P,GET2S ;WHAT DO WE WANT TO REPLACE?
00800 TRZ FL,LINSN ;CLR FOR NOW
00900 PUSHJ P,INSINC ;GO GET INCR
01000 PUSHJ P,DELSUB ;DELETE SOME STUFF
01010 IFN %SS020, <
01020 PUSHJ P,DELRPT ; & REPORT WHAT WE DID
01030 >; END OF IFN %SS020
01090 IFE %SS053, <
01100 SKIPN T1,LOLN ;WHERE TO START INSERTING
01190 IFE %SS027, <
01200 MOVE T1,[<ASCII /00100/>!1]
01210 >; END OF IFE %SS027
01220 IFN %SS027, <
01230 MOVE T1,TECFST ;GET DEFAULT STARTING ADDRESS
01240 >; END OF IFN %SS027
01300 MOVEM T1,HILN ;SET UP FOR INSERT CODE
01400 MOVE T2,LOPG
01500 MOVEM T2,HIPG ;...
01600 SKIPE PGDELS ;OK IF NONE DELETED
01700 SKIPN T1,(PNTR) ;OR AT EOF
01800 JRST REPLC1
01900 CAME T1,PGMK ;ALSO END OF PAGE
02000 CAMLE T1,FDELLN ;OR REALLY IN ORDER
02100 JRST REPLC1
02105 >; END OF IFE %SS053
02110 IFN %SS053, <
02115 PUSHJ P,ORDCHK ;CHECK FOR ORDER ERROR
02120 AOSA LOPG ; YES, INCR LOW PAGE # & SKIP
02125 JRST REPLC1 ; NO, JUMP
02130 PUSHJ P,FINDN ;FIND THE NEXT LINE AGAIN
02135 MOVE T1,TECFST ;GET LINE 'START' FOR THE NEW PAGE
02140 MOVEM T1,LOLN ; & SET TO START THERE
02145 >; END OF IFN %SS053
02150 IFE %SS056, <
02200 AOS CPG ;INSERT PAGE MARK TO PREVENT INSANITY
02300 AOS INPG ;ADJUST PAGE COUNTERS
02400 AOS BGPG
02500 MOVE T1,PGMK ;SET UP PAGE MARK TO INSERT
02600 MOVEM T1,LIBUF
02700 MOVE T1,PGMKW2
02800 MOVEM T1,LIBUF+1
02900 SETZM OCNT ;STUFF FOR INSED
03000 MOVEI T1,2
03100 MOVEM T1,NCNT
03200 PUSHJ P,INSED ;PUT IT IN
03300 PUSHJ P,FINDN ;CREEP PAST IT
03400 PUSHJ P,FILLB ;IN CASE OVERFLOW
03410 >; END OF IFE %SS056
03420 IFN %SS056, <
03430 PUSHJ P,MARKIT ;INSERT A PAGE-MARK
03440 >; END OF IFN %SS056
03500 OUTSTR [ASCIZ /%Page mark inserted to prevent order error
03600 /]
03700 REPLC1: ;HERE AFTER DELETION-TYPE ORDER ERRORS RESOLVED
03705 IFN %SS053, <
03710 MOVE T2,LOPG ;GET THE 1ST PAGE #
03715 MOVEM T2,HIPG ; & STORE FOR INSERTION
03720 MOVEM T2,CPG ;STORE AS CURRENT PAGE
03725 MOVEM T2,DPG ;STORE AS DESIRED PAGE
03730 MOVE SINDEX,LOLN ;GET DESIRED LINE #
03735 PUSHJ P,FIND ;FIND IT
03740 PUSHJ P,FINDB ;NOW FIND THE PREVIOUS LINE
03745 MOVE T2,LOLN ;GET STARTING LINE #
03750 JUMPE T1,REPLC2 ;JUMP IF BEGINNING OF FILE FOUND
03755 CAMN T1,PGMK ;TEST FOR PREVIOUS P/M FOUND
03760 JRST REPLC2 ; YES, ALSO JUMP
03765 CAMLE T1,T2 ;TEST FOR PREVIOUS LINE .LE. STARTING #
03770 MOVE T2,T1 ; YES, USE PREVIOUS AS STARTING #
03775 REPLC2: MOVEM T2,HILN ;STORE AS INSERTION LINE #
03780 MOVEM T2,CLN ;STORE AS CURRENT LINE #
03785 >; END OF IFN %SS053
03790 PUSHJ P,DOINS ;LET HIM TYPE FOR A WHILE
03800 JRST COMND ;RETURN
03810
03820 PAGE
03900
04000 ;SUBROUTINE TO DELETE THE LINE POINTED TO BY PNTR
04100
04200 DODEL: SETZM NCNT ;NEW IS 0
04300 MOVEM T1,LDELLN
04400 PUSHJ P,GETLTH ;OLD LENGTH
04500 MOVEM T1,OCNT
04600 AOS DELCNT ;COUNT OF LINES DELETED
04700 SKIPE FDELLN ;FIRST TIME HERE
04800 JRST INSED ;NO: GO INSERT AND RETURN
04900 MOVE T1,LDELLN ;YES: SET UP FIRST LINE ETC.
05000 MOVEM T1,FDELLN
05100 MOVE T1,CPG
05200 MOVEM T1,FDELPG
05300 JRST INSED ;AND GO INSERT
05400
05500 IFN %SS020, <
05600 DELRPT: TRNN FL,EXTOG ;TEST FOR EXPERT MODE
05700 SKIPG T1,DELCNT# ; OR IF NO DELETIONS
05800 JRST DELCLR ; JUMP IF NOTHING TO REPORT
05900 MOVEI T3,OCHR ;SET UP FOR PRINTER
06000 PUSHJ P,DECPR ;PRINT # OF LINES DELETED
06100 PUSHJ P,FORCE ;DUMP IT
06200 OUTSTR [ASCIZ / Line/] ;TYPE START OF TEXT
06300 SOSE DELCNT ;TEST FOR EXACTLY 1 LINE DELETED
06400 OUTCHR ["s"] ; NO, MAKE PLURAL
06500 OUTSTR [ASCIZ / (/]
06600 MOVE T1,FDELLN# ;GET FIRST LINE DELETED
06700 MOVEM T1,LINOUT ;PRINT IT
06800 OUTSTR LINOUT
06900 MOVE T1,FDELPG#
07000 PUSHJ P,DECPR ;AND PAGE #
07100 PUSHJ P,FORCE
07200 MOVE T1,LDELLN# ;LAST LINE DELETED
07300 SKIPN PGDELS ;IF ANY PAGE MARKS DELETED
07400 CAME T1,FDELLN ;SAME AS FIRST?
07500 JRST [OUTCHR [":"] ;NO: PRINT IT ALSO
07600 SETZI T2,
07700 OUTSTR T1
07800 SKIPN T1,PGDELS
07900 JRST .+1
08000 ADD T1,FDELPG
08010 CAMLE T1,HIPG ;TEST FOR PAGE # TOO BIG;** FIX **
08020 SUBI T1,1 ; YES, DECR PAGE # ;** FIX **
08100 OUTCHR ["/"]
08200 PUSHJ P,DECPR
08300 PUSHJ P,FORCE
08400 JRST .+1]
08500 OUTSTR [ASCIZ /) deleted
08600 /]
08700 DELCLR: SETZM DELCNT
08800 SETZM LDELLN
08900 SETZM FDELLN
09000 SETZM FDELPG ;INIT DELETE CNTS
09100 POPJ P, ;RETURN TO CALLER
09200 >; END OF IFN %SS020
09300
09400 SUBTTL COMMON SEARCH ROUTINES FOR F AND S
00100 COMMENT ! SOME COMMON ROUTINES FOR SEARCHING FILES!
00200
00300 COMMENT ! THIS ROUTINE GENERATES CODE FOR FINDING A MATCH
00400 FOR THE FIRST CHARACTER OF A SEARCH STRING. THE POINTER
00500 TO A SET OF BYTE POINTERS FOR SEARCH STRINGS IS IN T1 !
00600
00700
00800
00900 CODSR: MOVEI T2,CODEBF ;SET UP POINTER TO PLACETO PUT CODE
01000 MOVEI ALTP,0 ;THE NUMBER OF THE CURRENT STRING
01100 HRLI T1,-SRNUM ;THE NUMBER OF STRINGS
01200 CODS5: TLZ FL,NEGF!DEMCHR ;TURN OFF THE SEEN FLAG
01300 MOVE T3,(T1) ;GET A POINTER
01400 JUMPE T3,ENDCOD ;A ZERO BYTE POINTER IS END OF CODE
01500 READCD: ILDB C,T3 ;PICK UP A CHARACTER IN STRING
01590 IFE %SS044, <
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,.PTINF ;ARBTIRARY NUMBER OF SOMETHING
02100 JRST ARBCD
02200 CAIN C,.PTANY ;ANY CHARACTER
02300 JRST ANYCD
02400 CAIN C,.PTNOT ;NOT THIS ONE
02500 JRST [TLC FL,NEGF
02600 TLO FL,DEMCHR ;WE REALLY JEED IT
02700 JRST READCD]
02800 CAIN C,.PTSEP ;SEPARATOR
02900 JRST SEPCD
03000 CAIN C,.PTQOT ;QUOTE THE NEXT CHARACTER
03100 JRST QUOTE
03105 >; END OF IFE %SS044
03110 IFN %SS044, <
03115 READC1: CAIN C,.PTQOT ;TEST FOR QUOTED CHARACTER
03120 JRST QUOTE ; YES, JUMP
03125 CAIN C,.PTSEP ;TEST FOR SEPARATOR
03130 JRST SEPCD ; YES, JUMP
03135 CAIL C,LPTTAB ;TEST FOR CHAR W/IN TABLE
03140 JRST COMLET ; NO, GENERATE NORMAL CHAR COMPARE
03145 HLRZ T4,PATTAB(C) ;GET TRANSFER ADDRESS
03150 JUMPN T4,(T4) ; & GO THERE IF DEFINED
03155 >; END OF IFN %SS044
03200 COMLET: MOVE CS,CTBL(C) ;GET THE MAJIC BITS
03290 IFE %SS040, <
03300 TLNN FL,EXCTS1!EXCTSR ;IS THIS AN EXACT SEARCH?
03310 >; END OF IFE %SS040
03320 IFN %SS040, <
03330 TRNN FL2,DOEXCT ;TEST FOR /EXACT
03340 >; END OF IFN %SS040
03400 TLNN CS,LETF_16 ;OR NOT A LETTER
03500 JRST NORMCR ;YES JUST THE TEST
03600 HRLI C,(<CAIE C,>) ;DO A CAIE
03700 MOVEM C,(T2)
03800 XOR C,[XWD 4000,40] ;CAIN .XOR. CAIE = 4000,,0
03900 MOVEM C,1(T2)
04000 TLNE FL,NEGF ; THAT CHR
04100 JRST GENSKP ;GENERATE A SKIPA
04200 COMXCT: MOVE C,[XCT JSPR] ;THE CALL TO SEARCH FURTHER
04300 DPB ALTP,[POINT 4,C,12] ;AC FIELD GIVES STRING NUMBER
04400 MOVEM C,2(T2)
04500 ADDI T2,3 ;ADVANCE OUTPUT POINTER
04600 ENDSTR: ADDI ALTP,1 ;NEXT STRING
04700 AOBJN T1,CODS5 ;IF ANY
04800 ENDCOD: MOVE C,[JRST COMSRT] ;A RETURN
04900 MOVEM C,(T2)
05000 POPJ P,
00100 SEPCD: MOVE C,[SKIPG CS,CTBL(C)] ;GET BITS
00200 MOVEM C,(T2)
00300 MOVE C,[TRNE CS,NSEPF] ;CHECK FOR %,$,OR .
00400 TRNE FL2,QSEPF ;SEPARATORS?
00500 MOVSI C,(<SKIPA>) ;YES;
00510 IFN %SS044, <
00520 TSTNNS: ;HERE TO GENERATE 'NEGATIVE NON-SKIP' CODE
00530 >; END OF IFN %SS044
00600 MOVEM C,1(T2)
00700 TLNE FL,NEGF ;SKIPA IN NORMAL CASE
00800 JRST COMXCT
00900 GENSKP: MOVSI C,(<SKIPA>)
01000 MOVEM C,2(T2)
01100 AOJA T2,COMXCT ;SO XCT WILL GO IN RIGHT PLACE
01200
01300 QUOTE: ILDB C,T3 ;GET NEXT CHR
01400 JUMPE C,[NERROR ISS] ;END OF STRING IS ILLEGAL
01500 JRST COMLET ;TREAT AS NORMAL CHARACTER
01600
01610 IFN %SS044, <
01620 EOLCD: SKIPA C,[CAIE C,15] ;GET <CR> CHAR IN RH OF C & SKIP (LH IRRELEVANT)
01630 ANYCD: SKIPA C,[CAIE C,15] ;GET SPECIAL INSTR FOR <EOL> & SKIP
01640 >; END OF IFN %SS044
01700 NORMCR: HRLI C,(<CAIN C,>) ;EXACT OR NOT LETTER
01710 IFN %SS044, <
01720 GENIVT: ;HERE TO INVERT TXNE/TXNN OR CAIE/CAIN
01730 >; END OF IFN %SS044
01800 TLNE FL,NEGF
01900 TLC C,4000 ;CAIN .XOR. CAIE = 4000,,0
02000 NORMC1: MOVEM C,(T2)
02100 SOJA T2,COMXCT ;MAKE THE XCT GO IN RIGHT PL@CE
02200
02290 IFE %SS044, <
02300 ANYCD: MOVE C,[CAIE C,15] ;SPECIAL FOR EOL
02400 TLNE FL,NEGF
02500 TLC C,4000 ;CAIN .XOR. CAIE = 4000,,0
02600 JRST NORMC1
02610 >; END OF IFE %SS044
02700
02800 ARBCD: ILDB C,T3 ;GET NEXT
02900 CAIN C,.PTNOT ;JUST CHECK VALIDITY
03000 JRST ARBCD
03010 IFN %SS044, <
03020 CAIE C,.PTINF ;TEST FOR 'ANY NUMBER OF'
03030 CAIN C,.PT1MR ;TEST FOR '1 OR MORE'
03040 NERROR ISS ; YES, ILLEGAL FORMAT
03050 >; END OF IFN %SS044
03100 CAIN C,.PTQOT
03200 ILDB C,T3
03300 JUMPE C,[NERROR ISS] ;END OF STRING ERROR
03400 JRST READCD ;LOOK FOR FIRST OTHER CHR
03500
03600 JSPR: JSP T1,SRCRET ;CALL CONTINUE SEARCH
03700
03800
03900 IFN %SS044, <
04000 SPCCD: MOVE C,[CAIE C,11] ;THE 'TAB' TEST
04100 MOVEM C,(T2)
04200 MOVE C,[CAIN C,40] ;THE 'SPACE' TEST
04300 MOVEM C,1(T2)
04400 TSTNSK: TLNE FL,NEGF ;TEST FOR NEGATIVE
04500 JRST GENSKP ; YES, GENERATE A SKIP
04600 JRST COMXCT ; NO, NEXT INSTRUCTION IF SUCCESSFUL
04700
04800 DGTCD: MOVE C,[CAIL C,"0"] ;LOWER-BOUND TEST
04900 MOVEM C,(T2)
05000 MOVE C,[CAILE C,"9"] ;UPPER-BOUND TEST
05100 JRST TSTNNS ;FAIL GETS NO SKIP
05200
05300 LCLCD: MOVE C,[CAIL C,"A"+40] ;LOWER-BOUND TEST
05400 MOVEM C,(T2)
05500 MOVE C,[CAILE C,"Z"+40] ;UPPER-BOUND TEST
05600 JRST TSTNNS ;FAIL GETS NO SKIP
05700
05800 UCLCD: MOVE C,[CAIL C,"A"] ;LOWER-BOUND TEST
05900 MOVEM C,(T2)
06000 MOVE C,[CAILE C,"Z"] ;UPPER-BOUND TEST
06100 JRST TSTNNS ;FAIL GETS NO SKIP
06200
06300 LTRCD: MOVE C,[MOVE CS,CTBL(C)] ;GET CHAR STATUS BITS
06400 MOVEM C,(T2)
06500 MOVE C,[TLNE CS,LETF_16] ;TEST FOR LETTER
06600 AOJA T2,GENIVT ;INCR PC & JUMP TO CHECK - SIGN
06700
06800 ALMCD: MOVE C,[MOVE CS,CTBL(C)] ;GET CHAR STATUS BITS
06900 MOVEM C,(T2)
07000 MOVE C,[TLNE CS,<LETF!SNUMF>_16] ;TEST FOR LETTER/NUMBER
07100 AOJA T2,GENIVT ;INCR PC & JUMP TO CHECK - SIGN
07200
07300 MR1CD: ILDB C,T3 ;GET NEXT CHARACTER
07400 CAIE C,.PTINF ;TEST FOR 'ANY # OF'
07500 CAIN C,.PT1MR ;TEST FOR '1 OR MORE'
07600 SKIPA ; EITHER, SKIP
07700 JUMPN C,READC1 ; LOOK FOR IT IF NON-NULL
07800
07900 NULCD: NERROR ISS ; NULL, ILLEGAL STRING
08000
08100 NOTCD: TLC FL,NEGF ;INVERT THE '-' SIGN
08200 JRST READCD ; & CONTINUE READING
08300 >; END OF IFN %SS044
00100 ;READ INTHE STRING TO SEARCH FOR
00200 ;T3 HAS PLACE TO PUT POINTERS T1 A BYTE POINTER FOR STRINGS
00300
00400
00500 SSTRNG: MOVEI T2,SRBLG ;THE PERMISSIBLE LENGTH
00600 HRLI T3,-SRNUM ;T3 HAS POINTER TO PLACE BYTE POINTERS
00700 SSTR0: MOVEM T1,SVPT ;SAVE THE POINTER FOR END OF STRING
00800 SSTR1: PUSHJ P,GNCH ;GET A CHR
00900 CAIN C,200 ;ALTMODE TERMINATES
01000 JRST SSTEND
01100 CAIN C,15 ;IGNORE RETURNS
01200 JRST SSTR1
01300 CAIN C,12 ;LINE FEED IS END OF ONE STRING
01400 JRST SSTR2
01500 IDPB C,T1 ;PUT IN OUTPUT STRING
01600 SOJG T2,SSTR1
01700 SSTR3: RERROR STL ;THE STRING WAS TOO LONG
01800 SSTR4: HRLZ T1,T3 ;ZERO OUT FIRST POINTER
01900 MOVNS T1
02000 ADDI T1,-SRNUM(T3) ;FIND START
02100 SETZM (T1)
02200 JRST COMND
02300 SSTR2: CAMN T1,SVPT ;NULL STRING?
02400 JRST [HLRZ C,T3 ;FIRST ONE?
02500 CAIE C,-SRNUM ;WELL?
02600 JRST .+1 ;NO
02700 MOVEI C,12 ;RETURN A LINE FEED
02800 POPJ P,]
02900 RETSTR: MOVEI C,0 ;TERMINATE STRING WITH 0
03000 IDPB C,T1
03100 SOJLE T2,SSTR3
03200 MOVE C,SVPT ;SET UP POINTER
03300 MOVEM C,(T3)
03400 AOBJN T3,SSTR0 ;IF ROOM FOR MORE, GET THEM
03500 RERROR TMS ;TOO MANY GIVEN
03600 JRST SSTR4
03700 SSTEND: CAIN T2,SRBLG ;DID WE SEE ANY?
03800 POPJ P, ;NO, RETURN
03900 MOVEI C,0 ;YES, TERMINATE LAST
04000 IDPB C,T1
04100 MOVE T1,SVPT
04200 MOVEM T1,(T3) ;SET POINTER
04300 SSTR5: AOBJP T3,CPOPJ1 ;ZERO OUT OTHER POINTERS
04400 SETZM (T3)
04500 JRST SSTR5
04600
00100 ;THE SEARCH ITSELF
00200
00300
00400 COMSRC: MOVEM T2,BUFSAV ;SAVE THE POINTER TO STRINGS
00500 MOVNI T3,1 ;THE COUNT OF HOW FAR INTO LINE WE ARE
00600 MOVEI ALTP,1(PNTR) ;SET BYTE POINTER
00700 HRLI ALTP,(<POINT 7,0,6>)
00800 MOVEI C,15 ;START WITH A LINE DELIMITER
00900 JRST CODEBF ;GO SCAN
01000 COMSRT: ILDB C,ALTP ;WE RETURN HERE IF NO MATCH FOR THIS ONE
01100 CAIE C,15 ;DONE?
01200 AOJA T3,CODEBF ;NO, GO ON
01300 POPJ P, ;YES, NON-MATCH RETUNR
01400
01500 SRCRET: PUSH P,T1 ;SAVE THE RETURN ADDRESS
01600 PUSH P,ALTP ;AND THE STRING POINTER
01700 PUSH P,C ;AND THE CHARACTER
01800 LDB T1,[POINT 4,-1(T1),12] ;GET STRING NUMBER
01900 ADD T1,BUFSAV ;POINT TO BYTE POINTER
02000 SKIPN T1,(T1) ;GET IT
02100 ERROR ICN ;THERE SHOULD BE ONE THERE
02200 MOVE T2,[POINT 7,ARBBUF] ;SET UP ARBIT MATCH
02300 MOVEI T4,MXWPL*^D10 ;POINTER AND COUNT
02400 SETZM ARBCNT ;THE NUMBER OF ARBITRARY MATCHES SEEN
02500 TLZ FL,ARBITG ;OFF AT START
02600 PUSHJ P,LINMAT ;GO CHECK FOR MATCH
02700 JRST LOSE ;WE LOSE, CONTINUE SCAN
02800 MOVEM ALTP,SRCALP ;POINTER TO END OF STRING
02900 POP P,C ;RESTORE
03000 POP P,ALTP
03100 POP P,T1
03200 CPOPJ1: AOS (P) ;SKIP RETURN
03300 POPJ P,
03400 LOSE: POP P,C ;RESTORE
03500 POP P,ALTP
03600 POPJ P, ;AND CONTINUE SEARCH
03700
03800 IFN %SS070, <
03900
04000 ; SUBROUTINE TO IMPLEMENT "FIND NOT" INVERSION OF 'COMSRC' RESULTS
04100
04200 COMTST: PUSHJ P,COMSRC ;CALL COMSRC TO MATCH STRINGS
04300 IFN <FNDNOT-1B0>, <
04400 TDZA T1,T1 ; FAILURE, SET TO 0 & SKIP
04500 MOVEI T1,1 ; SUCCESS, SET TO 1
04600 TLNE FL2,FNDNOT ;TEST FOR "FIND NOT"
04700 XORI T1,1 ; YES, INVERT THE ANSWER
04800 ADDM T1,(P) ;MODIFY RETURN ADDR IF SUCCESSFUL
04900 POPJ P, ;RETURN +0 FOR NO, +1 FOR YES
05000 >; END OF IFN <FNDNOT-1B0>
05100 IFE <FNDNOT-1B0>, <
05200 JRST [ ; FAILURE, JUMP
05300 JUMPL FL2,CPOPJ1 ;RETURN +1 FOR YES IF "FIND NOT"
05400 POPJ P, ;RETURN +0 FOR NO IF "FIND"
05500 ]
05600 JUMPGE FL2,CPOPJ1 ;RETURN +1 FOR YES IF "FIND"
05700 POPJ P, ;RETURN +0 FOR NO IF "FIND NOT"
05800 >; END OF IFE <FNDNOT-1B0>
05900 >; END OF IFN %SS070
00100 NXTCHR: CAIN C,12 ;WAS THAT LAST OF LINE?
00200 POPJ P, ;YES, LOSE
00300 ILDB C,ALTP ;NO, TRY NEXT
00400 LINMAT: PUSHJ P,CHRMAT ;CHECK FOR MATCH
00500 POPJ P, ;NONE, RETURN
00600 CAIE CS,0 ;IS SO ALL DONE
00700 JRST NXTCHR ;NO, TRY MORE
00800 JRST CPOPJ1 ;SKIP RETURN
00900
01000
01100 CHRMAT: TLZ FL,NEGF!DEMCHR ;NO SEEN AND CHR CAN BE 0
01200 READCH: ILDB CS,T1 ;GET NEXT
01290 IFE %SS044, <
01300 JUMPE CS,MATCH ;END OF STRING IS USUALLY GOOD
01400 CAIN CS,.PTNOT ;CHEC FOR NEGATE
01500 JRST [TLC FL,NEGF
01600 TLO FL,DEMCHR ;MUST BE FOLLOWED BY A CHR
01700 JRST READCH]
01800 CAIN CS,"|" ;SEPERATOR?
01900 JRST SEP
02000 CAIN CS,.PTINF ;ARBITRARY NUMBER
02100 JRST ARBIT
02200 CAIN CS,.PTANY ;ANY?
02300 JRST ANY
02400 CAIN CS,.PTQOT ;QUOTE NEXT?
02500 JRST [ILDB CS,T1
02600 JUMPN CS,.+1 ;MUST HAVE ONE THERE
02700 NERROR ISS] ;ELSE ILLEGAL
02705 >; END OF IFE %SS044
02710 IFN %SS044, <
02715 CAIN CS,.PTQOT ;TEST FOR QUOTED CHAR
02720 JRST [ ; YES, JUMP
02725 ILDB CS,T1 ;GET NEXT CHARACTER
02730 JUMPN CS,TSTCHR ; YES, JUMP
02735 NERROR ISS ; NONE, ILLEGAL STRING
02740 ]
02745 CAIN CS,.PTSEP ;TEST FOR A SEPARATOR
02750 JRST SEP ; YES, JUMP
02755 CAIL CS,LPTTAB ;TEST FOR CHAR W/IN TABLE
02760 JRST TSTCHR ; NO, GO DO NORMAL COMPARE
02765 HRRZ T5,PATTAB(CS) ;GET TRANSFER ADDRESS FOR THIS CHAR
02770 JUMPN T5,(T5) ; & GO THERE IF DEFINED
02775 TSTCHR: ;HERE TO TEST FOR CHAR MATCH
02780 >; END OF IFN %SS044
02800 CAMN C,CS ;ARE THEY THE SAME
02900 JRST ISTRU1 ;YES, CHECK NEGF
03000 MOVE T5,CTBL(CS) ;GET BITS
03090 IFE %SS040, <
03100 TLNN FL,EXCTS1!EXCTSR ;EXACT?
03110 >; END OF IFE %SS040
03120 IFN %SS040, <
03130 TRNN FL2,DOEXCT ;TEST FOR EXACT MATCH
03140 >; END OF IFN %SS040
03200 TLNN T5,LETF_16 ;OR NOT LET
03300 JRST ISFALS ;NO MATCH
03400 XORI CS,40 ;CHECK OTHER CASE
03500 CAMN C,CS
03600 JRST ISTRU1
03700 JRST ISFALS ;LOSE
03800
03900 IFN %SS044, <
04000
04100 ; PATTERN MATCH SPECIAL CHARACTER BRANCH TABLE
04200
04300 PATTAB: ;PATTERN-MATCHING CONTROL-CHARACTER BRANCH TABLE
04400 ; (LH) ADDR TO GENERATE CODE, OR ZERO
04500 ; (RH) ADDR TO DO COMPARE, OR ZERO
04600 PHASE 0
04700 XWD NULCD,MATCH ;NUL, END OF PATTERN
04800 .PTLTR: XWD LTRCD,LTR ;^A, ANY LETTER
04900 .PTNXS: XWD 0,0 ;^B (NEXT STRING)
05000 XWD 0,0 ;^C (RESERVED FOR TTY USE)
05100 XWD 0,0 ;^D (RESERVED FOR TTY USE)
05200 .PTNOT: XWD NOTCD,NOT ;^E, 'NOT'
05300 .PTUCL: XWD UCLCD,UCL ;^F, UPPER-CASE LETTER
05400 XWD 0,0 ;BEL (RESERVED FOR TTY USE)
05500 XWD 0,0 ;BS (RESERVED FOR TTY USE)
05600 XWD 0,0 ;HT (RESERVED FOR TTY USE)
05700 XWD 0,0 ;LF (RESERVED FOR TTY USE)
05800 XWD 0,0 ;VT (RESERVED FOR TTY USE)
05900 XWD 0,0 ;FF (RESERVED FOR TTY USE)
06000 XWD 0,0 ;CR (RESERVED FOR TTY USE)
06100 .PTINF: XWD ARBCD,ARBIT ;^N, ANY NUMBER OF
06200 .PTDLM: XWD 0,0 ;^O (NEXT STRING)
06300 .PTDGT: XWD DGTCD,DGT ;^P, ANY DECIMAL DIGIT
06400 XWD 0,0 ;DC1 (RESERVED FOR TTY USE)
06500 XWD 0,0 ;DC2 (RESERVED FOR TTY USE)
06600 XWD 0,0 ;DC3 (RESERVED FOR TTY USE)
06700 .PTANY: XWD ANYCD,ANY ;DC4, ANY CHARACTER
06800 XWD 0,0 ;^U (RESERVED FOR TTY USE)
06900 .PT1MR: XWD MR1CD,ARBIT ;^V, 1 OR MORE
07000 .PTLCL: XWD LCLCD,LCL ;^W, LOWER-CASE LETTER
07100 .PTALM: XWD ALMCD,ALM ;^X, ALPHAMERIC
07200 XWD .-.,.-. ;^Y (AVAILABLE)
07300 XWD 0,0 ;^Z (RESERVED FOR TTY USE)
07400 XWD 0,0 ;ESC (RESERVED FOR TTY USE)
07500 .PTSPC: XWD SPCCD,SPC ;^\, SPACE OR TAB
07600 .PTEOL: XWD EOLCD,EOL ;^], END OF LINE
07700 ;;; .PTQOT: XWD 0,0 ;^^, QUOTE
07800 ;;; XWD .-.,.-. ;^_ (AVAILABLE)
07900 DEPHASE
08000 LPTTAB==.-PATTAB ;LENGTH OF THE TABLE
08100
08200 PAGE
08300
08400 LTR: MOVE T5,CTBL(C) ;GET CHAR BITS
08500 TLNE T5,LETF_16 ;TEST FOR A LETTER
08600 JRST ISTRU ; YES, JUMP
08700 JRST ISFALS ; NO, JUMP
08800
08900 NOT: TLC FL,NEGF ;INVERT THE NEGATIVE FLAG
09000 TLO FL,DEMCHR ;REQUIRE A NEXT CHAR
09100 JRST READCH ; & READ ON
09200
09300 UCL: TDZA T5,T5 ;SET ZERO FOR UPPER CASE
09400 LCL: MOVEI T5,40 ;SET 40 FOR LOWER CASE
09500 CAIL C,"A"(T5) ;TEST FOR LETTER
09600 CAILE C,"Z"(T5) ;TEST FOR LETTER
09700 JRST ISFALS ; NO, JUMP
09800 JRST ISTRU ; YES, JUMP
09900
10000 DGT: CAIL C,"0" ;TEST FOR A DECIMAL DIGIT
10100 CAILE C,"9" ;TEST FOR A DECIMAL DIGIT
10200 JRST ISFALS ; NO, JUMP
10300 JRST ISTRU ; YES, JUMP
10400
10500 ALM: MOVE T5,CTBL(C) ;GET CHAR BITS
10600 TLNE T5,<LETF!SNUMF>_16 ;TEST FOR LETTER/NUMBER
10700 JRST ISTRU ; YES, JUMP
10800 JRST ISFALS ; NO, JUMP
10900
11000 SPC: CAIE C,40 ;TEST FOR SPACE
11100 CAIN C,11 ;TEST FOR TAB
11200 JRST ISTRU ; YES, JUMP
11300 JRST ISFALS ; NO, JUMP
11400
11500 EOL: CAIE C,15 ;TEST FOR END OF LINE
11600 JRST ISFALS ; NO, JUMP
11700 JRST ISTRU ; YES, JUMP
11800
11900 >; END OF IFN %SS044
00100 MATCH: TLNE FL,DEMCHR ;DID WE NEED A CHARACTER THERE?
00200 NERROR ISS ;YES, ILLEGAL STRING
00300 JRST CPOPJ1 ;OK RETURN
00400
00500 ANY: CAIE C,15
00600 JRST ISTRU ;YES THIS IS ANY CHR
00700 ISFALS: CAIN C,15 ;IS IT A RETURN
00800 AOSA T4 ;ADJUST COUNT AND ENTER A NULL STRING
00900 IDPB C,T2 ;SAVE IN ARBIT
01000 MOVEI T5,0
01100 IDPB T5,T2
01200 SUBI T4,2 ;COUNT THEM
01300 JUMPLE T4,ILFMTR ;THIS LINE MUST HAVE ILLEGAL FORMAT
01400 AOS ARBCNT ;ONE MORE SEEN
01500 ISFAL1: TLNE FL,NEGF ;WAS NEG FLAG ON?
01600 AOS (P) ;YES, A MATCH
01700 POPJ P,
01800
01900 SEP: MOVE T5,CTBL(C) ;GET TABLE ENT
02000 JUMPG T5,ISFALS ;NOT A SEP
02100 TRNN FL2,QSEPF ;CHECK . % $
02200 TRNN T5,NSEPF ;CHECKING - DO WE HAVE ONE?
02300 JRST ISTRU ;NO: SEP
02400 JRST ISFALS ;YES: NOT A SEP
02500 ISTRU: CAIN C,15
02600 AOSA T4
02700 IDPB C,T2 ;SAVE CHR
02800 MOVEI T5,0
02900 IDPB T5,T2
03000 SUBI T4,2
03100 JUMPLE T4,ILFMTR
03200 AOS ARBCNT
03300 ISTRU1: TLNN FL,NEGF ;NEGATE?
03400 AOS (P) ;NO, MATCH
03500 POPJ P,
03600
03700 ILFMTR: MOVE T2,CPG ;GIVE HIM AN ERROR MESSAGE AND PAGE
03800 PUSHJ P,PGPRN ;AND LINE
03900 MOVE T1,(PNTR)
03990 IFE %SS021, <
04000 PUSHJ P,OUTSN
04010 >; END OF IFE %SS021
04020 IFN %SS021, <
04030 PUSHJ P,OUNTSN ;TYPE THE SEQ #
04040 >; END OF IFN %SS021
04100 NERROR ILFMT
00100 ARBIT: TLNN FL,NEGF ;THIS HAS NO MEANING
00200 TLOE FL,ARBITG ;ARE WE SEEING
00300 NERROR ISS ;YES, ILLEGAL STRING
00400 PUSH P,T1 ;SAVE SEARCH POINTER
00500 MOVEI T5,0 ;SET ARBITRARY STRING TO NULL
00600 IDPB T5,T2
00700 SOJLE T4,ILFMTR
00800 AOS ARBCNT
00900 PUSH P,ARBCNT ;SAVE IN CASE WE COME BACK WITH NO MATCH
01000 PUSH P,T2
01100 PUSH P,T4
01200 PUSH P,C
01210 IFN %SS044, <
01220 CAIE CS,.PT1MR ;TEST FOR '1 OR MORE'
01230 JRST CHKTHS ; NO, JUMP
01240 TLO FL,DEMCHR ;CHARACTER DEMANDED NOW
01250 PUSHJ P,READCH ;TEST FOR NEXT CHARACTER MATCHES
01260 JRST ARBFAI ; NO, THEN THIS DOESN'T MATCH
01270 JRST ARBAL1 ; YES, THEN TREAT AS NORMAL ARBITRARY
01280 >; END OF IFN %SS044
01300 CHKTHS: TLO FL,DEMCHR ;NEED A CHARACTER NOW
01400 PUSHJ P,READCH ;CALL SELF RECURSIVELY
01500 JRST PROCED ;THIS COULD NOT MATCH JUST SCAN ON
01510 IFN %SS044, <
01520 ARBAL1: ;TO HERE ON FIRST MATCH
01530 >; END OF IFN %SS044
01600 MOVE T2,-3(P) ;RESTORE ARBIT COUNT
01700 MOVEM T2,ARBCNT
01800 MOVE T4,-1(P) ;AND ARBIT CHR COUNT
01900 MOVE T2,-2(P) ;AND POINTER
02000 PUSH P,ALTP ;SAVE CHR POINTER
02100 TLZ FL,ARBITG ;CAN SEE ANOTHER NOW
02200 PUSHJ P,LINMAT ;A MATCH
02300 JRST RECUR ;NO, TRY FOR ANOTHER OF THAT CHR
02400 SUB P,[XWD 7,7] ;GET ALL THAT JUNK OFF STACK
02500 JRST CPOPJ1 ;AND RETURN TO CALLER OF LINMAT
02600 RECUR: POP P,ALTP ;GET BACK POINTER
02700 POP P,C ;AND CHR
02800 MOVE T4,-2(P) ;RESTORE COUNT
02900 MOVEM T4,ARBCNT
03000 POP P,T4
03100 POP P,T2 ;ALSO CHR COUNTER AND POINTER
03200 DPB C,T2 ;PUT IN THAT CHR
03300 MOVEI T5,0 ;AN@ TERMINATOR
03400 IDPB T5,T2
03500 SOJLE T4,ILFMTR
03600 PUSH P,T2
03700 PUSH P,T4 ;RESAVE
03800 MOVE T1,-3(P) ;RESTORE SEARCH POINTER
03900 ILDB C,ALTP ;GET ANOTHER CHR
04000 PUSH P,C ;SAV IT
04100 TLZ FL,NEGF ;TURN THIS OFF FOR RECURSION
04200 CAIE C,12 ;END OF WORLD?
04300 JRST CHKTHS
04310 IFN %SS044, <
04320 ARBFAI: ;TO HERE TO FAIL THE MATCH
04330 >; END OF IFN %SS044
04400 SUB P,[XWD 5,5] ;RECUCE STACK
04500 POPJ P, ;AND ERROR RET
04600 PROCED: TLZ FL,ARBITG!NEGF ;JUST GO ON
04700 POP P,C
04800 POP P,T4
04900 POP P,T2
05000 POP P,ARBCNT
05100 POP P,(P) ;GET RID OF EXTRA POINTER
05200 JRST CHRMAT ;CONTINUE MATCH SCANNING
05300
05400
05500 SUBTTL FIND COMMAND (SEARCHES)
00100
00200 ;DO A SEARCH OF A FILE
00300
00400 SEARCH: TLZ FL,ASSMF ;CLEAR ALL FLAGS
00500 SETZM LOLN ;JUST LIKE EVERYONE ELSE HAS TO
00600 SETZM SRCNT ;START WITH ZERO
00700 MOVE T1,[POINT 7,SRBUF] ;SET UP BYTE POINTER
00800 MOVEI T3,SRPNT ;AND POINTER TO BYTE POINTER TABLE
00900 PUSHJ P,SSTRNG ;GET A SEARCH STRING
01000 JRST [SKIPN SRPNT ;WAS STRING SET?
01100 NERROR NSG ;NO, TELL HIM
01110 IFN %SS043*DEFCRL, <
01120 TLO FL,ASSMF ;ASSUME .+1
01130 >; END OF IFN %SS043*DEFCRL
01200 CAIN C,12
01300 JRST ASSMD1 ;SPECIAL CONTINUE MODE
01400 JRST .+1] ;YES, USE OLD ONE
01500 TLZ FL,NUMSRF!ALTSRF!EXCTSR ;CLEAR FLAGS
01505 IFN %SS040, <
01510 SKIPE EXACTF ;TEST FOR /EXACT
01515 TLO FL,EXCTSR ; YES, SET THE BIT
01520 >; END OF IFN %SS040
01525 IFN %SS055, <
01530 SETZM FNDFTN ;CLEAR THE FIND-FUNCTION WORD
01535 >; END OF IFN %SS055
01540 IFN %SS070, <
01545 TLZ FL2,FNDNOT ;CLEAR "FIND NOT" BIT
01550 >; END OF IFN %SS070
01600 PUSHJ P,SCAN ;CHECK FOR WHAT COMES AFTER
01700 TRNN FL,TERMF ;IF TERMINATOR
01800 CAIN C,"," ;OR ,
01900 JRST ASSMDT ;SET UP LIMITS SPECIALLY
02000 CAIE C,"!"
02100 CAIN C,":"
02200 JRST ASSMDT ;LET HIM SPECIFY 2ND HALF OF RANGE
02210 IFN %SS043*DEFCRL, <
02220 TLZ FL,ASSMF ;NO RANGE ASSUMPTION IF SPECIFIED
02230 >; END OF IFN %SS043*DEFCRL
02300 PUSHJ P,GET2 ;ELSE CALL USUAL LIMIT ROUTINE
02400 SRC4: MOVE T1,HILN ;SAVE END OF RANGE
02500 MOVEM T1,SRHILN
02600 MOVE T1,HIPG
02700 MOVEM T1,SRHIPG
02790 IFE %SS042, <
02800 CAIE C,"," ;ANY MORE ARGUMENTS?
02900 JRST SRC1 ;NO, CHECK TERMINATOR AND PROCEED
03000 PUSHJ P,SCAN ;YES, SEE WHAT IT IS
03100 TRNN FL,IDF ;SHOULD BE IDENT OR NUMBER
03200 JRST SRC2 ;NOT IDENT, CHECK FOR NUMBER OF SEARCHES
03300 MOVS T1,ACCUM ;GET THE IDENT
03400 CAIN T1,(<SIXBIT /N />) ;AND FIND OUT WHAT IT IS
03500 TLO FL,NUMSRF
03600 CAIN T1,(<SIXBIT /A />)
03700 TLO FL,ALTSRF ;FIRST CHECK FOR A OR N
03800 TRNE FL,READOF ;IF READ ONLY AND ALTER
03900 TLNN FL,ALTSRF
04000 SKIPA
04100 NERROR ILC ;WE DO NOT PERMIT IT
04200 TLNN FL,NUMSRF!ALTSRF ;WAS IT EITHER?
04300 JRST SRC3 ;NO, CHECK E
04400 PUSHJ P,SCAN ;CONTINUE LOOKING
04500 CAIE C,","
04600 JRST SRC1 ;NO MORE ARGUMENTS
04700 PUSHJ P,SCAN ;WELL WHAT KIND IS THIS ONE?
04800 TRNN FL,IDF ;MORE IDENTS?
04900 JRST SRC2 ;NO, MUST BE NUMBER OF SEARCHES
05000 MOVS T1,ACCUM
05100 SRC3: CAIE T1,(<SIXBIT /E />)
05200 NERROR ILC ;NO, HE MUST HAVE MADE A MISTAKE
05290 IFE %SS040, <
05300 TLO FL,EXCTSR ;YES, REMEMBER IT
05310 >; END OF IFE %SS040
05320 IFN %SS040, <
05330 TLC FL,EXCTSR ; YES, INVERT THE BIT
05340 >; END OF IFN %SS040
05400 PUSHJ P,SCAN ;AND CHECK FOR MORE
05500 CAIE C,","
05600 JRST SRC1 ;NO MORE
05700 PUSHJ P,SCAN ;ONLY ONE THING IT CAN BE NOW
05800 SRC2: TRNN FL,NUMF
05900 NERROR ILC ;NOPE, LOSE
06000 MOVEM T2,SRCNT ;SAVE AS COUNT OF LINES TO FIND
06100 PUSHJ P,SCAN ;GET TERMINATOR (WE HOPE)
06102 >; END OF IFE %SS042
06104 IFN %SS042, <
06106 IFE %SS055, <
06108 MOVE SINDEX,[SRCNT,,[SIXBIT /N/
06110 TLO FL,NUMSRF
06112 SIXBIT /A/
06114 TLO FL,ALTSRF
06116 SIXBIT /E/
06118 TLC FL,EXCTSR
06120 IFN %SS070, <
06122 SIXBIT /-/
06124 TLO FL2,FNDNOT
06126 >; END OF IFN %SS070
06128 EXP 0]]
06130 PUSHJ P,SCNMOD ;SCAN ALL MODIFIERS
06132 TLNE FL,ALTSRF ;TEST FOR ALTER
06134 TLZ FL,NUMSRF ; YES, CLEAR ",N" SWITCH
06136 >; END OF IFE %SS055
06138 IFN %SS055, <
06140 MOVE SINDEX,[SRCNT,,[SIXBIT /N/
06142 TLO FL,NUMSRF
06144 SIXBIT /D/
06146 TLO FL,ALTSRF ;",D" MEANS "DECIDE"
06148 IFN %SS070, <
06150 SIXBIT /-/
06152 TLO FL2,FNDNOT
06154 >; END OF IFN %SS070
06156 EXP -1
06158 PUSHJ P,SETFTN ;ALL ELSE COMES HERE
06160 ]]
06162 PUSHJ P,SCNMOD ;SCAN THE MODIFIERS
06164 IFN %SS041, <
06166 TLNE FL2,PDECID ;TEST FOR /DECIDE
06168 TLC FL,ALTSRF ; YES, INVERT THE ",D" BIT
06170 >; END OF IFN %SS041
06172 >; END OF IFN %SS055
06174 >; END OF IFN %SS042
06200 SRC1: TRNN FL,TERMF ;ALLS WELL THAT ENDS WELL
06300 NERROR ILC ;BUT THIS DOSNT
06400 SRCH1A: ;HERE TO EXECUTE THE FIND
06410 IFN %SS040, <
06420 TRZ FL2,DOEXCT ;ASSUME NON-EXACT
06430 TLNE FL,EXCTSR ;TEST FOR EXACT
06440 TRO FL2,DOEXCT ; YES, SET THE BIT
06450 >; END OF IFN %SS040
06460 MOVEI T1,SRPNT ;GET POINTER TO STRINGS
06500 PUSHJ P,CODSR ;AND GENERATE CODE
00100 MOVE T1,LOPG ;GET SET TO HUNT IT
00200 MOVEM T1,DPG
00300 MOVEM T1,SRPG ;FLAG TO SAY IF WE SHOULD PRINT PAGE
00400 MOVE SINDEX,LOLN
00500 PUSHJ P,FIND
00600 TRZ FL,LINSN ;NO LINES YET
00700 SETZM FNDFLG ;NO MATCHES EITHER
00800 ONSRC: PUSHJ P,ONMOV ;CHECK RANGE
00900 JRST ENDSRC ;DONE
01000 TLZE FL,ASSMF ;FIRST TIME AND WANT .+1?
01100 JRST [CAME T1,LOLN ;IS THERE EXACT MATCH?
01200 JRST .+1 ;NO, THIS IS .+1
01300 AOS SVCNT ;PRETEND WE DIDNT SEE IT
01400 JRST SRNXT] ;AND TAKE NEXT
01500 TRO FL,LINSN ;WE SAW ONE
01600 CAMN T1,PGMK ;PAGES ARE SPECIAL
01700 JRST SRCPAG ;SO TAKE GOOD CARE OF THEM
01800 MOVEI T2,SRPNT ;POINTER TO STRINGS
01890 IFE %SS070, <
01900 PUSHJ P,COMSRC ;GO SEARCH THIS LINE
02000 JRST SRNXT ;LOSER
02010 >; END OF IFE %SS070
02020 IFN %SS070, <
02030 PUSHJ P,COMTST ;TEST FOR PERMITTED SUCCESSFUL MATCH
02040 JRST SRNXT ; NO, IGNORE THE LINE
02050 TLNE FL2,FNDNOT ;TEST FOR "FIND NOT"
02060 SETZ T3, ; YES, CLEAR OFFSET TO MATCHING CHARS
02070 >; END OF IFN %SS070
02100 SETOM FNDFLG ;FOUND!
02200 MOVEM T3,SVCCNT ;SAVE AWAY THE CHARACTER COUNT
02210 IFN %SS055, <
02220 TLNE FL,ALTSRF ;TEST FOR ",D" OPTION
02230 PUSHJ P,CLRCTO ; YES, CALL TO CLEAR ^O
02240 >; END OF IFN %SS055
02300 MOVE T2,CPG ;GET CURRENT PAGE
02400 TRNN FL2,NONUMF ;DON'T PRINT IF NONUMBER MODE
02500 CAMN T2,SRPG ;SEE IF WE SHOULD PRINT IT
02600 SKIPA
02700 PUSHJ P,PGPRN ;YES
02800 MOVE T2,CPG ;NOW SET IT AS CURRENT
02900 MOVEM T2,CPGL
03000 MOVEM T2,SRPG ;ALSO RESET FLAG
03100 MOVE T2,(PNTR) ;ALSO SET LINE
03200 MOVEM T2,CLN
03290 IFE %SS055, <
03300 TLNE FL,ALTSRF ;ARE WE GOING TO EDIT?
03400 JRST SRCALT ;YES, GO SET THINGS UP
03410 >; END OF IFE %SS055
03420 IFN %SS055, <
03430 TLNN FL,ALTSRF ;TEST FOR DECIDE-OPTION
03440 SKIPL FNDFTN ;TEST FOR ALTER-TYPE COMMAND
03450 SKIPA ; SKIP IF DECIDE OR NOT ALTER-TYPE
03460 JRST SRNXTE ; JUMP IF ALTER W/O DECIDE
03470 >; END OF IFN %SS055
03500 TLNE FL,NUMSRF ;DO WE WANT ONLY LINE NUMBERS?
03600 JRST SRCNUM ;YES
03700 MOVE T1,PNTR ;GO PRINT LINE
03800 PUSHJ P,OUTLIN
03900 SRNXTC: ;HERE AFTER LINE HAS BEEN TYPED
03902 IFN %SS055, <
03904 TLNN FL,ALTSRF ;TEST FOR DECIDE-OPTION
03906 JRST SRNXTE ; NO, JUMP
03908 OUTSTR [ASCIZ /D*/] ;PROMPT FOR THE DECIDE
03910 SRNXTD: INCHRW T1 ;ACCEPT A REPLY CHAR
03912 ANDI T1,177 ;MASK THE CHAR TO 7 BITS
03914 CAIN T1,177 ;TEST FOR RUBOUT
03916 JRST FNDCNO ; YES, JUMP TO IGNORE THE LINE
03918 CAIN T1," " ;TEST FOR BLANK
03920 JRST FNDCOK ; YES, JUMP TO ACCEPT THE LINE
03922 ANDI T1,137 ;FOLD TO UPPER-CASE
03924 CAIE T1,"E" ;TEST FOR "E"
03926 CAIN T1,"Q" ;TEST FOR "Q"
03928 JRST FNDCQT ; EITHER, QUIT THE OPERATION
03930 CAIN T1,"G" ;TEST FOR "G"
03932 JRST FNDCGO ; YES, ACCEPT THE LINE & CANCEL DECIDE-OPTION
03934 SUBI T1,40 ;CONVERT CHAR TO SIXBIT
03936 SETZ T2, ;CLEAR THE NEXT AC
03938 LSHC T1,-6 ;LEFT-ALIGN IN RIGHT AC
03940 PUSHJ P,CHKFTN ;CHECK FOR VALID FIND FUNCTION
03942 JRST SRNXTR ; NOT VALID OR DUPLICATE, SKIP
03944 JUMPE T1,SRNXTG ;JUMP IF ALTER, ALWAYS WORKS
03946 TRNE FL,READOF ;TEST FOR READONLY
03948 JRST SRNXTR ; YES, THEN ANSWER IN ERROR
03950 SRNXTG: OCRLF ; VALID, RETURN THE CARRIAGE
03952 JRST (T3) ;GO PERFORM THE FUNCTION
03954 SRNXTR: OUTSTR [BYTE(7)77,40,7,0,0] ;TYPE OUR DIAGNOSTIC
03956 CLRBFI ;CLEAR TYPE-AHEAD
03958 JRST SRNXTD ; & READ AGAIN
03960
03962 FNDCNO: TRNN FL,EXTOG ;TEST FOR EXPERT
03964 OUTSTR [ASCIZ /[Ignored]/] ; NO, TELL THE USER
03966 OCRLF ;END THE LINE
03968 JRST SRNXTF ; & CONTINUE
03970 FNDCGO: TLZ FL,ALTSRF ;CLEAR THE DECIDE-OPTION
03972 FNDCOK: OCRLF ;RETURN THE CARRIAGE, LINE ACCEPTED
03974
03976 SRNXTE: SKIPE T1,FNDFTN ;TEST FOR FUNCTION DEFINED & GET IT
03978 JRST (T1) ; YES, GO PERFORM IT
03980
03982 SRNXTF: ;HERE AT END OF OPERATION ON THIS LINE
03984 >; END OF IFN %SS055
03986 SOSG SRCNT ;HAVE WE FOUND ENOUGH
04000 JRST SRFND ;YES, GIVE UP (WE HAVE SEEN AT LEAST ONE)
04100 SRNXT: PUSHJ P,FINDN ;GET NEXT LINE TO LOOK A
04200 JRST ONSRC
04300 SRCNUM: MOVE T1,(PNTR) ;PRINT SEQUENCE NUMBER
04390 IFE %SS021, <
04400 PUSHJ P,OUTSN
04500 OCRLF
04510 >; END OF IFE %SS021
04520 IFN %SS021, <
04530 PUSHJ P,OUNTSN ;TYPE THE SEQ #
04540 >; END OF IFN %SS021
04600 JRST SRNXTC ;AND GO
04610
04620 IFN %SS055, <
04630 FNDCQT: TRNN FL,EXTOG ;TEST FOR EXPERT
04640 OUTSTR [ASCIZ /[Ignored]/] ; NO, TELL THE USER
04650 OCRLF ;RETURN THE CARRIAGE BEFORE QUITTING
04660 >; END OF IFN %SS055
04700 ENDSRC: TRZN FL,LINSN ;DID WE SEE ONE?
04800 NERROR NLN ;NULL RANGE
04900 SRFND: SKIPN FNDFLG ;FIND ANY?
05000 RERROR SRF ;NO: TELL HIM
05100 JRST COMND
05200 SRCPAG: AOS CPG ;JUST ADVANCE PAGE COUNTER
05300 JRST SRNXT ;AND PROCEED
05400
05500 IFN %SS055, <
05600
05700 ; FUNCTION TO VALIDATE UNRECOGNIZED MODIFIER CHARACTERS DURING SCAN
05800
05900 SETFTN: MOVE T2,ACCUM ;GET THE TYPED MODIFIER
06000 PUSHJ P,CHKFTN ;CHECK FOR VALID FUNCTION
06100 NERROR ILC ; ERROR, ILLEGAL COMMAND
06200 JUMPE T1,SETFT0 ;JUMP IF ALTER, ALWAYS WORKS
06300 TRNE FL,READOF ;TEST FOR READONLY
06400 IFE %SS074, <
06500 NERROR ILC ; YES, ERROR
06600 >; END OF IFE %SS074
06700 IFN %SS074, <
06800 NERROR IRO ; YES, DESCRIPTIVE ERROR
06900 >; END OF IFN %SS074
07000 SETFT0: MOVEM T3,FNDFTN ; VALID, STORE THE FUNCTION ADDRESS
07100 POPJ P, ;RETURN TO CALLER
07200
07300 ; FUNCTION TO CHECK FOR VALID MODIFIER CHARACTER
07400
07500 CHKFTN: MOVSI T1,-FNDLTB ;GET AOBJN PTR
07600 HLLZ T3,FNDTAB(T1) ;GET TARGET CHARACTERS
07700 CAME T2,T3 ;TEST FOR SAME CHARS
07800 AOBJN T1,.-2 ; NO, INCR & REPEAT
07900 SKIPN FNDFTN ;TEST FOR DUPLICATE FUNCTION
08000 SKIPL T1 ;TEST FOR UNRECOGNIZED OPTION
08100 POPJ P, ; EITHER, RETURN+0 AS ERROR
08200 HRRZ T3,FNDTAB(T1) ;GET FUNCTION ADDRESS
08300 HRRZS T1 ;CLEAR L.H. OF AOBJN PTR
08400 CAIGE T1,FNDNPT ;TEST FOR NON-PRINTING FUNCTION
08500 TLO T3,(1B0) ; YES, SET A BIT
08600 JRST CPOPJ1 ;RETURN+1 IF GOOD MODIFER
08700
08800 FNDTAB: 'A ',,SRCALT ;A - ALTER (*** MUST BE FIRST ***)
08900 'X ',,FNDXND ;X - EXTEND
09000 FNDNPT==.-FNDTAB ; (END OF NON-PRINTING FUNCTIONS)
09100 'I ',,FNDINS ;I - INSERT
09200 'K ',,FNDDEL ;K - DELETE (D PREEMPTED FOR DECIDE)
09300 'M ',,FNDMRK ;M - MARK
09400 'R ',,FNDREP ;R - REPLACE
09500 FNDLTB==.-FNDTAB ; (LENGTH OF TABLE)
09600
09700 >; END OF IFN %SS055
00100 SRCALT: PUSHJ P,SETALT ;SET THINGS UP
00200 SKIPLE T2,SVCCNT ;GET COUNT (DO NOT CALL IF .LE.0)
00300 PUSHJ P,ALTSP ;SPACE OVER CORRECTLY
00400 PUSHJ P,ALTN1 ;GO ALTER
00500 JRST LEVINS ;HE SAID ALTMODE
00600 IFN %SS055, <
00700 TRNE FL,READOF ;TEST FOR READONLY
00800 JRST SRNXTF ; YES, DON'T STORE BACK, JUST CONTINUE
00900 FNDINX: MOVE T1,LIBUF ;GET NEW LINE #
01000 MOVEM T1,CLN ;MAKE IT THE CURRENT LINE
01100 >; END OF IFN %SS055
01200 PUSHJ P,INSED ;INSERT IT
01300 PUSHJ P,FINDN
01400 PUSHJ P,FILLB ;MAKE SURE WE HAVE NOT GOTTEN TOO BIG
01500 IFN %SS055, <
01600 FNDDLX: ;HERE WHEN NO INSERTION & AT NEXT LINE
01700 >; END OF IFN %SS055
01800 MOVE T1,(PNTR) ;GET POINTER BACK
01900 SOSG SRCNT
02000 JRST COMND ;DONE
02100 JRST ONSRC ;GO ON
02200
02300 ASSMD1: TROA FL,CNTF ;MARK AS KEEP END OF RANGE
02400 ASSMDT: TRZ FL,CNTF ;JUST IN CASE
02500 IFE %SS043*DEFCRL, <
02600 TLO FL,ASSMF ;WE ASSUME .+1
02700 >; END OF IFE %SS043*DEFCRL
02800 MOVE T1,CLN ;SET THINGS UP FOR . TO INFINITY
02900 MOVEM T1,LOLN
03000 MOVEM T1,HILN ;AS GOOD AS ANYTHING WITH THE PAGE WE WILL
03100 MOVE T1,CPGL ;USE
03200 MOVEM T1,LOPG
03300 TRZE FL,CNTF ;KEEP END?
03400 JRST NOSPC ;YES
03500 CAIE C,":" ;IF A : OR !
03600 CAIN C,"!"
03700 JRST HALFSP ;GET THE SECOND HALF (.+1 TO GIVEN)
03800 IFN %SS043*DEFCRL, <
03900 TLNE FL,ASSMF ;TEST FOR ASSUMED RANGE
04000 JRST NOSPCC ; YES, JUMP TO SET TOP HALF
04100 >; END OF IFN %SS043*DEFCRL
04200 MOVSI T1,377777 ;GET A LARGE PAGE
04300 MOVEM T1,HIPG
04400 JRST SRC4 ;BACK INTO THINGS
04500
04600 HALFSP: MOVEM T1,HIPG ;SET TOP AS /.
04700 PUSHJ P,GET2HF ;GET THE SECOND HALF
04800 JRST SRC4 ;AND GO
04900
05000 IFN %SS043*DEFCRL, <
05100 NOSPCC: TRO FL,CNTF ;SET FLAG FOR "F$" SYNTAX
05200 >; END OF IFN %SS043*DEFCRL
05300 NOSPC: MOVE T1,SRHIPG
05400 MOVEM T1,HIPG ;PUT BACK END
05500 MOVE T1,SRHILN
05600 MOVEM T1,HILN
05700 IFN %SS043*DEFCRL, <
05800 TRZE FL,CNTF ;TEST FOR "F$" SYNTAX
05900 JRST SRC4 ; YES, JUMP TO SCAN REST OF LINE
06000 >; END OF IFN %SS043*DEFCRL
06100 JRST SRCH1A
06200
06300 LEVINS: OCRLF ;YES - PUT OUT CRLF
06400 SETZM ALTSN ;CLEAR FLAG
06500 JRST COMND
06600
06700 IFN %SS055, <
06800
06900 ; FIND - REPLACE OPTION
07000
07100 FNDREP: PUSHJ P,FNDDDL ;DELETE THE LINE & POSITION AFTER
07200 MOVE T1,CLN ;GET THE CURRENT LINE
07300 JRST FNDIRC ; & GO INSERT THERE
07400
07500 ; FIND - INSERT OPTION
07600
07700 FNDINS: MOVE T1,CLN ;GET THE CURRENT LINE
07800 MOVE T2,T1 ; & COPY IT
07900 MOVEI T3,1 ;REQUEST ONE LINE
08000 SETZM TRMFLG ;REQUESTED ROUNDED #
08100 PUSHJ P,GETDIF ;COMPUTE THE NEXT LINE #
08200 JRST [ ; ERROR, NO ROM FOR ANOTHER LINE
08300 RERROR ILR ;GIVE THE ERROR MSG
08400 JRST FNDDLX ; & CONTINUE
08500 ]
08600 FNDIRC: MOVEM T1,LIBUF ;STORE LINE # FOR INSERTION
08700 SETZM OCNT ;CLEAR OLD LINE LENGTH
08800 TRNN FL2,COMFLF!NONUMF ;TEST FOR LINE # PROMPT
08900 PUSHJ P,OUTSN ; YES, OUTPUT IT
09000 PUSHJ P,RDLIN ;READ THE NEW LINE
09100 SETZ T1, ; LEADING ALTMODE, SET TO ZERO FOR NO INSERTION
09200 SKIPN ALTSN ;TEST FOR ALTMODE TYPED (LEADING/TRAILING)
09300 JRST FNDIRX ; NO, JUMP
09400 TRNN FL2,COMFLF ;TEST FOR @-FILE
09500 OCRLF ; NO, RETURN THE CARRIAGE
09600 SETZM ALTSN ;SHOW NO ALTMODE SEEN
09700 FNDIRX: JUMPE T1,FNDDLX ;JUMP IF NOTHING TO INSERT
09800 MOVEM T1,NCNT ;STORE THE INSERTION COUNT
09900 JRST FNDINX ; & GO INSERT THE LINE
10000
10100 ; FIND - DELETE OPTION
10200
10300 FNDDEL: PUSHJ P,FNDDDL ;DELETE THE LINE & REPOSITION
10400 JRST FNDDLX ;CONTINUE ONWARD
10500
10600 FNDDDL: MOVE T1,(PNTR) ;GET CURRENT LINE #
10700 PUSHJ P,DODEL ;DELETE THE LINE
10800 PUSHJ P,DELRPT ;REPORT THE DELETION
10900 JRST FINDN1 ;FIND NEXT LINE & RETURN TO CALLER
11000
11100 ; FIND - MARK OPTION
11200
11300 FNDMRK: PUSHJ P,MARKIT ;INSERT A PAGE-MARK
11400 AOS HIPG ;INCREMENT UPPER PAGE #
11500 AOS SRHIPG ; & SAVED VERSION OF SAME
11600 MOVE T2,CPG ;GET CURRENT PAGE #
11650 MOVEM T2,SRPG ; & STORE AS TYPED PAGE #
11700 TRNN FL,NONUMF ;TEST FOR NONUMBER MODE
11800 PUSHJ P,PGPRN ; NUMBER MODE, TYPE THE NEW PAGE #
11900 JRST SRNXTF ;CONTINUE ONWARD, FINDING NEXT LINE 1ST
12000
12100 ; FIND - EXTEND OPTION
12200
12300 FNDXND: TLNE FL,NUMSRF ;TEST OR ",N" OPTION
12400 TRO FL2,SUPN ; YES, SUPPRESS LINE PRINTING
12500 PUSHJ P,SETALT ;SET UP THE LINE FOR ALTER
12600 MOVSI T2,1 ;GET LARGE #
12700 PUSHJ P,ALTSP ;SPACE TO END OF LINE
12800 TRZ FL2,SUPN ;CLEAR THE SUPPRESS FLAG
12900 SETZ T2, ;CLEAR THE REPEAT COUNT
13000 PUSHJ P,[ ;CALL TO INSERT
13100 PUSHJ P,ALTIN ;INSERT TEXT
13200 PUSHJ P,ALTN1 ;PERFORM NORMAL INSERT
13300 JRST LEVINS ; DONE, END THE COMMAND
13400 AOS (P) ;NORMAL RETURN, SET +1 RETURN
13500 POPJ P, ;RETURN TO CALLER
13600 ]
13700 JRST LEVINS ; DONE, END THE COMMAND
13800 JRST FNDINX ;INSERT THE CHANGED LINE
13900 >; END OF IFN %SS055
14000
14100 SUBTTL ALTMODE AND LINE FEED COMMANDS
00100 NXTLIN: PUSHJ P,NBFIND ;GET CURRENT LINE
00200 CAMN T1,CLN ;DID WE REALLY FIND IT
00300 PUSHJ P,FINDN ;YES, GET NEXT ELSE WE ALREADY HAVE IT
00400 JUMPE T1,[NERROR NLN] ;EOF AND NOT FOUND
00500 ;;*FIX* OUTCHR [15]
00550 OCRLF ;END THE LINE ;** FIX **
00600 TRNE FL,DPYF
00700 OUTSTR [BYTE (7)32,177,177,177]
00800 NXTL1: CAMN T1,PGMK ;IS THIS A PAGE MARK?
00900 JRST NXTPG ;TREAT SPECIALLY
01000 NBPRNT: MOVEM T1,CLN ;SET AS CURRENT
01100 MOVE T1,PNTR ;GET THE CURRENT POINTE
01150 ;;*FIX* COMMENTED-OUT CODE FOLLOWING NOT REQ'D- 'OUTLIN' ROUTINE RESPECTS 'NONUMF'
01200 ;;*FIX* TRNE FL2,NONUMF
01300 ;;*FIX* TRO FL2,SUPN
01400 PUSHJ P,OUTLIN ;AND PRINT
01500 ;;*FIX* TRZ FL2,SUPN
01600 JRST COMND ;DONE
01700
01800 NXTPG: AOS T2,CPG ;WE ARE ON THE NEXT PAGE
01900 MOVEM T2,CPGL
02000 TRNN FL2,NONUMF
02100 PUSHJ P,PGPRN ;TELL HIM
02200 PUSHJ P,FINDN ;FIND A LINE ON IT
02300 JUMPN T1,NXTL1 ;THERE IS ONE THERE, PRINT IT
02400 MOVE T1,[<ASCII /00000/>!1] ;END OF FILE, SET TO THAT PAGE ;** FIX **
02500 MOVEM T1,CLN
02600 JRST COMND
02700
02800
02900
03000 BAKLIN: PUSHJ P,NBFIND ;GET CURRENT LINE
03100 TRNE FL,BOF ;IF NOT AT START OF FILE
03200 CAME PNTR,BUFP ;OR NOT AT START OF BUFFER
03300 SKIPA
03400 NERROR NLN
03500 ;;*FIX* OUTCHR [15]
03600 ;;*FIX* TRNN FL,DPYF ;*** NOT NEEDED WHEN CRT'S TAKE <CR> AS
03700 ;;*FIX* OUTCHR [12] ;*** <CR>,<LF> & IGNORE <LF>
03750 OCRLF ;*** BUT HARD-COPY TTY'S NEED BOTH!
03800 BAK1: PUSHJ P,FINDB
03900 CAME T1,PGMK
04000 JRST NBPRNT
04100 MOVE T2,CPG
04200 MOVEM T2,CPGL
04300 TRNN FL2,NONUMF
04400 PUSHJ P,PGPRN
04500 TRNE FL,BOF ;CHECK FOR START OF WORLD
04600 CAME PNTR,BUFP
04700 JRST BAK1 ;OK, BACK UP SOME MOR
04800 MOVE T1,[<ASCII /00000/>!1]
04900 MOVEM T1,CLN
05000 JRST COMND
05100
05200 NBFIND: MOVE T1,CPGL ;CURRENT PAGE
05300 MOVEM T1,DPG
05400 MOVE SINDEX,CLN ;AND CURRENT LINE
05500 JRST FIND ;GO FETCH
05600
05700 SUBTTL COPY AND TRANSFER COMMANDS
00100
00200 TRANS: TLOA FL,TRANFL ;SET AS TRANSFER COMMAND
00300 COPY: TLZ FL,TRANFL ;JUST TO MAKE SURE
00400 SETZM HILN ;THIS, TOO MAY PROVE USEFUL
00500 SETZM LOLN ;A GOOD THING TO DO
00590 IFE %SS074, <
00600 TRNE FL,READOF ;DO NOT LET HIM IN READ ONLY MODE
00700 NERROR ILC
00710 >; END OF IFE %SS074
00800 SETZM SVJRL2 ;NO SECOND JOBREL SAVED
00900 PUSHJ P,GET1S ;GET PLACE TO PUT LINES
01000 MOVE T1,HIPG ;STORE IT AWAY FOR LATER
01100 MOVEM T1,DESTPG
01200 ;;*FIX* MOVE T1,HILN
01210 SKIPN T1,HILN ;GET DESTINATION LINE # & TEST FOR 0 ;** FIX **
01220 MOVE T1,[<ASCII /00000/>!1] ; YES, SET TO ASCII 00000 ;** FIX **
01300 MOVEM T1,DESTLN
01400 CAIE C,"_" ;...
01500 CAIN C,"=" ;DOES HE WANT TO COME FROM ANOTHER FILE?
01600 JRST ALTFIL ;YES
01700 TLZ FL,COPFIL ;NO, MAKE SURE FLAG IS OFF
01800 COPY1:
01900 CAIE C,"," ;SHOULD BE COMMA EVEN IF FROM ALTFIL
02000 NERROR ILC ;HE MUST SAY WHERE TO PUT IT
02100 PUSHJ P,COPYP ;PARSE RANGE ARGS
02200 COPY2: SETOM NLIN1 ;LINES ON FIRST PAGE
02300 SETZM NLIN2 ;LINES ON LAST PAGE
02310 IFN %SS047, <
02320 PUSHJ P,CHKBAS ;CHECK FOR /BASIC FILE
02330 >; END OF IFN %SS047
02400 TLO FL2,NORENT ;AND REE-ENTER
02500 TLZ FL2,RENTF ;IN CASE HE HAS
02600 TLO FL,ISCOP ;SO WE WILL DO SPECIAL RESET IF ERROR
02700 MOVE ALTP,.JBREL## ;SET UP SAVE POINTER
02800 MOVEM ALTP,SVJRL ;SO WE CAN RESET IT
02900 MOVEI T1,2000(ALTP) ;ASK FOR ANOTHER 1K
03000 CORE T1,
03100 NERROR NEC ;ALL OUT, GIVE UP
03200 HRLI ALTP,-2000 ;SET COUNT OF HOW MUCH IS THERE
03300 SETZM LSTPG ;HAVE SEEN NO PAGES YET
03400 MOVE T1,LOPG ;LOOK FOR SOURCE
03500 MOVEM T1,DPG
03600 MOVE SINDEX,LOLN
03700 PUSHJ P,FIND
00100 TRZ FL,LINSN ;AND NO LINES
00200 TLNN FL,TRANFL ;IS THIS A TRANSFER COMMAND?
00300 JRST GOCOP ;NO, IGNORE ALL THIS SPECIAL STUFF
00400 HRRZM ALTP,STARTD ;SAVE THE START OF DELETED CODE
00500 HRRZM ALTP,ENDD ;AND THE END
00600 MOVE T1,CPG ;GET THE PAGE ON WHICH DELETION STARTS
00700 MOVEM T1,TRANST ;AND SAVE IT
00800 SKIPN -1(PNTR) ;ARE WE AT THE START OF THE BUFFER
00900 TRNN FL,BOF ;AND OF THE WORLD
01000 SKIPA
01100 JRST BEGFIL ;YES, DO NOT LOOK BACK
01200 PUSHJ P,FINDB ;GET THE PREVIOUS LINE
01300 CAMN T1,PGMK ;A PAGE IS SPECIAL
01400 JRST SPCPG
01500 MOVEM T1,BOTLIN ;SAVE IT FOR LATER
01600 PUSHJ P,FINDN ;GO FORWARD AGAIN
01700 JRST GOCOP
01800 SPCPG: SKIPE LOLN ;DO WE INTEND TO ABSORD THIS ONE
01900 JRST BEGFIS ;MOVE FORWARD AND RECORD
02000 SKIPN -1(PNTR) ;CHECK FOR START OF WORLD AGAIN
02100 TRNN FL,BOF
02200 SKIPA
02300 JRST BEGFIS
02400 PUSHJ P,FINDB ;BACK UP
02500 AOS CPG ;FIX PAGE COUNT
02600 PUSH P,T1 ;SAVE THAT LINE
02700 PUSHJ P,FINDN
02800 PUSHJ P,FINDN ;AND GO BACK WHERE WE BELONG
02900 POP P,T1 ;GET LINE NUMBER BACK
03000 CAMN T1,PGMK ;THERE'S THAT PAGE AGAIN
03100 JRST BEGFIA
03200 MOVEM T1,BOTLIN ;SAVE LINE NUMBER
03300 JRST GOCOP
03400 BEGFIS: AOSA CPG
03500 BEGFIA: AOSA CPG
03600 BEGFIF: PUSHJ P,FINDN
03700 BEGFIL: SETOM BOTLIN ;A VERY SMALL NUMBER
03800 GOCOP: SETZM PGDELS ;TOTAL NUMBER OF PAGES DELETED IS 0
03900 SKIPE LOLN ;DID HE ASK FOR THE WHOLE PAGE
03990 IFE %SS035, <
04000 JRST NOISTP ;NO
04010 >; END OF IFE %SS035
04020 IFN %SS035, <
04030 JRST RSTSTP ; NO, STORE LIMITS
04040 >; END OF IFN %SS035
04100 MOVE T1,PGMK ;YES, PUT IN THE PAGE MARK
04200 MOVEM T1,1(ALTP)
04300 MOVE T1,PGMKW2 ;2ND WORD
04400 MOVEM T1,2(ALTP)
04500 HRRZM ALTP,LSTPG
04600 ADD ALTP,[XWD 2,2]
04700 SETZM NLIN1 ;NO LINES ON FIRST PAGE
04800 TLNN FL,TRANFL ;IS THIS A TRANSFER
04890 IFE %SS035, <
04900 JRST NOISTP ;NO, START TRANSFER OF DATA
04910 >; END OF IFE %SS035
04920 IFN %SS035, <
04930 JRST RSTSTP ;NO, JUMP TO SAVE POINTERS & XFER DATA
04940 >; END OF IFN %SS035
05000 MOVE T1,CPG ;CHECK TO SEE IF WE SHOULD REALLY DELETE
05100 CAIN T1,1 ;NOT IF PAGE 1
05200 JRST RSTSTP
05300 PUSHJ P,FINDB ;GET THAT PAGE
05400 SETZM NCNT ;DELETE
05500 MOVEI T1,2
05600 MOVEM T1,OCNT
05700 PUSHJ P,INSED
05800 PUSHJ P,FINDN1 ;MAKE SURE WE ARE AT THE LINE WE WERE AT
05900 AOS CPG ;KEEP COUNT STRAIGHT
06000 AOSA PGDELS ;ONE DELETED
06100 RSTSTP: HRRZM ALTP,STARTD ;RESET START IF NONE DELETED
06200 HRRZM ALTP,ENDD ;RESET END
00100 NOISTP: MOVE T1,(PNTR) ;MAKE SURE WE HAVE THAT JUNK BACK
00200 ONCOPY: PUSHJ P,ONMOV ;STILL IN RANGE?
00300 JRST ENDCOP ;NO, START INSERTING
00400 TRO FL,LINSN ;WE SAW ONE
00500 CAMN T1,PGMK ;IS IT A PAGE?
00600 JRST MOVPG ;YES, TREAT SPECIAL
00700 AOS NLIN2 ;INCR LINE SEEN
00800 MOVLCT: MOVE T1,PNTR ;START TRANSFER
00900 MOVE T2,(T1) ;PICK UP FIRST WORD (SEQ NUM)
01000 MOVEM T2,LSTLN ;SAVE FOR INC CALC
01005 IFN %SS020, <
01007 TLNE FL,TRANFL ;TEST FOR COPY COMMAND
01010 CAMN T2,PGMK ;TEST FOR PAGE MARK
01015 JRST TRLIN ; EITHER, JUMP
01020 AOS DELCNT ;INCR COUNT OF DELETED LINES
01025 MOVEM T2,LDELLN ;STORE AS LAST DELETED LINE #
01030 SKIPE FDELLN ;TEST FOR 1ST DELETED LINE
01035 JRST TRLIN ; NO, JUMP
01040 MOVEM T2,FDELLN ;STORE FIRST DELETED LINE #
01045 MOVE T1,CPG ;GET CURRENT PAGE #
01050 MOVEM T1,FDELPG ;STORE AS FIRST DELETED PAGE #
01055 MOVE T1,PNTR ;RESTORE BUFFER POINTER
01060 >; END OF IFN %SS020
01100 TRLIN: MOVEM T2,1(ALTP) ;PUT LINE AWAY
01200 AOBJP ALTP,RESTCR ;NEED MORE CORE?
01300 TRLIN1: SKIPN T2,1(T1) ;END OF LING?
01400 JRST NXTLCT
01500 TRNN T2,1
01600 AOJA T1,TRLIN ;NO MOVE NEXT WORD
01700 NXTLCT: TLNN FL,TRANFL ;IS THIS TRANSFER?
01800 JRST NXTLCP ;NO, DON'T DELETE
01900 HRRZM ALTP,ENDD ;SAVE END OF DELETED TEXT
02000 SETZM NCNT
02100 SUBI T1,-1(PNTR) ;GET LENGTH
02200 MOVEM T1,OCNT
02300 PUSHJ P,INSED
02400 PUSHJ P,FINDN1 ;MAKE SURE A LINE IS THERE
02500 SKIPA ;SKIP THE FINDN
02600 NXTLCP: PUSHJ P,FINDN ;YES, GET NEXT
02700 JRST ONCOPY
02800
02900 MOVPG: AOS CPG ;WE ARE ON NEXT PAGE
03000 MOVE T1,NLIN2
03100 SKIPGE NLIN1 ;PUT ON FIRST PAGE IF NOT SOME ALREADY THERE
03200 MOVEM T1,NLIN1
03300 SETZM NLIN2
03400 HRRZM ALTP,LSTPG ;SAVE RECORD OF WHERE SEEN
03500 AOS PGDELS ;RECORD ONE MORE PAGE DELETED
03510 IFN %SS020, <
03520 SETZM LDELLN ;CLEAR LAST DELETED LINE #
03530 >; END OF IFN %SS020
03540 IFN %SS031, <
03550 SETZM LSTLN ;CLEAR LAST LINE # SEEN
03560 >; END OF IFN %SS031
03600 JRST MOVLCT ;NOW MOVE IT
03700 RESTCR: MOVE T2,.JBREL## ;GET END
03800 ADDI T2,2000
03900 CORE T2, ;GET MORE
03990 IFE %SS031, <
04000 NERROR NEC
04010 >; END OF IFE %SS031
04020 IFN %SS031, <
04030 JRST NOMOCO ; NO CORE, GIVE AN ERROR
04040 >; END OF IFN %SS031
04100 HRLI ALTP,-2000
04200 JRST TRLIN1 ;AND CONTINUE
04204
04208 IFN %SS031, <
04212 NOMOCO: MOVEI T1,NEC ;GET NOT ENOUGH CORE ERROR CODE
04216 MOVEM T1,SVERN ; & STORE FOR "=ERROR"
04220 TRNE FL,EXTOG ;TEST FOR EXPERT
04224 OUTSTR [ASCIZ /%NEC/] ; YES, TYPE SHORT MSG
04228 TRNN FL,EXTOG ;TEST FOR NON-EXPERT
04232 OUTSTR [ASCIZ /%Not enough core/] ; YES, TYPE LONG MSG
04236 OUTSTR [ASCIZ / copying /] ;TYPE MORE TEXT
04240 SKIPN T2,LSTLN ;GET LINE & TEST FOR ZERO
04244 MOVE T2,[ASCII /<P-M>/] ; YES, AS '<P-M>'
04248 MOVEM T2,LINOUT ;STORE FOR ASCIZ TEXT
04252 OUTSTR LINOUT ; & TYPE IT, PLUS A "/"
04256 MOVE T1,CPG ;GET CURRENT PAGE
04260 PUSHJ P,GIV2 ;TYPE IT & <CR><LF>
04264 TRNE FL2,COMFLF ;TEST FOR @-FILE
04268 OUTSTR COMESS ; YES, TELL LINE #
04272 JRST CKIND ;GO END THE COMMAND
04276 >; END OF IFN %SS031
04300
04400 ENDCOP: TRNN FL,LINSN ;WERE THERE ANY THERE?
04500 NERROR NLN ;NO LOSE
04510 IFN %SS035, <
04520 HRRZM ALTP,ENDD ;STORE END OF DATA
04530 >; END OF IFN %SS035
04600 SETZM 1(ALTP) ;MAKE SURE THERG IS AN END FLAG THERE
04700 TLZE FL,COPFIL ;ARE WE COMMING OFF A FILE
04800 PUSHJ P,RSCOP ;YES, RESET POINTERS
04900 MOVE T1,DESTPG ;LOOK FOR DESTINATION
05000 MOVEM T1,DPG
00100 TLNN FL,TRANFL ;IS IT A TRANSFER?
00200 JRST DOINS1 ;NO, PUT THE COPIED TEXT IN
00300 SETZM PGINSD ;NO EXTRA PAGE MARK INSERTED YET
00400 SKIPN T2,(PNTR) ;ARE WE AT EOF
00500 JRST NOPGIN ;YES, DO NOT INSERT A PAGE MARK
00600 CAME T2,PGMK ;ALSO NOT IF PAGE MARK
00700 CAMLE T2,BOTLIN ;OR GREATER THAN LINE LEFT OVER
00800 SKIPA
00900 SETOM PGINSD ;WE WILL HAVE TO INSERT ONE
01000 NOPGIN: MOVN T2,PGDELS ;GET MINUS NUMBER OF PAGES DELETED
01100 SUB T2,PGINSD ;ONE LESS IF A PAGE MARK INSERTED
01200 CAMGE T1,TRANST ;(T1 HAS DEST. PAGE) IF SMALLER THAN START
01300 JRST DOSUB ;EVERYTHING IS OK
01400 CAMN T1,TRANST ;IS IT SAME?
01500 JRST DSEQTR ;SPECIAL CHECK REQUIRED
01600 CAMGE T1,CPG ;INSIDE RANGE DELETED?
01700 NERROR ITD ;LOSE BIG
01800 CAMN T1,CPG ;SAME AS TOP PAGE?
01900 JRST DSEQCP
02000 ADDM T2,DESTPG ;ADJUST PGE WE ARE TO FIND
02100 ADDM T2,DPG
02200 DOSUB: ADDM T2,CPG ;ADJUST FOR REMOVED PAGES
02300 ADDM T2,INPG
02400 ADDM T2,BGPG
02500 SKIPN PGINSD ;SEE IF WE WANT TO INSERT ONE
02600 JRST DOINS1
02690 IFE %SS056, <
02700 MOVE T1,PGMK
02800 MOVEM T1,LIBUF
02900 MOVE T1,PGMKW2
03000 MOVEM T1,LIBUF+1
03100 SETZM OCNT
03200 MOVEI T1,2
03300 MOVEM T1,NCNT
03400 PUSHJ P,INSED
03500 PUSHJ P,FINDN ;ADVANCE OVER IT
03600 PUSHJ P,FILLB ;IN CASE OF OVERFLOW
03610 >; END OF IFE %SS056
03620 IFN %SS056, <
03630 PUSHJ P,MARKER ;INSERT A PAGE-MARK
03640 >; END OF IFN %SS056
03700 OUTSTR [ASCIZ /%Page mark inserted to prevent order error
03800 /]
03900 JRST DOINS1
04000 ALLSAM: SKIPN LOLN
04100 SKIPE PGINSD ;IF DID NOT DELETE PAGE OR INSERTED ONE
04200 JRST DOSUB ;ALL OK
04300 SKIPE T1,(PNTR) ;ELSE MUST BE IN UPPER PART
04400 CAMN T1,PGMK
04500 NERROR ITD ;THERE IS NO UPPER PART
04600 CAMLE T1,DESTLN
04700 NERROR ITD
04800 SOS T1,DESTPG ;THIS WILL BE ON A LOWER PAGE
04900 MOVEM T1,DPG
05000 JRST DOSUB
00100 DSEQTR: CAMN T1,CPG ;IS IT ALL ON SAME PAGE?
00200 JRST ALLSAM ;YES, SPECIAL CHECKING
00300 SKIPN LOLN ;DID WE START WITH A PAGE
00400 NERROR ITD ;YES, LOSE
00500 SKIPE PGINSD ;WAS THERE A PAGE INSERTED?
00600 JRST DOSUB ;YES, ALL OK
00700 SKIPE T1,(PNTR) ;FIND OUT WHAT THE NEXT LINE IS
00800 CAMN T1,PGMK
00900 JRST DOSUB ;THIS WILL BE OK
01000 CAMG T1,DESTLN ;SEE IF WE ARE IN TROUBLE
01100 NERROR ITD
01200 JRST DOSUB ;OK
01300 DSEQCP: SKIPE PGINSD ;WAS ONE INSERTED
01400 JRST AOSTRA ;SET PAGE PROPERLY
01500 MOVE T1,DESTLN
01600 CAMG T1,BOTLIN
01700 NERROR ITD
01800 SKIPA T1,TRANST
01900 AOSTRA: AOS T1,TRANST
02000 MOVEM T1,DESTPG
02100 MOVEM T1,DPG ;ALSO SET THIS
02200 JRST DOSUB
02300 DOINS1: MOVE SINDEX,DESTLN
02400 PUSHJ P,FIND
02500 PUSH P,T1 ;SAVE LINE FOUND
02600 MOVE T1,CPG
02700 CAMN T1,DESTPG ;PAGES MUST MATCH
02800 JRST DOINS2
02900 TLNN FL,TRANFL ;ONLY TRANSFER
03000 NERROR NSP ;ERROR IF COPY
03090 IFE %SS056, <
03100 MOVE T1,PGMK
03200 MOVEM T1,LIBUF
03300 MOVE T1,PGMKW2
03400 MOVEM T1,LIBUF+1
03500 SETZM OCNT
03600 MOVEI T1,2
03700 MOVEM T1,NCNT
03800 PUSHJ P,INSED
03890 IFE %SS035, <
03900 PUSHJ P,FINDN
03910 >; END OF IFE %SS035
03920 IFN %SS035, <
03930 PUSHJ P,FINDZ ;FIND THE NEXT LINE, BUT DON'T READ
03940 >; END OF IFN %SS035
04000 PUSHJ P,FILLB
04100 AOS CPG
04200 AOS INPG
04300 AOS BGPG
04310 >; END OF IFE %SS056
04320 IFN %SS056, <
04330 PUSHJ P,MARKIT ;INSERT A PAGE MARK
04340 >; END OF IFN %SS056
04400 OUTSTR [ASCIZ /%Text inserted at end of file
04500 /]
04600 MOVE T1,CPG
04700
04800 DOINS2: MOVEM T1,CPGL ;SET THIS AS CURRENT PAGE
04890 IFE %SS020, <
04900 POP P,T1 ;RETRIEVE LINE FOUND
04910 >; END OF IFE %SS020
04990 IFE %SS027, <
05000 MOVE T2,[<ASCII /00100/>!1]
05010 >; END OF IFE %SS027
05020 IFN %SS027, <
05030 MOVE T2,TECFST ;GET DEFAULT 1ST LINE NUMBER
05040 >; END OF IFN %SS027
05100 MOVEM T2,CLN ;AND THIS AS CURRENT LINE
05200 MOVEM T2,SVLNUM
05300 MOVE ALTP,SVJRL ;POINT TO START OF LINES TO COPY
05400 TLZ FL,TRANFL ;THIS FLAG NO LONGER NEEDED
05500 IFN %SS020, <
05600 PUSHJ P,DELRPT ;TYPE REPORT ON DELETED LINES
05700 POP P,T1 ;RESTORE NEXT LINE # OF DESTINATION
05800 >; END OF IFN %SS020
05900 IFN %SS035, <
06000 SETZM FILPT ;SET TO 0 TO CAUSE TEXT BUFFER NOT
06100 ;TO REFILL DURING COPY OPERATIONS
06200 >; END OF IFN %SS035
00100 TWOSET: SKIPGE NLIN1 ;DID WE SEE ANY PAGE MARKS?
00200 JRST ONSET ;NO -- JUST NEED ONE INCR
00300 MOVEM T1,HIGH1 ;SAVE THIS FOR LATER
00310 JUMPE T1,ONSET ;JUMP IF COPYING AT EOF ;** FIX **
00320 ; (LAST PAGE SEQ # OK AS GIVEN, ;** FIX **
00330 ; SO ONLY NEED TO CHECK 1ST #) ;** FIX **
00340 ;FIX FROM DEC EDIT 123 ;** FIX **
00400 MOVE T3,NLIN2 ;NUMBER OF LINES ON LAST PG
00410 IFN %SS031, <
00420 JUMPE T3,OKINC2 ; ZERO, JUMP, ALL IS OK
00430 >; END OF IFN %SS031
00500 MOVE T2,[<ASCII /00000/>!1]
00600 MOVE T1,T2 ;COMPUTE CORRECT INCR
00610 IFN %SS031, <
00620 SETOM TRMFLG ;REQUEST RAW INCRMENT BACK
00630 >; END OF IFN %SS031
00700 PUSHJ P,GETDIF ;CALL ROUTINE
00800 JRST ORDSEC ;ORDER PROB
00900 MOVEM T1,START2 ;PLACE TO START FOR LAST PAGE
01000 SKIPN SINCR ;DID HE SAY ONE
01090 IFE %SS031, <
01100 JRST [MOVE T1,LSTLN ;LAST LINE SEEN
01200 CAML T1,(PNTR) ;HOW'S IT LOOK?
01300 JRST ONST3 ;NOT GOOD ENOUGH
01400 JRST OKINC2]
01405 >; END OF IFE %SS031
01410 IFN %SS031, <
01415 JRST [ ;JUMP IF ZERO INCREMENT
01420 MOVE T1,LSTLN ;GET LAST LINE # SEEN (FROM SOURCE)
01425 CAMGE T1,(PNTR) ;TEST FOR .LT. NEXT AFTER DESTINATION
01430 JRST OKINC2 ; NO ORDER ERROR, OK, JUMP
01435 SKIPE T1,(PNTR) ;GET MATCHING SEQ & TEST FOR ZERO
01440 CAMN T1,PGMK ;TEST FOR PG MARK
01445 JRST OKINC2 ; EOF OR P/M, NO ORRER ERROR, JUMP
01450 JRST ONST3 ;ERROR, JUMP TO GIVE THE SEQ #
01455 ]
01460 >; END OF IFN %SS031
01500 CAML T2,SINCR ;SEE WHOSE IS BETTER
01600 JRST OKINC2 ;WE'LL USE HIS
01700 ONST3: ;HERE TO USE COMPUTED 2D INCR
01710 IFN %SS031, <
01720 MOVE T3,START2 ;GET DEFAULT INCRMENT
01730 PUSHJ P,ACTINC ;COMPUTE ROUNDED INCR
01740 MOVEM T2,START2 ;STORE AS NEW STARTING LINE #
01750 >; END OF IFN %SS031
01760 MOVEM T2,SINCR ;OURS IS BETTER
01800 ONST2: MOVEM T2,PRNTO2 ;INFOR HIM OF THE CHANGE
01900 OUTSTR ASCIZ2
02000
02090 ;EDIT 134, SPR 10-14420 ;** FIX **
02100 OKINC2: MOVE SINDEX,DESTLN ;GET DESTINATION LINE # ;** FIX **
02110 MOVE T1,HIGH1 ;GET FOUND LINE # ;** FIX **
02120 CAMGE SINDEX,T1 ;TEST FOR DESTINATION EARLIER ;** FIX **
02130 PUSHJ P,FIND ; YES, THEN REPOSITION THERE ;** FIX **
02140 SKIPG T3,NLIN1 ;CHECK FOR P/M ONLY ;** FIX **
02200 JRST INSL2 ;ALL SET FIRST THING IS P/M
02300 ;*FIX* MOVE T1,HIGH1 ;RETRIEVE WHAT WE FOUND
02400 MOVE T2,DESTLN ;WHAT HE WANTED
02500 TLO T3,(1B0) ;DON'T LOOK AT NEXT LINE
02510 IFN %SS031, <
02520 SETOM TRMFLG ;SET TO GET RAW COMPUTED INCR
02530 >; END OF IFN %SS031
02600 PUSHJ P,GETDIF
02700 JRST ORDCP2 ;ORDER PROBLEM WILL FOLLOW
02790 IFE %SS031, <
02800 MOVEM T1,CLN ;SET UP GOOD THINGS
02900 MOVEM T1,SVLNUM
03000 CAML T2,FINCR ;WHICH IS BETTER
03100 JRST INSL2 ;HIS
03200 MOVEM T2,FINCR ;OURS
03300 JRST ONST1 ;TELL HIM WE CHANGED HIS MIND
03400 >; END OF IFE %SS031
03500 IFN %SS031, <
03600 JRST ONSET1 ;JUMP FOR COMMON ANALYSIS
03700
03800 ACTINC: MOVE T1,BINCR ;GET BINARY RAW INCREMENT
03900 PUSHJ P,TRIMNR ;CALL TO GET ROUNDED INCREMENT
04000 SKIPE T1 ;SKIP IF IMPOSSIBLE INCREMENT (TAKE DEFAULT)
04100 PUSHJ P,ASCON ;CONVERT INCREMENT TO ASCII
04200 MOVE T2,T3 ; & COPY INTO RIGHT AC
04300 CAMLE T2,INCR ;TEST FOR .LE. CURRENT INCR
04400 MOVE T2,INCR ; NO, GET DEFAULT INCR
04500 POPJ P, ;RETURN NOW
04600 >; END OF IFN %SS031
00100 ONSET: SKIPG T3,NLIN2 ;GO ANYTHING TO WORRY ABT
00200 JRST INSL2 ;NO -- DO OUR WORST
00300 MOVE T2,DESTLN ;HIS DESIRED PLACE
00310 IFN %SS031, <
00320 MOVEM T1,HIGH1 ;STORE AS 1ST LINE #
00330 MOVEM T3,NLIN1 ;STORE COUNT FOR LATER
00340 SETOM TRMFLG ;SET FLAG FOR RAW COMPUTED INCR
00350 >; END OF IFN %SS031
00400 PUSHJ P,GETDIF ;SEE WHAT THERE IS TO SEE
00500 JRST ORDCOP ;ORDER PROBS
00510 IFN %SS031, <
00520 ONSET1: ;HERE WITH COMPUTED INCR
00530 >; END OF IFN %SS031
00600 MOVEM T1,SVLNUM ;SET THE GOOD S--T
00700 MOVEM T1,CLN
00790 IFE %SS031, <
00800 CAML T2,FINCR ;THE MOMENT OF TRUTH
00900 JRST INSL2 ;THAT CRAFTY FELLOW
01000 MOVEM T2,FINCR ;TELL HIM HE BLEW IT
01004 >; END OF IFE %SS031
01008 IFN %SS031, <
01012 MOVE T1,NLIN1 ;GET # OF LINES ON THIS PAGE
01016 MOVE T3,DESTLN ;GET DESTINATION LINE #
01020 CAME T3,HIGH1 ;TEST FOR EXISTENCE OF DESTINATION
01024 CAILE T1,1 ;TEST FOR .LE. 1 LINE TO BE INSERTED
01028 SKIPA T3,T2 ;COPY DEFAULT INCR INTO T3 & SKIP
01032 JRST INSL2 ; ELSE JUMP IF ANY INCR WILL DO
01036 CAMGE T3,FINCR ;TEST FOR SPECIFIED INCR TOO BIG
01040 SETZM FINCR ; YES, FORGET IT
01044 SKIPN T2,FINCR ;TEST FOR VALID SPECIFIED INCR
01048 PUSHJ P,ACTINC ; NO, COMPUTE ROUNDED INCREMENT
01052 MOVE T3,T2 ;COPY CHOSEN INCR FOR LATER
01056 MOVE T1,DESTLN ;GET DESTINATION LINE #
01060 CAMN T1,SVLNUM ;TEST FOR COMPUTED 1ST NEW NUMBER
01064 JRST ONSET2 ; NO, JUMP (IT'S OK AS-IS)
01068 PUSHJ P,ASCIAD ;COMPUTE NEW 1ST LINE # AS DEST. + INCR
01072 MOVEM T1,SVLNUM ;STORE NEW LINE #
01076 MOVEM T1,CLN ;STORE AS CURRENT LINE
01080 MOVE T2,T3 ;RESTORE THE CHOSEN INCREMENT
01084 ONSET2: EXCH T3,FINCR ;STORE THE CHOSEN INCR & GET OLD VALUE
01088 JUMPN T3,INSL2 ; OLD VALUE GIVEN, NO MSG NEEDED
01092 >; END OF IFN %SS031
01100 ONST1: MOVEM T2,PRNTO1 ;PUT IN IN PRINT POSITION
01110 IFN %SS031, <
01120 ONST4: ;HERE WITH MESSAGE SET UP
01130 >; END OF IFN %SS031
01200 OUTSTR ASCZ1
01300 JRST INSL2 ;HE HAS BEEN TOLD
01400
01500 ORDCP2: SKIPA T2,[ASCII /WAR /]
01600 ORDCOP: MOVE T2,[ASCII /ORDER/]
01690 IFE %SS031, <
01700 JRST ONST1
01705 >; END OF IFE %SS031
01710 IFN %SS031, <
01715 MOVEM T2,PRNTO1 ;STORE THE MESSAGE
01720 MOVE T1,DESTLN ;GET THE DESTINATION LINE #
01725 SKIPN T2,FINCR ;GET THE INCREMENT & TEST IT
01730 MOVE T2,[<ASCII /00001/>!1] ; NULL, SET TO SMALLEST INCREMENT
01735 MOVEM T2,FINCR ;STORE INCREMENT IF DEFAULTING
01740 CAMN T1,HIGH1 ;TEST FOR DESTINATION EXISTING
01745 PUSHJ P,ASCIAD ; YES, INCREMENT ONCE
01750 MOVEM T1,SVLNUM ;STORE AS STARTING LINE #
01755 MOVEM T1,CLN ;STORE AS CURRENT LINE #
01760 JRST ONST4 ;GO GIVE THE MESSAGE
01765 >; END OF IFN %SS031
01800
01900 ORDSEC: MOVE T2,[ASCII /ORDER/]
02000 JRST ONST2
02100
02200 ;CONVERT INTEGER IN T1 TO SEQ # IN T3
02300
02400 ASCON: MOVSI T3,400000 ;WILL BECOME LOW ORDER BIT
02500 ASCO2: IDIVI T1,^D10
02600 ADDI T2,"0"
02700 LSHC T2,-7
02800 TRNN T3,1 ;HAS IT GOTTEN THERE?
02900 JRST ASCO2
03000 POPJ P,
03100
03200 ;CONVERT SEQ # IN T3 TO INTEGER IN T1
03300
03400 NUMCON: MOVEI T1,0
03500 TRZ T3,1 ;GET RID OF LOW ORDER BIT
03600 NUMC1: JUMPE T3,CPOPJ ;DONE IF ZERO (POSSIBLE 0'D WD) ;** FIX **
03650 MOVEI T2,0
03700 LSHC T2,7
03800 IMULI T1,^D10
03900 ADDI T1,-"0"(T2)
03950 JRST NUMC1 ;REPEAT ;** FIX **
04000 ;*FIX* JUMPN T3,NUMC1 ;** FIX **
04100 ;*FIX* POPJ P, ;** FIX **
04200
04300 IFN %SS047, <
04400 CHKBAS: SKIPE BASICF ;TEST FOR /BASIC
04500 TRNE FL,EXTOG ;TEST FOR /EXPERT
04600 POPJ P, ; RETURN IF NOT /BASIC OR IF EXPERT
04700 OUTSTR [ASCIZ /Destroy numbering in BASIC file? /] ;TELL THE USER
04800 PUSHJ P,CONFRM ;ASK FOR CONFIRMATION
04900 JRST COMND ; NO, FORGET IT
05000 POPJ P, ; YES, CONTINUE
05100 >; END OF IFN %SS047
00100 INSLN: MOVE T2,FINCR ;GENERATE NEW SEQUENCE NUMBER
00200 SKIPN T1,SVLNUM ;BUT ONLY IF WE ARE SUPPOSED TO
00300 JRST INSL2
00400 PUSHJ P,ASCIAD
00500 MOVEM T1,SVLNUM ;PUT EITHER NGW OR 0 BACK
00600 INSL2: SETZM LIBUF ;ZERO OUT PLACE TO PUT LINE
00700 MOVE T1,[XWD LIBUF,LIBUF+1]
00800 BLT T1,LIBUF+MXWPL+1
00900 MOVEI T1,LIBUF ;SET UP OUTPUT POINTER
01000 SKIPN T2,1(ALTP) ;AT END?
01100 JRST INSDON ;FINISHED
01200 INS1: MOVEM T2,(T1) ;PUT IT AWAY
01300 ADDI ALTP,1 ;NEXT
01400 SKIPN T2,1(ALTP) ;CHECK FOR END OF LING
01500 JRST INS2
01600 TRNN T2,1 ;BY EITHER METHOD
01700 AOJA T1,INS1 ;GO ON WITH TRANSFER
01800 INS2: SUBI T1,LIBUF-1 ;GET COUNT
01900 MOVEM T1,NCNT ;AND SET AS NEW
02000 SETZM OCNT ;OLD IS ZERO
02100 MOVE T1,LIBUF ;GET SEQ NUM
02200 CAMN T1,PGMK ;CHECK FOR PAGE
02300 JRST INSPG ;AND DO SPECIAL
02400 SKIPN T1,SVLNUM ;IF A NON-ZERO NUMBER THEN REPLACE
02500 MOVE T1,LIBUF
02600 MOVEM T1,LIBUF
02700 NOINCR: MOVEM T1,CLN ;SET AS CURRENV LINE
02800 PUSHJ P,INSED ;INSERT IT
02890 IFE %SS035, <
02900 PUSHJ P,FINDN ;GET NEXT
03000 PUSHJ P,FILLB ;AND DUMP IF NEEDED
03010 >; END OF IFE %SS035
03020 IFN %SS035, <
03030 PUSHJ P,FINDZ ;POINT AT NEXT LINE, BUT DON'T READ
03040 PUSHJ P,FILLBX ;DUMP IF NEEDED
03050 >; END OF IFN %SS035
03100 JRST INSLN ;GO PUT IN MORE
03200
03300 INSPG: AOS T3,CPG ;WE ARE ON THE NEXT PAGE
03400 MOVEM T3,CPGL ;SET AS CURRENV
03500 MOVE T1,[<ASCII /00000/>!1] ;SET TO SAY LINE 0
03600 AOS BGPG ;ONE MORE PAGE IN FILE
03700 AOS INPG
03800 SETZM SVLNUM ;DO NOT DO ANY MORE SEQUENCE REPLACEMENT
03900 MOVEI T2,-2(ALTP) ;SINCE WE HAVE ALREADY GONE PAST
04000 CAMN T2,LSTPG ;UNLESS STARTING LAST PAGE
04100 SKIPN T3,SINCR ;ANF SECOND SEQUENCE NUMBER GIVEN
04200 JRST NOINCR
04300 MOVEM T3,FINCR ;SET UP INCREMENT
04400 MOVE T3,START2 ;GET LAST PAGE START
04500 MOVEM T3,SVLNUM
04600 MOVEM T1,CLN
04700 PUSHJ P,INSED ;INSERT IT
04790 IFE %SS035, <
04800 PUSHJ P,FINDN ;TO NEXT
04900 PUSHJ P,FILLB ;SLURP
04910 >; END OF IFE %SS035
04920 IFN %SS035, <
04930 PUSHJ P,FINDZ ;POINT AT NEXT LINE, BUT DON'T READ
04940 PUSHJ P,FILLBX ;DUMP IF NEEDED
04950 >; END OF IFN %SS035
05000 JRST INSL2 ;GO DO IT
00100 INSDON:
00200 COPDON: RELEASE ALTDV,0 ;JUST FOR GOOD MEASURE
00300 TLZE FL,COPFIL ;ARE WE COPYING FROM A FILE (ERRORS ONLY)
00400 PUSHJ P,RSCOP ;YES, CLEAN UP POINTERS
00500 TLZ FL,ISCOP ;RESET COPY FLAG
00600 TLNN FL,TRANFL ;IF TRANSFER, WE MUST REINSERT
00700 JRST COPD1 ;NO
00800 MOVE ALTP,STARTD
00900 REINXT: MOVEI T1,LIBUF
01000 CAMN ALTP,ENDD
01100 JRST COPD1 ;ALL DONE
01200 MOVE T2,1(ALTP)
01300 JRST REINWD
01400 REINS: MOVE T2,1(ALTP)
01500 CAME ALTP,ENDD
01600 TRNE T2,1
01700 JRST ENDLIN ;DONE WITH THIS LINE
01800 REINWD: MOVEM T2,(T1)
01900 ADDI T1,1
02000 AOJA ALTP,REINS
02100 ENDLIN: SETZM OCNT
02200 SUBI T1,LIBUF
02300 MOVEM T1,NCNT
02400 PUSHJ P,INSED ;INSERT LINE
02490 IFE %SS035, <
02500 PUSHJ P,FINDN
02600 PUSHJ P,FILLB ;IN CASE OF OVERFLOW
02610 >; END OF IFE %SS035
02620 IFN %SS035, <
02630 PUSHJ P,FINDZ ;POINT AT NEXT LINE, BUT DON'T READ
02640 PUSHJ P,FILLBX ;DUMP IF NEEDED
02650 >; END OF IFN %SS035
02700 JRST REINXT
02800 COPD1: ;HERE AT END OF COPY OPERATION
02810 IFN %SS035, <
02820 MOVE T1,CORTOP ;GET END OF TEXT BUFFER
02830 SUBI T1,2*MXWPL+2 ;LEAVE SPACE FOR TWO LINES
02840 MOVEM T1,FILPT ;RESET LAST LOC'N TO FILL
02850 PUSHJ P,FILLBF ;NOW REFILL THE BUFFER
02860 >; END OF IFN %SS035
02870 SKIPN T1,SVJRL2 ;USE THIS IF SET
02900 MOVE T1,SVJRL ;ELSE THIS
03000 CORE T1, ;TO RESTORE PROPER AMOUNT OF CORE
03100 ERROR ICN ;THIS SHOULD NEVER HAPPEN
03200 JRST COMND ;FINISH UP
03300
03400 IFN %SS035, <
03500 FILLBX: MOVE T1,WC ;GET CURRENT BUFFER CONTENTS
03600 CAMGE T1,MAXWC ;TEST FOR DUMPING NEEDED
03700 POPJ P, ; NO, RETURN TO CALLER
03800 MOVE T1,ENDD ;GET END OF COPY TEXT
03900 SUB T1,ALTP ; MINUS CURRENT TEXT POINTER
04000 SKIPG T1 ;SKIP IF SOMETHING ELSE TO COPY
04100 MOVEI T1,1 ; ELSE SET TO 1 WORD
04200 CAMLE T1,WC ;TEST FOR MORE LEFT THAN IN BUFFER
04300 MOVE T1,WC ; YES, DUMP ENTIRE BUFFER
04400 ADD T1,BUFP ;POINT AT ENDING ADDRESS TO DUMP
04500 CAMLE T1,PNTR ;TEST FOR DUMPING TOO MUCH
04600 MOVE T1,PNTR ; YES, DON'T DUMP PAST LINE CURRENTLY POINTED TO
04700 JRST GETN1 ;DUMP THE BUFFER & RETURN
04800 >; END OF IFN %SS035
00100 ALTFIL: TLZE FL,TRANFL ;GIVE WARNING IF TRANSFER
00200 OUTSTR [ASCIZ /% WARNING - Copy assumed
00300 /]
00400 PUSHJ P,SCAN
00410 IFN %SS030, <
00420 CAIE C,"," ;TEST FOR COMMA
00430 CAIN C,"/" ;TEST FOR SLASH
00440 JRST ALTDFT ; EITHER, JUMP FOR DEFAULTED FILE NAME
00450 >; END OF IFN %SS030
00500 PUSHJ P,READNM
00600 NERROR ILC
00700 MOVE T1,[TMPBLK,,ALTBLK]
00800 BLT T1,ALTBKE ;SAVE IN CORRECT PLACE
00900 DONNAM: MOVE T1,.JBREL## ;SET THINGS UP
01000 MOVEM T1,SVJRL2
01100 ADDI T1,4000 ;ASK FOR 1 K FOR BUFFERS
01200 TLO FL,ISCOP ;TELL THE WORLD WHAT WE HAVE DONE
01300 CORE T1, ;IS IT THERE?
01400 NERROR NEC
01500 MOVE T1,SVJRL2 ;POINT BUFFERS TO RIGHT PLACE
01600 MOVEM T1,.JBFF##
01700 MOVE T1,ALTDEV ;GET DEVICE
01800 MOVEM T1,ALDEVI+1
01900 OPEN ALTDV,ALDEVI ;DO OPEN
02000 NERROR DNA ;MAYBE ITS HEREDITARY
02100 XLOOK ALTDV,ALTBLK ;LOOK FOR FILE
02200 NERROR FNF
02300 INBUF ALTDV,0 ;GET BUFFER SPACE
02400 PUSH P,SAVEN ;TURN OFF AUTO-SAVE
02500 SETZM SAVEN
00100 MOVE T1,.JBREL##
00200 SUBI T1,2*MXWPL+2 ;SET UP THE VARIOUS POINTERS
00300 PUSH P,FILPT ;SEE STPT FOR MORE INFO
00400 MOVEM T1,FILPT
00500 MOVEI T1,1
00600 PUSH P,CPGL
00700 MOVEM T1,CPGL
00800 MOVE T1,[<ASCII /00000/>!1]
00900 PUSH P,CLN
01000 MOVEM T1,CLN
01100 MOVE T1,.JBFF##
01200 SETZM (T1)
01300 ADDI T1,1
01400 PUSH P,BUFP
01500 MOVEM T1,BUFP
01600 MOVE T1,.JBREL##
01700 SUB T1,BUFP
01800 MOVE T2,T1
01900 SUBI T2,MXWPL+1
02000 PUSH P,MAXWC
02100 MOVEM T2,MAXWC
02200 ASH T1,-1
02300 PUSH P,HLFWC
02400 MOVEM T1,HLFWC
02500 MOVEI T1,1
02600 PUSH P,CPG
02700 PUSH P,INPG
02800 MOVEM T1,CPG
02900 MOVEM T1,INPG
03000 PUSH P,PNTR
03100 MOVE PNTR,BUFP
03200 PUSH P,SVWD
03300 SETZM SVWD
03400 PUSH P,OLDLIN
03500 SETZM OLDLIN
03600 PUSH P,WC
03700 SETZM WC
03800 MOVSI T1,1
03900 PUSH P,BGPG
04000 MOVEM T1,BGPG
04100 PUSH P,BASICF
04200 SETZM BASICF
04300 SKIPE RSW
04400 JRST [SETZM RSW
04500 SETOM SSW ;SET BROWSE MODE ALSO
04600 SETOM BASICF
04700 JRST .+1]
04800 MOVE T1,FL ;SAVE SELECTED FLAGS
04900 AND T1,[XWD TECOF+FSTOPF,READOF!BOF!EOF!EOF2!BGSN]
05000 PUSH P,T1
05100 TRZ FL,EOF!EOF2!IFN %SS030,<BGSN> ;CLEAR FLAG THAT OUGHT'N BE ON
05200 TRO FL,READOF!BOF
05300 TLZ FL,TECOF
05400 TLO FL,FSTOPF
05500 MOVEM P,COPDL ;SAVE PDL FOR LATER
05600 TLO FL,COPFIL ;WE ARE USING OTHER FILE POINTERS
05700 PUSHJ P,FILLBF
05800 SKIPN SSW
05900 JRST COPY1
00100 TRNN FL,TERMF ;MUST END HERE
00200 NERROR ILC
00300 TLO FL,SRCOP ;SET THINGS UP
00400 JRST COMND ;AND GO GET COMMANDS
00500
00600 DSCOP: PUSHJ P,GNCH ;GET NEXT CHAR
00700 ANDI C,137 ;FORCE UPPER
00800 CAIN C,"Q" ;CHECK FOR SPECIAL
00900 JRST NOCOP ;YES - DO NOTHING
01000 MOVEM C,SAVC ;BACK UP SCANNER
01100 PUSHJ P,SCAN
01200 TRNN FL,TERMF
01300 NERROR ILC
01400 OUTSTR [ASCIZ /Source lines=/]
01500 SETZM LOLN ;THIS MAY HAVE GOTTEN RESET
01600 SETZM SAVCHR ;CLEAR THINGS OUT
01700 SETZM SSW ;FORGET THIS SWITCH
01800 PUSHJ P,COPYP ;GET SOURCE LINES
01900 TLZ FL,SRCOP ;TURN OFF FLAG
02000 JRST COPY2 ;CONTINUE
02100
02200 COPYP: PUSHJ P,GET2S ;GO GET PLACE TO FIND LINES
02290 IFE %SS031, <
02300 MOVE T1,INCR ;SEV INCREMENT AS CURRENT
02400 MOVEM T1,FINCR
02410 >; END OF IFE %SS031
02420 IFN %SS031, <
02430 SETZM FINCR ;ZERO THE INCRMENT
02440 >; END OF IFN %SS031
02500 SETZM SINCR ;SET NO SECOND INCREMENT
02600 CAIE C,"," ;CHECK FOR MORE ARGUMENTS
02610 IFN %SS014, <
02620 CAIN C,";" ;TEST FOR A SEMI-COLON, TOO
02630 SKIPA ; SKIP IF EITHER COMMA OR SEMI-COLON
02640 >; END OF IFN %SS014
02700 JRST COPYP1 ;NO, LOOK FOR TERMINATOR
02800 PUSHJ P,SCAN
02900 CAME T1,[<ASCII /00000/>!1] ;AVOID 0 INCREMENTS
03000 TRNN FL,NUMF ;SHOULD BE INCREMENT, MUST BE NUMBER
03100 NERROR ILC
03200 MOVEM T1,FINCR
03300 PUSHJ P,SCAN
03400 CAIE C,","
03420 IFN %SS014, <
03430 CAIN C,";" ;TEST FOR A SEMI-COLON, TOO
03440 SKIPA ; SKIP IF EITHER COMMA OR SEMI-COLON
03450 >; END OF IFN %SS014
03500 JRST COPYP1
03600 PUSHJ P,SCAN
03700 CAME T1,[<ASCII /00000/>!1]
03800 TRNN FL,NUMF
03900 NERROR ILC
04000 MOVEM T1,SINCR
04100 PUSHJ P,SCAN
04200 COPYP1: TRNN FL,TERMF
04300 NERROR ILC ;DID NOT END PROPERLY, LOSE
04400 POPJ P, ;RETURN
04500
04600 NOCOP: PUSHJ P,SCAN ;CHECK EOL
04700 TRNN FL,TERMF
04800 NERROR ILC
04900 TLZ FL,SRCOP ;TURN OFF COPY
05000 JRST COPDON
05100
05200 IFN %SS030, <
05300
05400 ; CODE TO DEFAULT THE COPY FILE-NAME
05500
05600 ALTDFT: SKIPN ALTNAM ;TEST FOR PREVIOUS FILE SPEC
05700 NERROR ILC ; NO, ERROR
05800 SETZM SSW ;CLEAR FLAGS
05900 SETZM RSW ; DITTO
06000 CAIE C,"/" ;TEST FOR SLASH COMING
06100 JRST ALTDF1 ; NO, JUMP
06200 PUSHJ P,RDSWT ;READ THE SWITCHES
06300 NERROR ILC ; ERROR, TELL SOMEBODY
06400 ALTDF1: OUTSTR [ASCIZ /Copy: /] ;TELL WHAT FILE
06500 MOVEI T4,ALTBLK ;POINT AT FILE SPEC
06600 PUSHJ P,GVNAM0 ; & TYPE IT
06700 OCRLF ;END THE LINE
06800 MOVEI C,"," ;SUPPLY THE NEXT DELIMITER (IGNORED IF /S SET)
06900 JRST DONNAM ; & CONTINUE ON
07000 >; END OF IFN %SS030
00100 RSCOP: POP P,T2
00200 MOVE P,COPDL ;GET PDL BACK
00300 POP P,T1
00400 TRZ FL,READOF!BOF!EOF!EOF2!BGSN ;RESTORE SELECTED FLAGS
00500 TLZ FL,TECOF!FSTOPF
00600 IOR FL,T1
00700 POP P,BASICF
00800 POP P,BGPG
00900 POP P,WC
01000 POP P,OLDLIN
01100 POP P,SVWD
01200 POP P,PNTR
01300 POP P,INPG
01400 POP P,CPG
01500 POP P,HLFWC
01600 POP P,MAXWC
01700 POP P,BUFP
01800 POP P,CLN
01900 POP P,CPGL
02000 POP P,FILPT
02100 POP P,SAVEN ;RESTORE AUTO-SAVE
02200 JRST (T2) ;NOW RETURN
02300
02400 COPGET: SOSG ALTBF+2 ;GET A WORD FROM COPY FILE
02500 JRST GETDCT
02600 GETWCT: ILDB T3,ALTBF+1
02700 JUMPE T3,COPGET
02800 POPJ P,
02900 GETDCT: INPUT ALTDV,0
03000 STATO ALTDV,760000
03100 JRST GETWCT
03200 STATZ ALTDV,740000
03300 ERROR DIE
03400 TRO FL,EOF
03500 MOVEI T3,0
03600 POPJ P,
03700
03800
03900 CKTEC2: SETSTS ALTDV,1
04000 MOVSI T3,(<POINT 7,0>)
04100 HLLM T3,ALTBF+1
04200 MOVEI T3,5
04300 IMULM T3,ALTBF+2
04400 AOS ALTBF+2
04500 JRST RDTECO
04600
04700
04800 SUBTTL SUBSTITUTE COMMAND (REPLACES THINGS)
00100
00200 ;ALSO KNOWN AS SUBSTITUTE
00300 SUBST: TLZ FL,ASSMF ;DO NOT ASSUME ANYTHING YET
00390 IFE %SS074, <
00400 TRNE FL,READOF
00500 NERROR ILC
00510 >; END OF IFE %SS074
00600 SETZM LOLN ;A GOOD THING
00700 SETZM PARCNT ;ZERO COUNT FOR SEQUENTIAL PARTIALS
00800 HRLOI T1,377777 ;SET FOR LOTS
00900 MOVEM T1,RPCNT
01000 MOVE T1,[POINT 7,R1BUF]
01100 MOVEI T3,R1PNT
01200 PUSHJ P,SSTRNG ;THIS CODE IS JUST LIKE SEARCH
01290 IFE %SS043*DEFCRL, <
01300 JRST [SKIPE R2PNT ;BOTH STRINGS MUST HAVE BEEN GIVEN
01400 SKIPN R1PNT
01500 NERROR NSG ;ELSE THERE HAS BEEN AN ERROR
01600 CAIN C,12 ;CHECK FOR JUST A CRRET
01700 JRST ASBMD1 ;AND DO A CONTINUE
01800 JRST NOSTR] ;THERE IS NO STRING
01805 >; END OF IFE %SS043*DEFCRL
01810 IFN %SS043*DEFCRL, <
01815 JRST [ ; NO STRINGS, JUMP
01820 SKIPE R2PNT ;TEST FOR PRIOR STRINGS
01825 SKIPN R1PNT ;TEST FOR PRIOR STRINGS
01830 NERROR NSG ; NO, ERROR
01835 TLO FL,ASSMF ;SET "ASSUME .+1" FLAG
01840 CAIE C,12 ;TEST FOR "S<CR>" COMMAND
01845 JRST NOSTR ; NO, JUMP (WAS "S<ALTMODE>...")
01850 MOVEI T1,1 ;GET A ONE
01855 MOVEM T1,RPCNT ;SET REPEAT COUNT FOR "S<CR>"
01860 JRST ASBMD1 ; & GO DEFAULT THE RANGE
01865 ]
01870 >; END OF IFN %SS043*DEFCRL
01900 MOVE T1,[POINT 7,R2BUF] ;GET STRING TO REPLACE BY
02000 MOVEI T3,R2PNT
02100 PUSHJ P,SSTRNG
02200 JRST [CAIN C,12
02300 JRST [PUSH P,[.] ;SET UP RETURN
02400 JRST RETSTR] ;AND READ MORE (FISRT NULL)
02500 MOVEM T1,R2PNT ;NULL STRING MEANS DELETE
02600 MOVEI T2,0 ;SO SET A REAL NULL STRING
02700 IDPB T2,T1
02800 JRST .+1]
02900 SUBI T3,R2PNT ;GENERATE NUMBER OF REPLACEMENT STRINGS
03000 MOVEM T3,RSTRCT ;AND SAVE FOR LATER
03100 NOSTR: TLZ FL,NOPRN!DECID!EXCTS1 ;CLEAR FLAGS
03110 IFN %SS040, <
03120 SKIPE EXACTF ;TEST FOR /EXACT
03130 TLO FL,EXCTS1 ; YES, SET THE BIT
03140 >; END OF IFN %SS040
03200 PUSHJ P,SCAN ;AND START LOOKING FOR MORE JUNK
03300 TRNN FL,TERMF ;NOTHING
03400 CAIN C,"," ;OR JUST A COMMA
03500 JRST ASBMDT ;THEN SEARCH FROM HERE TO ETERNITY
03600 CAIE C,"!" ;HE ONLY WANTS TO GIVE A STOPPING POINT
03700 CAIN C,":"
03800 JRST ASBMDT
03810 IFN %SS043*DEFCRL, <
03820 TLZ FL,ASSMF ;CLEAR "ASSUME .+1" BIT WHEN RANGE READ
03830 >; END OF IFN %SS043*DEFCRL
03900 PUSHJ P,GET2 ;GO GET A RANGE
04000 REP4: MOVE T1,HILN ;SAVE FOR POSSIBLE CONTINUE
04100 MOVEM T1,RPHILN
04200 MOVE T1,HIPG
04300 MOVEM T1,RPHIPG
04390 IFE %SS042, <
04400 CAIE C,"," ;IS THERE MORE?
04500 JRST REP1 ;NO
04600 PUSHJ P,SCAN ;SEE WHAT IT IS
04700 TRNN FL,IDF ;POSSIBLY AN IDENT
04800 JRST REP2 ;NO MAYBE A NUMBER OF TIMES
04900 MOVS T1,ACCUM
05000 CAIN T1,(<SIXBIT /N />)
05100 TLO FL,NOPRN ;SET FOR NO PRINTING
05200 CAIN T1,(<SIXBIT /D />)
05300 TLO FL,DECID ;HE WANTS TO BE ABLE TO DECIDE
05400 TLNN FL,DECID!NOPRN ;IF NEITHER
05500 JRST REP3 ;THEN TRY FOR E SWITCH
05600 PUSHJ P,SCAN ;SEE IF THERE IS MORE
05700 CAIE C,","
05800 JRST REP1 ;END OF LINE
00100 PUSHJ P,SCAN ;LOOK FOR STILL MORE
00200 TRNN FL,IDF
00300 JRST REP2
00400 MOVS T1,ACCUM
00500 REP3: CAIE T1,(<SIXBIT /E />) ;IS IT THE EXACT SEARCH SWITCH
00600 NERROR ILC ;NO,LOSAGE
00690 IFE %SS040, <
00700 TLO FL,EXCTS1
00710 >; END OF IFE %SS040
00720 IFN %SS040, <
00730 TLC FL,EXCTS1 ;INVERT THE BIT
00740 >; END OF IFN %SS040
00800 PUSHJ P,SCAN ;ONE LAST TRY
00900 CAIE C,","
01000 JRST REP1 ;GO CHECK TERMINATOR
01100 PUSHJ P,SCAN ;ONLY ONE THING LEFT
01200 REP2: TRNN FL,NUMF
01300 NERROR ILC ;BUT IT WAS NOT
01400 MOVEM T2,RPCNT ;SAVE IT AWAY
01500 PUSHJ P,SCAN
01505 >; END OF IFE %SS042
01510 IFN %SS042, <
01515 MOVE SINDEX,[RPCNT,,[SIXBIT /N/
01520 TLO FL,NOPRN
01525 SIXBIT /D/
01530 TLO FL,DECID
01535 SIXBIT /E/
01540 TLC FL,EXCTS1
01545 EXP 0]]
01550 PUSHJ P,SCNMOD ;SCAN THE MODIFIERS
01555 >; END OF IFN %SS042
01600 REP1: TRNN FL,TERMF ;ALLS WELL THAT ENDS WELL
01700 NERROR ILC ;BUT NOT THIS ONE
01800 REP1A: ;HERE TO EXECUTE THE SUBSTITUTE
01810 IFN %SS040, <
01820 TRZ FL2,DOEXCT ;ASSUME NON-EXACT
01830 TLNE FL,EXCTS1 ;TEST FOR EXACT
01840 TRO FL2,DOEXCT ; YES, SET THE BIT
01850 >; END OF IFN %SS040
01860 MOVEI T1,R1PNT ;GET THE SEARCH CODE
01900 PUSHJ P,CODSR
02000 MOVE T1,LOPG
02100 MOVEM T1,DPG
02200 MOVEM T1,RPPG ;FOR PRINT OUTS
02300 MOVE SINDEX,LOLN
02400 PUSHJ P,FIND ;GET THAT LINE
02500 TRZ FL,LINSN ;NOTHING YET
02600 SETZM FNDFLG ;NO HOW
02700 TLNE FL2,PDECID
02790 IFE %SS041, <
02800 TLO FL,DECID ;SET IF PERM MODE ON
02810 >; END OF IFE %SS041
02820 IFN %SS041, <
02830 TLC FL,DECID ;INVERT THE DECIDE SWITCH IF /DECIDE
02840 >; END OF IFN %SS041
02900 ONREP: PUSHJ P,ONMOV ;CHECK FOR STILL IN RANGE
03000 JRST ENDREP ;FINALLY
03100 TLZE FL,ASSMF ;SHOULD WE START WITH .+1
03200 JRST [CAME T1,LOLN ;IS IT THE ONE WE ASKED FOR
03300 JRST .+1 ;NO, USE IT
03400 AOS SVCNT ;JUST IN CASE A ! TYPE OF RANGE
03500 JRST RPNXT]
03600 TRO FL,LINSN ;THIS LINE IS GOOD ENOUGH
03700 CAMN T1,PGMK
03800 JRST RPPAG ;GO TAKE CARE OF PAGE MARKS
03900 MOVEI T2,R1PNT ;DO THE SEARCH
04000 PUSHJ P,COMSRC
04100 JRST RPNXT
04200 SETOM FNDFLG ;FOUND
04300 SKIPGE T3 ;PROTECT AGAINS SPECIAL KILLING TAB
04400 IBP ALTP
04500 PUSH P,T3 ;SAVE COUNT OF HOW FAR INTO LINE
04600 MOVE T3,(PNTR) ;SET UP CURRENT LINE
04700 MOVEM T3,CLN
04800 MOVE T3,CPG
04900 MOVEM T3,CPGL
05000 MOVE T2,[XWD LIBUF,LIBUF+1] ;CLEAR IT OUT
05100 SETZM LIBUF
05200 BLT T2,LIBUF+MXWPL+1 ;WE WILL DO REPLACE HERE
00100 MOVE T2,PNTR ;GET THE POINTER TO THE LINE
00200 MOVE T3,(T2) ;PICK UP THE FIRST WORD
00300 MOVEI T4,LIBUF ;THE PLACE TO PUT IT
00400 JRST SBALT3 ;TRANSFER
00500 SBALT2: SKIPE T3,(T2)
00600 TRNE T3,1 ;IS IT THE END OF THE LINE
00700 JRST SBALT1
00800 SBALT3: MOVEM T3,(T4) ;PUT IT AWAY
00900 ADDI T4,1
01000 AOJA T2,SBALT2
01100
01200 SBALT1: SUBI T4,LIBUF ;GET SIZE LINE USED TO BE
01300 MOVEM T4,OCNT
01400 POP P,CCNT ;GET THE NUMBER OF CHRS INTO LINE
01500 SKIPGE CCNT ;MUST BE .GE. 0
01600 SETZM CCNT
01700 SUBI ALTP,(PNTR) ;CONVERT POINTER TO LIBUF
01800 ADD ALTP,[XWD 70000,LIBUF] ;AND BACK UP ONE
01900 NXTRPL: SETZM PARCNT ;ZERO FOR NEXT REP
02000 LDB T1,[POINT 4,-1(T1),12] ;GET STRING NUMBER
02100 CAMLE T1,RSTRCT ;IS IT LARGER
02200 MOVE T1,RSTRCT ;THEN USE LAST
02300 MOVE T1,R2PNT(T1)
02400 MOVSI T4,70000 ;DECREMENT POINTER
02500 ADDM T4,SRCALP
02600 REPSTR: ILDB C,T1 ;GET THE NEXT CHR
02700 JUMPE C,ENDRP ;THE END OF THE REPLACE STRING
02710 IFN %SS044, <
02720 CAIN C,.PTQOT ;TEST FOR QUOTED CHAR
02730 JRST INSQT ; YES, JUMP
02740 >; END OF IFN %SS044
02800 CAIN C,.PTDLM ;DOES HE WANT ONE OF THE PARTIAL THINGS
02900 JRST PARSTR ;YES, GO HANDLE THAT
02990 IFE %SS044, <
03000 CAIN C,.PTQOT ;CHECK FOR QUOTING NEXT CHR
03100 JRST INSQT
03110 >; END OF IFE %SS044
03200 CAIN C,.PTNXS ;SEQUENTIAL PARTIAL
03300 JRST PARORD ;YES, GO HANDLE
03400 PUTSTR: IDPB C,ALTP ;PUT IN THE REPLACEMENT
03500 AOS C,CCNT ;ADVANCE COUNT
03600 CAIL C,MXWPL*5 ;CHECK AGAINST MAX
03700 NERROR LTL ;AND LOSE
03800 JRST REPSTR
03900 ENDRP: MOVE T3,CCNT ;GET COUNT SO SEARCH CAN GO ON
04000 PUSH P,ALTP ;SAVE REPLACE POINTER
04100 PUSH P,SRCALP ;AND THE END OF INPUT POINTER
04200 MOVE ALTP,SRCALP ;CONTINUE FROM HERE
04300 ILDB T1,SRCALP ;SEE WHAT CHAR WE STOPPED ON
04400 CAIE T1,12 ;HAVE WE GONE TOO FAR?
04500 PUSHJ P,COMSRT ;THIS WILL CONTINUE
04600 JRST FINLIN ;ALL DONE WITH MATCHES, FINISH UP
04700 CAIL T3,MXWPL*5 ;ARE THERE TOO MANY?
04800 NERROR LTL
04900 POP P,T2
05000 DOMOV: ILDB C,T2 ;MOVE THE CHRS THAT DID NOT MATCH
05100 CAMN T2,ALTP ;HAVE WE GOTTEN TO THE NEXT MATCH
05200 JRST DONMOV ;YES
05300 IDPB C,(P) ;THE BYTE POINTER IS STILL IN THE STACK
05400 JRST DOMOV
05500 DONMOV: MOVEM T3,CCNT ;PUT THE COUNT BACK IN CORE
05600 POP P,ALTP ;THIS IS NOW THE DEPOSIT POINTER
05700 JRST NXTRPL ;GO DO A REPLACE
00100 FINLIN: POP P,SRCALP ;GET SET TO MOVE TO END
00200 POP P,ALTP
00300 ILDB C,2(P) ;WE JUST HAPPEN TO KNOW ITS STILL THERE
00400 CAIE C,12 ;IF SO WE HAVE EATEN A RETURN
00500 JRST ENDFIN ;ALL IS OK
00600 FINL2: MOVEI C,15
00700 SKIPA ;SO PUT IT IN
00800 ENDFIN: ILDB C,SRCALP
00900 IDPB C,ALTP
01000 AOS CS,CCNT
01100 CAIL CS,MXWPL*5
01200 NERROR LTL
01300 CAIE C,12
01400 JRST ENDFIN ;DONE WHEN WE SEE THE LINE FEED
01500 MOVEI T1,0 ;ZERO OUT REST OF THIS LINE
01600 DOZER: TLNN ALTP,760000 ;POINTER AT END OF LINE?
01700 JRST ZEROD
01800 IDPB T1,ALTP
01900 JRST DOZER
02000 ZEROD: SUBI ALTP,LIBUF ;MOVEI AC,1-LIBUF(AC)
02100 MOVEI ALTP,1(ALTP) ;GET COUNT
02200 MOVEM ALTP,NCNT
02300 TLNE FL,NOPRN ;DID HE WANT PRINTING SUPRESSED
02310 IFN %SS042, <
02320 TLNE FL,DECID ;TEST FOR ,N,D
02330 SKIPA ; YES, ,D OVERRULES, SO PRINT & DECIDE
02340 >; END OF IFN %SS042
02400 JRST NOPLIN
02410 IFN %SS042, <
02420 TLNE FL,DECID ;TEST FOR DECIDE OPTION
02430 PUSHJ P,CLRCTO ; YES, CALL TO CLEAR ^O
02440 >; END OF IFN %SS042
02500 MOVE T2,CPG ;GET CURRENT PAGE
02600 TRNN FL2,NONUMF ;DON'T PRINT IF NONUMBER
02700 CAMN T2,RPPG ;OR PAGES MATCH
02800 SKIPA
02900 PUSHJ P,PGPRN
03000 MOVE T2,CPG
03100 MOVEM T2,RPPG ;SET AS CURRENT PAGE
03200 MOVEI T1,LIBUF ;PRINT THE LINE
03300 PUSHJ P,OUTLIN
03400 TLNN FL,DECID ;DOES HE WANT THE OPTION OF SAYING NO
03500 JRST NOPLIN ;NO, INSERT IT
03510 IFN %SS043, <
03520 OUTSTR [ASCIZ /D*/] ;TYPE THE DECIDE PROMPT
03530 >; END OF IFN %SS043
03600 NOVCMD: INCHRW T1
03700 ANDI T1,177
03790 IFE %SS037, <
03800 OCRLF
03810 >; END OF IFE %SS037
03900 CAIN T1,177 ;DID HE SAY RUBOUT(DO NOT INSERT)?
04000 JRST RPNXT1 ;YES, JUST IGNORE THIS LINE
04100 CAIN T1," " ;SPACE MEANS USE IT
04190 IFE %SS037, <
04200 JRST NOPLIN
04210 >; END OF IFE %SS037
04220 IFN %SS037, <
04230 JRST NOPLN1
04240 >; END OF IFN %SS037
04300 ANDI T1,137 ;FORCE UPPER CASE
04400 CAIE T1,"Q"
04500 CAIN T1,"E" ;DOES HE WANT OUT
04590 IFE %SS037, <
04600 JRST ENDREP ;YES: QUIT
04610 >; END OF IFE %SS037
04620 IFN %SS037, <
04630 JRST ENDRP0 ; YES, QUIT
04640 >; END OF IFN %SS037
04700 CAIN T1,"A"
04800 JRST RPALT
04900 CAIN T1,"G" ;GET OUT OF DECIDE MODE
04990 IFE %SS037, <
05000 JRST [TLZ FL,DECID ;LEAVE DECIDE MODE
05100 JRST NOPLIN]
05110 >; END OF IFE %SS037
05120 IFN %SS037, <
05130 JRST NOPLN0 ; GO LEAVE DECIDE MODE
05140 >; END OF IFN %SS037
05200 OUTSTR [BYTE (7) 77,40,7,0,0]
05300 CLRBFI ;CLEAR HIM OUT
05400 JRST NOVCMD ;TRY AGAIN
05500
05510 IFN %SS037, <
05520 NOPLN0: TLZ FL,DECID ;LEAVE DECIDE MODE FOR NOW
05530 NOPLN1: OCRLF ;RETURN THE CARRIAGE
05540 >; END OF IFN %SS037
05600 NOPLIN: PUSHJ P,INSED ;ANYTHING ELSE IS OK
05700 PUSHJ P,FINDN ;GET NEXT
05800 PUSHJ P,FILLB ;IN CASE IT GOT LONGER
05900 SOSG RPCNT ;SEE IF OUT OF COUNT
06000 JRST COMND
06100 MOVE T1,(PNTR) ;GET POINTER BACK
06200 JRST ONREP
06300
06400 RPALT: ;HERE TO ALTER THE LINE
06410 IFN %SS037, <
06420 OCRLF ;FIRST RETURN THE CARRIAGE
06430 >; END OF IFN %SS037
06440 MOVE T1,OCNT ;SAVE COUNT
06500 ADDI T1,LIBUF ;FAKE OUT SETALT
06600 PUSHJ P,RPSALT
06700 PUSHJ P,ALTN1 ;DO ALTER
06800 JRST ENDREP ;QUIT
06900 JRST NOPLINE ;USE IT NOW
00100 ASBMD1: TROA FL,CNTF ;MARK AS KEEP END OF RANGE
00200 ASBMDT: TRZ FL,CNTF ;JUST IN CASE
00290 IFE %SS043*DEFCRL, <
00300 TLO FL,ASSMF ;WE ASSUME .+1
00310 >; END OF IFE %SS043*DEFCRL
00400 MOVE T1,CLN
00500 MOVEM T1,LOLN ;SET FOR HERE TO ETERNITY
00600 MOVEM T1,HILN
00700 MOVE T1,CPGL
00800 MOVEM T1,LOPG
00900 TRZE FL,CNTF ;KEEP END?
01000 JRST NOSPSB
01100 CAIE C,":" ;IF A : OR A !
01200 CAIN C,"!"
01300 JRST HALFSB ;GET THE SECOND HALF (.+1 TO GIVEN)
01310 IFN %SS043*DEFCRL, <
01320 TLNE FL,ASSMF ;TEST FOR ASSUMED RANGE .+1:??
01330 JRST NOSPSC ; YES, JUMP TO SET OLD UPPER LIMIT
01340 >; END OF IFN %SS043*DEFCRL
01400 MOVSI T1,377777 ;GET A LARGE PAGE
01500 MOVEM T1,HIPG
01600 MOVEI T1,1 ;SET FOR ONLY ONE
01700 MOVEM T1,RPCNT
01800 JRST REP4 ;ONWARD
01900 HALFSB: MOVEM T1,HIPG ;SET TO AS /.
02000 PUSHJ P,GET2HF ;GET THE SECOND HALF
02100 JRST REP4 ;AND GO
02200
02210 IFN %SS043*DEFCRL, <
02220 NOSPSC: TRO FL,CNTF ;SET BIT FOR "S$..." SYNTAX
02230 >; END OF IFN %SS043*DEFCRL
02300 NOSPSB: MOVE T1,RPHIPG
02400 MOVEM T1,HIPG
02500 MOVE T1,RPHILN
02600 MOVEM T1,HILN
02610 IFN %SS043*DEFCRL, <
02620 TRZE FL,CNTF ;TEST FOR "S$..." SYNTAX
02630 JRST REP4 ; YES, JUMP TO CONTINUE SCANNING
02640 >; END OF IFN %SS043*DEFCRL
02700 JRST REP1A
00100 INSQT: ILDB C,T1 ;GET NEXT CHR
00200 JUMPN C,PUTSTR ;MUST NOT BE 0
00300 NERROR IRS ;THIS STRING IS ILLEGAL
00400
00500 PARSTR: MOVEI CS,0 ;FIND OUT THE NUMBER
00600 PARST1: ILDB C,T1 ;GET A CHR
00700 CAIN C,.PTDLM ;CHECK FOR END
00800 JRST ENDNUM
00900 CAIL C,"0" ;MUST BE A DIGIT
01000 CAILE C,"9"
01100 NERROR IRS
01200 IMULI CS,^D10 ;CONVERT
01300 ADDI CS,-"0"(C)
01400 JRST PARST1
01500 ENDNUM: CAILE CS,0
01600 CAMLE CS,ARBCNT ;IS IT IN RANGE
01700 NERROR IRS ;NO SUCH PARTIAL STRING
01800 MOVE T4,[POINT 7,ARBBUF] ;START LOOKING FOR IT
01900 SOJLE CS,FNDRST ;STARTS WITH STRING 1
02000 NXTST: ILDB C,T4
02100 JUMPN C,NXTST ;0 IS END OF A PARTIAL STRING
02200 SOJG CS,NXTST ;LOOK FOR CORRECT STRING
02300 FNDRST: ILDB C,T4 ;NOW INSERT THAT STRING
02400 JUMPE C,REPSTR ;GO FINISH THE REPLACEMENT STRING
02500 IDPB C,ALTP
02600 AOS C,CCNT
02700 CAIL C,MXWPL*5
02800 NERROR LTL
02900 JRST FNDRST
03000
03100 PARORD: AOS CS,PARCNT ;GET NEXT PARTIAL
03200 JRST ENDNUM
03300
03400 RPNXT1: ;HERE TO REJECT A LINE
03410 IFN %SS037, <
03420 TRNN FL,EXTOG ;TEST FOR EXPERT
03430 OUTSTR [ASCIZ /[No change]/] ; YES, TELL OF NO ACTION
03440 OCRLF ;RETURN THE CARRIAGE
03450 >; END OF IFN %SS037
03460 SOSG RPCNT
03500 JRST RPFND
03600 RPNXT: PUSHJ P,FINDN
03700 JRST ONREP ;CONTINUE LOOKING AT LINES
03800
03810 IFN %SS037, <
03820 ENDRP0: TRNN FL,EXTOG ;TEST FOR EXPERT
03830 OUTSTR [ASCIZ /[No change]/] ; YES, TELL OF NO ACTION
03840 OCRLF ;RETURN THE CARRIAGE
03850 >; END OF IFN %SS037
03900 ENDREP: TRZN FL,LINSN ;WERE THERE ANY?
04000 NERROR NLN
04100 RPFND: SKIPN FNDFLG ;FIND ANY?
04200 RERROR SRF ;NOPE
04300 JRST COMND ;GO ON
04400
04500 RPPAG: AOS CPG ;JUST ADVANCE PAGE COUNTER
04600 JRST RPNXT
04700
04800
04900
05000
05100 SUBTTL XPAND COMMAND
00100
00200
00300 XPAND: SETZM LOLN ;AS USUAL, A GOOD THING
00390 IFE %SS074, <
00400 TRNE FL,READOF ;CHECK R/O
00500 NERROR ILC
00510 >; END OF IFE %SS074
00600 SETZM SSW ;CLEAR SWITCH
00700 PUSHJ P,GET2S ;THE RANGE
00710 IFN %SS040, <
00720 TRZ FL2,DOEXCT ;ASSUME NON-EXACT MATCH
00730 SKIPE EXACTF ;TEST FOR /EXACT
00740 TRO FL2,DOEXCT ; YES, SET THE BIT
00750 >; END OF IFN %SS040
00760 IFE %SS042, <
00800 CAIE C,"," ;SWITCH
00900 JRST XPAND0
01000 PUSHJ P,SCAN
01100 MOVS T1,ACCUM
01200 CAIE T1,(<SIXBIT /S />)
01300 NERROR ILC
01400 SETOM SSW ;SET TO SUPPRESS TYPEOUT
01500 PUSHJ P,SCAN
01505 >; END OF IFE %SS042
01510 IFN %SS042, <
01515 MOVEI SINDEX,[SIXBIT /S/
01520 SETOM SSW
01525 IFN %SS040, <
01530 SIXBIT /E/
01535 TRC FL2,DOEXCT
01540 >; END OF IFN %SS040
01545 EXP 0]
01550 PUSHJ P,SCNMOD ;SCAN FOR MODIFIERS
01555 >; END OF IFN %SS040
01600 XPAND0: TRNN FL,TERMF
01700 NERROR ILC
01800 TRZ FL,LINSN
01900 MOVE T1,LOPG
02000 MOVEM T1,DPG
02100 MOVE SINDEX,LOLN
02200 PUSHJ P,FIND
02300 XPND1: PUSHJ P,ONMOV ;STILL IN RANGE?
02400 JRST EXPEND
02500 TRO FL,LINSN
02600 CAMN T1,PGMK ;IGNORE THESE
02700 JRST PAGE
02800 SKIPE SSW ;SUPPRESS?
02900 TRO FL2,SUPN ;YES:
03000 MOVEM T1,CLN
03100 MOVE T1,CPG
03200 MOVEM T1,CPGL ;SET LINE AND PAGE
03300 PUSHJ P,SETALT ;SET THINGS UP
03400 MOVSI T2,1 ;A LARGE COUNT
03500 PUSHJ P,ALTSP ;SPACES
03600 TRZ FL2,SUPN ;RESET SWITCH
03700 MOVEI T2,0
03800 PUSHJ P,[PUSHJ P,ALTIN
03900 PUSHJ P,ALTN1
04000 JRST LEVINS
04100 AOS (P)
04200 POPJ P, ]
04300 JRST LEVINS
04400 PUSHJ P,INSED ;PUT IN CHANGED LINE
04500 EXPND2: PUSHJ P,FINDN
04600 PUSHJ P,FILLB ;IN CASE OF OVERFLOW
04700 MOVE T1,(PNTR) ;GET BACK NEXT LINE
04800 JRST XPND1
04900 PAGE: AOS T2,CPG
05000 MOVEM T2,CPGL
05100 PUSHJ P,PGPRN ;SEE ALTER COMMAND
05200 MOVE T1,[<ASCII /00000/>!1]
05300 MOVEM T1,CLN
05400 JRST EXPND2
05500 EXPEND: TRNN FL,LINSN
05600 NERROR NLN
05700 JRST COMND
05800 SUBTTL JUSTIFY COMMAND
00100 IFN JUSTSW,<
00200 JUST: SETZM LOLN ;AS USUAL
00300 ;*FIX* MOVEI JF,0 ;CLEAR FLAGS ;** FIX **
00390 IFE %SS074, <
00400 TRNE FL,READOF ;BETTER NOT BE READ ONLY
00500 NERROR ILC ;SO TELL HIM
00510 >; END OF IFE %SS074
00600 PUSHJ P,GNCH ;GET A CHARACTER
00700 MOVEM C,SAVC ;IN CASE WE NEED IT
00800 ANDI C,137 ;FORCE UPPER
00900 CAIN C,"R"
01000 TRO JF,JRFLG ;R FOR RIGHT
01100 CAIN C,"L"
01200 TRO JF,JLFLG ;L FOR LEFT
01300 CAIN C,"C"
01400 TRO JF,JCFLG ;C FOR CENTER
01500 CAIN C,"U" ;U FOR JUSTIFY
01600 TRO JF,JFFLG ;WHICH IS THE ONLY THING WHICH FILLS
01700 CAIN C,"W" ;W FOR WORDS
01800 TRO JF,JWFLG!JFFLG
01900 TRNN JF,JRFLG!JLFLG!JCFLG!JFFLG!JWFLG
02000 JRST JOIN ;MUST BE LINE NUMBER FOR JOIN
02100 SETZM SAVC ;DON'T NEED IT
02200 MOVE T1,RMAR ;CHECK THAT THIS GUY IS LARGEST
02300 CAMLE T1,LMAR
02400 CAMG T1,PMAR
02500 NERROR MAR
02600 PUSHJ P,GET2S ;GET RANGE
02700 TRNN FL,TERMF ;THIS HAD BETTER BE A TERMINATOR
02800 NERROR ILC ;HE REALLY BLEW IT
02900 MOVE T1,LOPG ;GET SET TO FIND LINE
03000 MOVEM T1,DPG
03100 MOVE SINDEX,LOLN
03200 MOVEM SINDEX,LIBUF ;ALSO SET NEW FIRST LINE TO SAME
03300 PUSHJ P,FIND ;FIND IT
03400 PUSHJ P,INITOL ;SET IT UP
03500 MOVEM T1,LIBUF ;SET NEW LINE NUMBER SAME AS OLD
03600 PUSHJ P,INITNL ;AND SET UP THE NEW ONE
03700 SETZM TPNT ;TELL JGET THERE IS NOTHING IN LIBUF2
03800 MOVE T1,LMAR ;SET LEFT MARGIN
03900 TRNE JF,JFFLG ;IF FILLING
04000 MOVE T1,PMAR ;MAKE THIS START OF PARAGRAPH
04100 SOS T1
04200 MOVEM T1,INDNT ;FOR INDENTATION
04300 MOVEM T1,LINL ;AND LINE LENGTH
00100 ;THIS IS THE PART THAT GETS A CHARACTER FROM THE OLD LINE
00200
00300 JGET: SKIPN TPNT ;IS THERE ANY UNPROCESSED TAIL?
00400 JRST JGET1 ;NO, GET A CHARACTER
00500 MOVE T1,ELIN ;ARE WE AT END OF LINE?
00600 CAMN T1,TPNT
00700 JRST JGET2 ;YES, START GETTING FROM OLD LINE
00800 ILDB T1,TPNT ;NO, GET A CHARACTER
00900 JRST JPUT ;AND PUT.
01000 JGET2: SETZM TPNT ;END OF TAIL
01100
01200 JGET1: ILDB T1,PNTR ;LOAD A CHARACTER
01300 AOS OCNT1 ;STEP CHARACTER COUNT
01400 CAIE T1,15 ;IS THIS A CR?
01500 JRST JGET3 ;NO,TEST FOR END OF LINE
01600 TRNN JF,JFFLG ;ARE WE FILLING?
01700 JRST JGET4 ;NO, WE'RE THROUGH
01800 MOVEI T1," " ;YES, MAKE IT A BLANK
01900 JRST JPUT ;AND GO PUT
02000 JGET3: CAIE T1,12 ;END OF LINE?
02100 JRST JPUT ;NOT YET, SO GO PUT
02200 JGET4: ;END OF LINE
02210 CAIN T1,15 ;TEST FOR <CR> ;** FIX **
02220 IBP PNTR ; YES, INCR TO <LF> ;** FIX **
02300 HRRZ T1,PNTR ;CURRENT WORD IN BUFFER FOR DELETION
02400 SUB T1,OPTR ;- START OF OLD LINE
02500 AOS T1 ;+1 = WORD COUNT OF OLD LINE
02600 MOVEM T1,OCNT ;FOR INSED
02700 TRNN JF,JFFLG ;IF WE ARE NOT FILLING
02800 JRST JGETE ;DO WHAT WE HAVE TO DO
02900 SETZM NCNT ;OTHERWISE WE DELETE OLD LINE
03000 MOVE PNTR,OPTR ;WHICH STARTS HERE
03100 PUSHJ P,INSED ;USING INSED
03200 PUSHJ P,FINDN1 ;MAKE SURE WE`RE AT START OF NEXT ONE
03300 PUSHJ P,INITOL ;DO SETUP ON IT AND CHECK RANGE
03400 JGETF: ILDB T1,PNTR ;GET FIRST CHARACTER
03500 AOS OCNT1 ;STEP CHARACTER COUNT
03600 CAIE T1,11 ;IS IT A TAB
03700 CAIN T1,15 ;OR CR?
03800 JRST PARA ;YES, START A NEW PARAGRAPH
03900 TRNE JF,JWFLG ;IF WE ARE DOING A "JW"
04000 CAIE T1," " ;AND A LINE STARTS WITH A SPACE
04100 JRST JPUT
04200 JRST JGETF ;THEN IGNORE IT
04300 JGETE: MOVE T1,LINL ;LINE LENGTH
04400 MOVEM T1,WRDL ;TO WRDL BECAUSE CR AS BLANK WAS DELETED
04500 MOVEM ALTP,LWRD ;ALSO STORE POINTER TO END OF LINE
04600 CAMLE T1,MAXL ;IF LINE WAS TOO LONG,
04700 RERROR LTL ;TELL HIM SO
04800 PUSHJ P,JSUB ;CLEAN UP NEW LINE AND PUT IT OUT
04900 PUSHJ P,INITOL ;SET UP NEXT LINE
05000 MOVEM T1,LIBUF ;SET NEW LINE NUMBER SAME AS OLD
05100 SETZM TPNT ;NOTHING IN LIBUF2
05200 JRST JGET2 ;START MUNCHING
00100 ;THIS IS THE PART THAT PUTS A CHARACTER INTO THE NEW LINE
00200
00300
00400 JPUT: CAIE T1," " ;IS THIS A BLANK?
00500 JRST JPUTN ;NO, CHECK SOME OTHER STUFF
00600 TRNE JF,JPER ;IF WE HAVE SEEN A PERIOD OR SOMETHING
00700 TRNN JF,JBLF ;AND THIS IS NOT THE FIRST BLANK
00800 SKIPA
00900 ;;*FIX* JRST JPUTN1 ;PERMIT IT ANYWAY BUT DON'T TELL ANYONE
00910 JRST [ ;JUMP TO PERMIT ONLY 1 BLANK AFTER "." ;** FIX **
00920 TRZ FL,JPER ;FORGET THE PERIOD NOW ;** FIX **
00930 JRST JPUTN1 ; BUT PERMIT THIS BLANK ;** FIX **
00940 ] ;** FIX **
01000 TROE JF,JBLF ;WAS THERE ONE BEFORE IT?
01100 JRST JGET ;YES; WE DON`T WANT IT
01200 ;;*FIX* TRNN JF,JWFLG ;IF HE WANTS BLANKS THEN CHECK
01300 TRNN JF,JFFLG ;ARE WE FILLING?
01400 TRZ JF,JBLF ;NO, PERMIT AN EXTRA BLANK
01500 AOS WCNT ;STEP WORDCOUNT
01600 MOVE T2,LINL ;GET LENGTH SO FAR
01700 MOVEM T2,WRDL ;AND SAVE IT FOR JSUB
01800 MOVEM ALTP,LWRD ;AND STORE POINTER TO END OF WORD
01900 JRST JPUT1 ;THEN PUT BLANKIN BUFFER
02000 JPUTN: TRZ JF,JBLF!JPER ;NOT A BLANK
02100 CAIN T1,"." ;IS IT A PERIOD
02200 TRO JF,JPER
02300 CAIN T1,":" ;OR COLON
02400 TRO JF,JPER
02500 CAIN T1,"?" ;OR QUESTION MARK
02600 TRO JF,JPER
02700 CAIN T1,"!" ;OR EXCLAMATION?
02800 TRO JF,JPER ;IF SO PERMIT EXTRA BLANKS
02900 JPUTN1: MOVE T2,LINL ;LENGTH SO FAR
03000 JPUT1: IDPB T1,ALTP ;DEPOSIT CHARACTER
03100 ADD T2,@WTBL ;WIDTH OF CHARACTER
03200 CAIN T1,10 ;ADJUST BACK-SPACES
03300 SUBI T2,2 ;** FIX **
03400 CAIE T1,11 ;WAS THAT A TAB?
03500 JRST JPUT2 ;NO
03600 TRZE T2,7 ;YES. IF LAST 3 BITS ARE NONZERO
03700 ADDI T2,10 ;WE WERN'T AT TAB POSITION
03800 SETZM WCNT ;RESET WORDCOUNT
03900 SETZM LWRD ;LAST WORD LOCATION
04000 MOVEM ALTP,BLIN ;AND LOGICAL BEGINNING OF LINE FOR JSUB
04100 TRNE JF,JFFLG ;IF FILLING
04200 TRO JF,JBLF ;DELETE A FOLLOWING BLANK
04300 JPUT2: MOVEM T2,LINL ;STORE NEW LENGTH
04400 CAMLE T2,MAXL ;ARE WE OVER THE END?
04500 JRST JPUTEL ;YES, END LINE WE ARE NOW ON
04600 CAME ALTP,[POINT 7,LIBUF2+MXWPL,34] ;NO, HAVE WE FILLED BUFFER?
04700 JRST JGET ;NOT YET, GET ANOTHER
04800 JPUTEL: SKIPE LWRD ;ANY WORDS YET?
04900 JRST JPUTE ;YES, PUT OUT LINE
05000 RERROR LTL ;NO, TELL HIM LINE TOO LONG
05100 MOVE T2,MAXL ;SAY LINE IS LONG ENOUGH
05200 MOVEM T2,WRDL
05300 JPUTE: TRNE JF,JFFLG ;UNLESS WE'RE NOT FILLING (IN WHICH CASE THIS IS A MISTAKE)
05400 PUSHJ P,JSUB ;MOVE OUT A NEW LINE, AFTER JUSTIFYING IT
05500 JRST JGET ;THEN GET ANOTHER CHARACTER
00100 ;THIS PUTS OUT A NEW LINE
00200
00300 NLOUT: MOVEI T1,15 ;ADD A CR
00400 IDPB T1,ALTP
00500 MOVEI T1,12 ;AND A LF
00600 IDPB T1,ALTP
00700 HRRZ T1,ALTP ;LAST WORD OF LINE
00800 SUBI T1,LIBUF ;-FIRST
00900 AOS T1 ;+1=WORDCOUNT
01000 MOVEM T1,NCNT ;FOR INSERTION INTO BUFFER
01100 TRNE JF,JFFLG ;IF FILLING
01200 SETZM OCNT ;INSERT BEFORE
01300 MOVE PNTR,OPTR ;ELSE REPLACE, THE OLD LINE
01400 PUSHJ P,INSED ;DONE BY INSED
01500 PUSHJ P,FINDN ;FIND OLD LINE
01600 PUSHJ P,FILLB ;AND KEEP FROM LOSING IT
01700 TRNN JF,JFFLG ;IF NOT FILLING
01800 JRST INITNL ;SET UP NEW LINE ON THE WAY BACK
01900 MOVE T2,INCR ;INCR FOR LINE NUMBERS
02000 MOVE T1,LIBUF ;OLD LINE NUMBER
02100 PUSHJ P,ASCIAD ;ADD TO MAKE NEW ONE
02200 MOVEM T1,LIBUF ;AND STORE IT AWAY
02300 CAMG T1,MAXLN ;TOO HIGH?
02400 JRST NLO2 ;NO, EXIT
02490 IFE %SS056, <
02500 AOS T1,CPG ;YES, WILL SOON BE ON NEXT PAGE
02600 MOVEM T1,CPGL ;AND LOGICAL PAGE
02700 AOS BGPG ;ADD ONE MORE PAGE
02800 AOS INPG
02900 AOS HIPG
03000 MOVE T1,PGMK ;INSERT PAGEMARK
03100 MOVEM T1,LIBUF ;IN LINE BUFFER
03200 MOVE T1,PGMKW2 ;AND TEXT THEREOF
03300 MOVEM T1,LIBUF+1
03400 SETZM OCNT ;INSERT
03500 MOVEI T1,2 ;2 WORDS
03600 MOVEM T1,NCNT
03700 PUSHJ P,INSED ;INTO TEXT FILE
03800 MOVE T2,INCR ;INCR AGAIN
03900 MOVEM T2,LIBUF ;TO MAKE FIRST LINE NUMBER
04000 PUSHJ P,FINDN ;MOVE PAST IT
04100 PUSHJ P,FILLB ;FILL BUFFER TO KEEP FROM LOSING IT
04110 >; END OF IFE %SS056
04120 IFN %SS056, <
04130 PUSHJ P,MARKIT ;INSERT A PAGE MARK
04140 >; END OF IFN %SS056
04200 OUTSTR [ASCIZ /%Page mark inserted
04300 /]
04400 NLO2: MOVE T1,OCNT1 ;CHARACTERS PROCESSED SO FAR
04500 MOVEM PNTR,OPTR ;REMEMBER WHERE WE ARE
04600 AOS PNTR ;SKIP LINE NUMBER
04700 HRLI PNTR,(<POINT 7,0>) ;MAKE BYTE POINTER
04800 NLO1: IBP PNTR ;TO MOVE PNTR BACK
04900 SOJGE T1,NLO1 ;TO WHERE WE FOUND IT
05000 JRST INITNL ;THEN SET UP NEW LINE ON WAY BACK
00100 ;THIS SETS UP A NEW OLD LINE FOR GET
00200
00300 INITOL: PUSHJ P,FINDN1 ;MAKE SURE WE ARE AT START OF LINE
00400 INITO1: HRRZM PNTR,OPTR ;SAVE POINTER TO START OF LINE
00500 PUSHJ P,ONMOV ;CHECK RANGE
00600 JRST JSTEND ;FINISHED
00700 CAMN T1,PGMK ;IS IT A PAGEMARK?
00800 JRST INITOP ;YES
00900 MOVEM T1,CLN ;NO, SET CURRENT LINE
01000 MOVE T2,CPG ;AND PAGE
01100 MOVEM T2,CPGL
01200 SETZM OCNT1 ;NO CHARACTERS YET
01300 SETZM TCHR ;NOT KNOWN TO BE START OF PARAGRAPH
01400 AOS PNTR ;SKIP LINE NUMBER
01500 HRLI PNTR,(<POINT 7,0>) ;MAKE BYTE POINTER
01600 IBP PNTR ;SKIP INITIAL TAB
01700 POPJ P, ;EXIT
01800 INITOP: ;FOUND A PAGEMARK
01900 TRNE JF,JFFLG ;ARE WE FILLING?
02000 JRST INITOD ;YES, DELETE IT
02100 AOS T2,CPG ;NO, WE ARE ON NEW PAGE
02200 MOVEM T2,CPGL
02300 PUSHJ P,FINDN ;FIND NEXT LINE
02400 PUSHJ P,FILLB ;HANG ON TO IT
02450 MOVE T1,(PNTR) ;GET NEXT SEQ # AGAIN ;** FIX **
02500 JRST INITO1 ;AND SEE WHAT'S THERE
02600 INITOD: SETZM NCNT ;DELETE PAGEMARK
02700 MOVEI T1,2 ;2 WORDS LONG
02800 MOVEM T1,OCNT
02900 PUSHJ P,INSED ;USE INSED AS USUAL
03000 SOS BGPG ;NOW HAVE ONE LESS PAGE
03100 SOS INPG
03200 SOS HIPG
03300 JRST INITOL ;LOOK AT NEXT LINE
03400 INITNL: SETZM LIBUF+1 ;CODE TO ZERO THE LINE BUFFER
03500 MOVE T1,[XWD LIBUF+1,LIBUF+2]
03600 BLT T1,LIBUF+MXWPL+1
03700 MOVE ALTP,[POINT 7,LIBUF2] ;POINT ALTP AT START OF LIBUF2
03800 MOVEI T1,11 ;TAB TO START LINE
03900 IDPB T1,ALTP ;SO INSERT IT
04000 MOVEM ALTP,BLIN ;AND SAVE LOGICAL BEGINNING OF LINE
04100 TRO JF,JBLF ; KEEP FROM INSERTING LEADING BLANKS
04200 TRZ JF,JPER
04300 MOVE T1,LMAR ;SET LEFT MARGIN
04400 SOS T1 ;MARGIN -1 = EXTRA BLANKS
04500 MOVEM T1,LINL ;FOR EXTRA LINE LENGTH
04600 MOVEM T1,INDNT ;AND INDENTATION
04700 SETZB T1,WCNT ;AND THERE ARE NO WORDS YET
04800 SETZM WRDL ;NOR CHARACTERS, FOR THAT MATTER
04900 EXCH T1,LWRD ;RESET POINTER TO LAST WORD
05000 MOVEM T1,TPNT ;BUT SAVE IT TO GET TAIL
05100 POPJ P, ;RETURN
00100 ;THIS STARTS A NEW PARAGRAPH
00200
00300 PARA: MOVEM T1,TCHR ;STORE TERMINATING CHARACTER
00400 SKIPE LWRD ;ANY WORDS YET?
00500 PUSHJ P,JSUB ;YES, GET RID OF OLD LINE
00600 MOVE T1,TCHR ;GET TERMINATOR BACK
00700 SETZM TCHR ;DON'T CONFUSE PEOPLE
00800 SETZM TPNT ;TELL JGET NOTHING REMAINS IN LIBUF2
00900 SETZM INDNT ;IF TAB, NO SPECIAL INDENTATION
01000 SETZM LINL
01100 CAIN T1,11 ;IS IT A TAB?
01200 JRST JPUT ;YES, PUT IT IN NEW LINE
01300 PUSHJ P,JSUB ;MUST HAVE BEEN BLANK LINE
01400 MOVE T1,PMAR ;SET PARAGRAPH MARGIN
01500 SOS T1
01600 MOVEM T1,INDNT
01700 MOVEM T1,LINL
01800 JRST JGET ;SO GET NEW CHARACTER
01900
02000 ;THIS FINISHES EVERYTHING UP
02100
02200 JSTEND: SETOM TCHR ;FAKE END OF PARAGRAPH
02300 SKIPE LWRD ;ANYTHING LEFT?
02400 PUSHJ P,JSUB ;YES, GET RID OF IT
02500 MOVE PNTR,OPTR ;GET BACK OLD POINTER
02600 MOVE T1,(PNTR) ;GET LINE NUMBER
02700 MOVEM T1,LIBUF ;SAVE NUMBER OF NEXT LINE
02800 PUSHJ P,FINDB ;GET LINE LAST FILLED
02900 MOVEM T1,CLN ;SET IT AS CURRENT LINE
03000 EXCH T1,LIBUF
03100 SKIPE T1 ;END OF FILE?
03200 CAMN T1,PGMK ;PAGE MARK NEXT?
03300 JRST COMND ;DON'T WORRY ABOUT ORDER
03400 CAMG T1,LIBUF ;ORDER TROUBLE?
03500 NERROR ORDER ;YES
03600 JRST COMND ;NO, WE'RE THROUGH.
00100 ;AT LAST! THE JUSTIFICATION OF ALL THIS STUFF!
00200
00300 JSUB: MOVEM ALTP,ELIN ;SAVE END OF LINE FOR GET
00400 MOVE ALTP,[POINT 7,LIBUF+1] ;WHERE TO DEPOSIT
00500 MOVE T4,[POINT 7,LIBUF2] ;WHERE TO LOAD
00600 MOVNS JFLOP ;PUT BLANKS IN OTHER SIDE THIS TIME
00700 JSUB1: ILDB T1,T4 ;GET A CHARACTER
00800 IDPB T1,ALTP ;AND MOVE IT
00900 CAME T4,BLIN ;WAS THAT THE LAST TAB?
01000 JRST JSUB1 ;NO, MOVE ANOTHER
01100 SKIPN T5,LWRD ;IF NO WORDS THERE
01200 MOVE T5,ELIN ;THIS IS WHERE TO STOP
01300 SKIPN WRDL ;IF NOTHING IS THERE AT ALL
01400 JRST NLOUT ;PUT OUT BLANK LINE
01500 ;NOW WE COMPUTE NUMBER OF BLANKS TO INSERT, IF ANY
01600 SETZM T2
01700 SETZM BPW
01800 SETZM REM
01850 MOVEI T1," " ;GET THE SPACE TO FILL WITH ;** FIX **
01875 ;SPR 10-16564 ;** FIX **
01900 TRNE JF,JLFLG ;IF LEFT JUSTIFYING,
02000 JRST JSUBM1 ;WE DON'T WANT ANY
02100 ;*FIX* MOVEI T1," " ;** FIX **
02200 MOVE T2,MAXL ;DESIRED LENGTH
02300 SUB T2,WRDL ;-LENGTH WE HAVE = WHAT WE WANT
02400 JUMPE T2,JSUBM1 ;IF ZERO, GO MOVE REST OF LINE
02500 IDIV T2,@WTBL ;/WIDTH OF BLANK = BLANKS WE NEED
02600 TRNE JF,JCFLG ;IF CENTERING
02700 ASH T2,-1 ;WE ONLY WANT HALF AS MANY
02800 TRNE JF,JRFLG!JCFLG ;IF NOT JUSTIFYING BOTH MARGINS
02900 JRST JSUBM1 ;GO PUT IN SOME BLANKS
03000 SOSLE WCNT ;IF LESS THAN 2 WORDS
03100 SKIPE TCHR ;OR END OF PARAGRAPH
03200 JRST JSUBM ;DON'T BOTHER
03300 IDIV T2,WCNT ;BLANKS/WORDS
03400 MOVEM T2,BPW ;= BLANKS PER WORD
03500 MOVEM T3,REM ;AND REMAINDER
03600 SKIPL JFLOP
03700 JRST JSUBM
03800 AOS BPW ;EVERY OTHER LINE
03900 SUB T3,WCNT ;WE ADD EXTRA BLANKS
04000 MOVNM T3,REM ;ON THE OTHER SIDE
04100 JSUBM: SETZM T2
04200 ;MOVE LINE, INSERTING BLANKS
04300 JSUBM1: ADD T2,INDNT ;DO INDENTATION
04400 JSUBM3: SOJL T2,JSUBM2 ;QUIT IF NONE
04500 IDPB T1,ALTP ;ELSE DEPOSIT
04600 SOJGE T2,.-1 ;AND TRY AGAIN
04700 JSUBM2: CAMN T4,T5 ;WAS IT THE LAST?
04800 JRST NLOUT ;YES, PUT OUT NEW LINE
04900 ILDB T1,T4 ;GET ANOTHER CHARACTER
05000 IDPB T1,ALTP ;DEPOSIT IT
05100 TRNE JF,JWFLG ;LOOP IF NO BLANK FILL
05200 JRST JSUBM2
05300 SKIPN TCHR ;AT END OF PARAGRAPH WE DO NOT LOOK FOR BANKS
05400 TRNN JF,JFFLG ;ARE WE LOOKING FOR BLANKS?
05500 JRST JSUBM2 ;NO, MOVE ANOTHER
05600 JSUBB: CAIE T1," " ;YES, IS IT A BLANK?
05700 JRST JSUBBN ;NO
05800 TROE JF,JBLF ;YES, DID WE JUST SEE ONE?
05900 JRST JSUBM2 ;YES, MOVE ANOTHER
06000 MOVE T2,BPW ;NO, GET BLANKS PER WORD
06100 SOSL REM ;IF REMAINDER STILL .GT. 0
06200 ADD T2,JFLOP ;ADD ANOTHER ON ALTERNATE LINES
06300 JRST JSUBM3 ;AND PUT THEM IN
06400 JSUBBN: TRZ JF,JBLF ;NOT A BLANK
06500 JRST JSUBM2 ;GET ANOTHER
06600
06700 > ;;; END OF INF JUSTSW
06800 SUBTTL JOIN COMMAND
00100 IFE JUSTSW,<
00200 JUST: SETZM LOLN ;AS USUAL
00290 IFE %SS074, <
00300 TRNE FL,READOF
00400 NERROR ILC
00410 >; END OF IFE %SS074
00500 >
00600 JOIN: PUSHJ P,GET1S ;GET LINE NUMBER
00700 TRNN FL,TERMF
00800 NERROR ILC
00900 MOVE T1,HIPG
01000 MOVEM T1,DPG
01100 MOVE SINDEX,HILN ;FIND THE CORRECT LINE
01200 PUSHJ P,FIND
01300 MOVE T2,CPG
01400 MOVE T1,(PNTR)
01500 CAMN T2,HIPG
01600 CAME T1,HILN
01700 NERROR NLN
01800 MOVEM T2,CPGL
01900 MOVEM T1,CLN
02000 SETZM LIBUF ;TO ELIMINATE GARBAGE AT END OF LINE
02100 MOVE T1,[XWD LIBUF,LIBUF+1]
02200 BLT T1,LIBUF+MXWPL+1
02300 MOVE T2,PNTR ;GET THE POINTER TO THE LINE
02400 MOVE T3,(T2) ;PICK UP THE FIRST WORD
02500 MOVEI T4,LIBUF ;THE PLACE TO PUT IT
02600 JRST JSALT3 ;TRANSFER
02700 JSALT2: SKIPE T3,(T2)
02800 TRNE T3,1 ;IS IT THE END OF THE LINE
02900 JRST JSALT1
03000 JSALT3: MOVEM T3,(T4) ;PUT IT AWAY
03100 ADDI T4,1
03200 AOJA T2,JSALT2
00100 JSALT1: MOVEI T1,(T4) ;MOVEI T1,-LIBUF(T4)
00200 SUBI T1,LIBUF
00300 MOVEM T1,OCNT
00400 IMULI T1,5 ;GET COUNT OF CHRS
00500 SUBI T1,6 ;WE WILL HAVE TO FIND THE TRUE END
00600 SUBI T4,2
00700 HRLI T4,(<POINT 7,0,27>) ;SET UP POINTER
00800 FEND1: ILDB T2,T4
00900 CAIE T2,15
01000 AOJA T1,FEND1
01100 PUSH P,T1
01200 PUSHJ P,FINDN ;GET THE LINE TO JOIN IT TO
01300 CAME T1,PGMK
01400 SKIPN T1
01500 NERROR NNN ;NO LINE THERE TO CONNECT TO
01600 POP P,T2 ;COUNT
01700 MOVEI T1,1(PNTR)
01800 HRLI T1,(<POINT 7,0,6>) ;SET TO POINT THERE
01900 ADD T4,[XWD 70000,0]
02000 TRN1: ILDB T3,T1
02100 IDPB T3,T4
02200 ADDI T2,1
02300 CAIL T2,MXWPL*5+6
02400 NERROR LTL
02500 CAIE T3,12
02600 JRST TRN1
02700 SUBI T1,-1(PNTR)
02800 PUSH P,OCNT
02900 HRRZM T1,OCNT ;SIZE OF OLD SECOND LINE
03000 SETZM NCNT
03100 PUSHJ P,INSED
03200 PUSHJ P,FINDB ;BACK UP
03300 POP P,OCNT ;GET ITS SIZE
03400 SUBI T4,LIBUF-1
03500 HRRZM T4,NCNT
03600 PUSHJ P,INSED
03700 JRST COMND
03800
03900 SUBTTL INDIRECT COMMAND
00100 ;INPUT ROUTINE FOR COMMAND FILE
00200
00300 RDCHAR: SOSG INDBUF+2 ;CHECK EMPTY BUFFER
00400 JRST DOINP ;READ FROM FILE
00500 RDCHR1: ILDB C,INDBUF+1 ;GET A CHAR
00600 JUMPE C,RDCHAR ;SKIP NULLS
00700 MOVE CS,@INDBUF+1 ;FETCH WORD
00800 TRNN CS,1 ;SEQ BIT
00900 POPJ P, ;NO - RETURN
01000 MOVNI C,5 ;SKIP 5 MORE CHARS (TAB INCLUDED)
01100 ADDM C,INDBUF+2
01200 AOS INDBUF+1 ;ADJUST BYTE POINTER
01300 CAME CS,PGMK ;PAGE MARK
01400 JRST RDCHAR ;NO -GET NEXT CHAR
01500 MOVNI C,4 ;YES- SKIP SOME MORE CHARS
01600 ADDM C,INDBUF+2
01700 MOVSI C,(<POINT 7,0,35>)
01800 HLLM C,INDBUF+1 ;ADJUST BYTE POINTER AGAIN
01900 JRST RDCHAR
02000
02100 DOINP: IN IND,0
02200 JRST RDCHR1 ;AOK
02290 IFE %SS012, <
02300 MOVE T1,SVCCIN ;RETSTORE INPUT ROUTINE
02400 MOVEM T1,CHIN
02500 TRZ FL2,COMFLF ;ERROR - CLR FLAG
02510 >; END OF IFE %SS012
02600 GETSTS IND,C
02700 RELEAS IND, ;GET STATUS AND CLOSE CHL
02790 IFE %SS012, <
02800 TRNN C,740000
02900 NERROR CMEND ;EOF
03000 NERROR CMERR ;LOSE BIG
03010 >; END OF IFE %SS012
03020 IFN %SS012, <
03030 TRNE C,740000 ;TEST FOR ERROR
03040 NERROR CMERR ; YES, TELL THE USER
03050 RERROR CMEND ;GIVE THE 'EOF' MESSAGE
03060 JRST CKIND1 ; BUT DON'T CLEAR TYPE-AHEAD
03070 >; END OF IFN %SS012
03100
03200 ;HANDLE @ COMMAND - READ COMMANDS FROM FILE
03300
03400 COMFIL: ;HERE TO SET UP @-FILE
03410 IFE %SS012, <
03420 TRNE FL2,COMFLF ;TRYING TO NEST?
03500 NERROR ILC
03510 >; END OF IFE %SS012
03600 PUSHJ P,SCAN ;READ FILE NAME
03700 PUSHJ P,SETNM1 ;FETCH FILE SPEC
03800 NERROR ILC ;ERROR RETURN
03900 MOVE T1,[TMPBLK,,INDBLK]
04000 BLT T1,INDBKE
04100 SKIPN T1,INDDEV ;GET DEVICE IF THERE
04200 MOVSI T1,'DSK' ;ELSE SUPPLY DEFAULT
04300 MOVEM T1,INDDVI+1
04310 IFN %SS012, <
04320 DEVCHR T1, ;FIND OUT ABOUT THE DEVICE
04330 TLNE T1,(1B4) ;TEST FOR CONTROLLING TTY
04340 JRST CKIND ; YES, COMMAND DONE
04350 >; END OF IFN %SS012
04400 OPEN IND,INDDVI ;OPEN FILE ETC..
04500 NERROR DNA
04600 XLOOK IND,INDBLK
04700 NERROR FNF
04800 MOVEI T1,COMBUF ;SETUP BUFFER
04900 MOVEM T1,.JBFF##
05000 INBUF IND,1 ;***
05100 MOVE T1,[ASCII /00000/] ;SET UP CMD COUNT
05200 MOVEM T1,COMCNT
05210 IFE %SS012, <
05300 TRO FL2,COMFLF
05310 >; END OF IFE %SS012
05400 MOVEI T1,RDCHAR ;SET UP INPUT ROUTINE
05500 EXCH T1,CHIN ;AND SAVE CURRENT
05510 IFN %SS012, <
05520 TRON FL2,COMFLF ;SET @-FILE BIT & SKIP IF ON
05530 >; END OF IFN %SS012
05600 MOVEM T1,SVCCIN
05700 JRST COMND
05800
05900
06000
06100 SUBTTL LITERALS
06200 XLIST
06300 LIT ;CLEAR ALL LITERALS
06400 LIST
06500 SUBTTL IMPURE AREA
00100 ;IMPURE SECTION IS DIVIDED INTO TWO AREAS
00200 ;1) DATA WHICH IS SEMI CONSTANT
00300 ;2) DATA WHICH IS INITIALLY ZEROED
00400
00500 DATAB:
00600 IFN RENTSW,< RELOC 0 ;SWITCH TO LOW SEG
00700 DATABL: RELOC
00800 PHASE DATABL>
00900
01000
01100 INDEVI: EXP 14
01200 SIXBIT /DSK/
01300 XWD 0,IBUF
01400
01500 OUDEVI: EXP 14
01600 SIXBIT /DSK/
01700 XWD OBUF,0
01800
01900 ALDEVI: EXP 14
02000 SIXBIT /DSK/
02100 XWD 0,ALTBF
02200
02300 TTDEVI: EXP 1B0+1
02400 SIXBIT /TTY/
02500 XWD 0,TTIBH
02600
02700 INDDVI: EXP 1
02800 SIXBIT /DSK/
02900 XWD 0,INDBUF
03000
03100 OPTDVI: EXP 1B0+1
03200 SIXBIT /DSK/
03300 XWD 0,OPTBHD
03400
03500 OPTFIL: SIXBIT /SWITCH/
03600 SIXBIT /INI/
03700 EXP 0,0
03800
03900 IFN EXTEND,<
04000 LSBUFN: LSNUM
04100 LSPTR:
04200 I==0
04300 REPEAT LSNUM,< POINT 7,LSBUF+<SRBLG/5+2>*I
04400 I==I+1
04500 >
04600 LSPTT:
04700 I==0
04800 REPEAT LSNUM,< EXP LSPNT+SRNUM*I
04900 I==I+1
05000 >
05100 >
05200 PGMK: <ASCII / />!1
05300 PGMKW2: BYTE (7)15,14,0,0,0
05400 SQBUF: BLOCK 1
05500 ASCII / /
05510 IFN %SS021, <
05520 SQTBUF: BLOCK 1 ;SPACE FOR THE SEQ #
05530 BYTE (7) 15,12,0,0,0 ; END THE LINE (NO TAB)
05540 >; END OF IFN %SS021
05600 IFN LSTSW,<
05700 PGHS: ASCII / /
05800 ASCII / /
05900 ASCIZ / PAGE /
06000 PGHD: BLOCK 10
06100
06200 LPDEVI: EXP 1
06300 SIXBIT /LPT/
06400 XWD LOBUF,0
06500 >
06600
06700 ERRHD: EXP 0 ;UUOHS COME HERE
06800 JRST ERRHD0
06900
07000 ASCZ1: ASCII /INC1=/
07100 PRNTO1: EXP 0
07200 ASCIZ /
07300 /
07400 ASCIZ2: ASCII /INC2=/
07500 PRNTO2: EXP 0
07600 ASCIZ /
07700 /
07800
07900 ;STUFF FOR JUSTIFICATION
08000
08090 IFN JUSTSW, <
08100 PMAR: 1 ;PARAGRAPH INDENTATION
08110 >; END OF IFN JUSTSW
08190 IFN JUSTSW!PPNTSW, <
08200 LMAR: 1 ;NORMAL INDENTATION (LEFT MARGIN)
08300 RMAR: ;RIGHT MARGIN
08400 MAXL: EXP ^D69 ;OTHERWISE KNOWN AS MAX LINE LENGTH
08410 >; END OF IFN JUSTSW!PPNTSW
08490 IFN JUSTSW, <
08500 MAXLN: <ASCII /99999/>!1 ;MAXIMUM LINE NUMBER ON A PAGE
08600 WTBL: .+1 ;FOR NOW, ALL CHARACTERS HAVE WIDTH 1
08700 1
08800 JFLOP: 1 ;FLIPFLOP FOR INSERTING BLANKS ON L OR R
08810 >; END OF IFN JUSTSW
08890 IFN JUSTSW!PPNTSW, <
08900 PAGESZ: EXP PGSZ
08910 >; END OF IFN JUSTSW!PPNTSW
08950
09000 PLINES: 20 ;DEFAULT VALUE FOR P CMD
09100 ESC: 33 ;DEFAULT ESCAPE CHAR
09105 IFN %SS025, <
09110 CHR128: EXP DFC128 ;CURRENT _C128 ESCAPE CHARACTER
09115 >; END OF IFN %SS025
09120 IFN %SS050, <
09125 CORSIZ: EXP DEFCOR ;CURRENT MINIMUM BUFFER SIZE, IN WORDS
09130 >; END OF IFN %SS050
09135
09140 IFN %SS052, <
09145 IFE DEFBLK, <
09150 FILFMT: XWD 0,-1 ;DEFAULT FILE FORMAT IS LINE-BLOCKED
09155 >; END OF IFE DEFBLK
09160 IFN DEFBLK, <
09165 FILFMT: EXP 2 ;DEFAULT FILE FORMAT IS COMPRESSED
09170 >; END OF IFN DEFBLK
09175 >; END OF IFN %SS052
09200 COMESS: ASCII /COMMAND # /
09300 COMCNT: EXP 0
09400 BYTE (7) 15,12
09500 LINOUT: EXP 0
09600 ASCIZ ./.
09700
09800 IFN CCLSW,<
09900 IFN TEMPC!%SS066,<
10000 T.HEAD: SIXBIT /EDS />
10100 T.IOWD: IOWD 20+.-.,CMDBUF ;** FIX **
10200 EXP 0
10205
10210 IFN %SS066, <
10215
10220 ; TMPCOR PARM LISTS & POINTERS TO FILENAME/IOWD FOR EACH *.TMP TYPE
10225
10230 XWD 2,S.HEAD ;-1, ADDRESS OF SAIL PARMS
10235 TS.DSP: XWD 1,T.HEAD ;0, ADDRESS OF NORMAL PARMS
10240
10245 S.HEAD: SIXBIT /EDT / ;SAIL TMPCOR CMD-FILE NAME
10250 S.IOWD: IOWD 17,CMDBUF+1 ;SAIL IOWD
10255 EXP 0
10260 >; END OF IFN %SS066
10300
10400 RPGR: SIXBIT /SYS/
10500 SIXBIT /COMPIL/
10600 EXP 0,0,0,0
10700 >
10800
10900 ;CONTROL BLOCK FOR CNTRL C TRAPPING
11000
11100 CNCBLK: 4,,CNCINT
11200 0,,1B34
11300 0
11400 0
11500 CNCLOK: -1 ;INTERLOCK FOR RE-ENTRANT HANDLING
11600
11700 IFN RENTSW,< DEPHASE >
11800 DATAE==.-1
11900
12000 ;MACRO TO GENERATE FILE-SPEC BLOCKS
12100
12200 DEV==0 ;DEVICE NAME INDEX (MUST BE A DISK)
12300 NAM==1 ;FILE NAME INDEX
12400 EXT==2 ;FILE EXTENSION (LH)
12500 PRT==2 ;FILE PROTECTION (RH)
12600 COD==3 ;ENCRYPTION PSW
12700 PTH==4 ;PATH AND PPN
12800
12900 DEFINE FILDES (F) <
13000 IRP F,<
13100 F'BLK==.
13200 F'DEV: BLOCK 1
13300 F'NAM: BLOCK 1
13400 F'EXT: BLOCK 1
13500 F'PRT==.-1
13600 F'COD: BLOCK 1
13700 F'PTH: BLOCK SFDLVL+1
13800 F'BKE==.-1>>
00100 ;REST IS RANDOM VARIABLES AND BUFFERS
00200
00300 IFN RENTSW,< RELOC DATABL+<DATAE-DATAB>+1 >
00400
00500 ZEROB==.
00600 BAKF: BLOCK 1 ;0 := NOBACKUP , -1 := BAK , +1 := OLD
00700 CREATF: BLOCK 1
00800 SVWD: BLOCK 1
00900 SVWD2: BLOCK 1
01000 SVWD3: BLOCK 1
01100 TMPT1: BLOCK 1
01200 DELETF: BLOCK 1 ;NON-ZERO FOR DELETE INPUT
01210 IFN %SS040, <
01220 EXACTF: BLOCK 1 ;NON-ZERO FOR /EXACT COMPARISON MODE
01230 >; END OF IFN %SS040
01300 BASICF: BLOCK 1
01400 UNSEQF: BLOCK 1
01500 RPGSW: BLOCK 1
01600 PZBEG==.
01700 IFN CRYPSW,<
01800 S.CRYP: BLOCK 10
01900 CODBUF: BLOCK 5
02000 >
02090 IFE %SS006, <
02100 MYPPN: BLOCK 1
02110 >; END OF IFE %SS006
02200 FILDES <ORG,NEW,TMP,ICR,OCR,IND,ALT>
02300
02400 PZEND==.-1
02500 FILDES <RUN>
02600 XBLOCK: BLOCK 4+<13*%SS006> ;FOR FILE OPS
02700 PTHADR: BLOCK <SFDLVL+4> ;FOR PATH UUO
02710 IFN %SS006, <
02720 DEFPTH: BLOCK <SFDLVL+4> ;FOR DEFAULT PATH
02730 DEFPRT: BLOCK 1 ;FOR DEFAULT PROTECTION
02740 MYPPN: BLOCK 1 ;MY PPN
02750 >; END OF IFN %SS006
02800 BUFHD: BLOCK 1 ;POINTER TO START OF EDIT BUFFER
02900 BUFP: BLOCK 1 ;POINTER TO CURRENT LOC IN EDIT BUFFER
03000 SSW: BLOCK 1
03100 RSW: BLOCK 1
03200 EDNAM: BLOCK 1
03300 EDBUF: BLOCK 1
03400 TMPCF: BLOCK 1
03500 CORTOP: BLOCK 1
03600 FILPT: BLOCK 1
03700 MAXWC: BLOCK 1 ;MAX FULL POINT IN EDIT BUFFER
03800 HLFWC: BLOCK 1 ;HALF FULL POINT IN EDIT BUFFER
03900 CLN: BLOCK 1 ;CURRENT LINE
04000 INCR: BLOCK 1
04100 CURINS: BLOCK 1
04200 CPG: BLOCK 1 ;CURRENT PAGE
04300 CPGL: BLOCK 1 ;LOGICAL CURRENT PAGE "/."
04400 IPG: BLOCK 1 ;INSERT PAGE
04402 IFN %SS017, <
04404 IINCR: BLOCK 1 ;SAVED INCR FROM LAST I CMD
04406 >; END OF IFN %SS017
04408 IFN %SS031, <
04410 BINCR: BLOCK 1 ;RAW BINARY INCREMENT AS COMPUTED
04412 TRMFLG: BLOCK 1 ; 0=ROUND INCR, -1=RAW INCREMENT
04414 >; END OF IFN %SS031
04416 IFN %SS032, <
04418 CURCMD: BLOCK 1 ;CURRENT COMMAND (L.H. -1 IF P<CR>)
04420 LSTCMD: BLOCK 1 ;PREVIOUS COMMAND ( DITTO )
04422 >; END OF IFN %SS032
04424 IFN %SS042, <
04426 USDOPT: BLOCK 1 ;BIT MAP FOR GIVEN COMMAND MODIFIERS
04428 >; END OF IFN %SS042
04430 IFN %SS040, <
04432 ALTSSG: BLOCK 1 ;ALTER SEARCH-STRING BUFFER
04434 >; END OF IFN %SS040
04436 IFN %SS055, <
04438 FNDFTN: BLOCK 1 ;CURRENT FIND-COMMAND FUNCTION
04440 ; SIGN-BIT ON IF PRE-PRINTING NOT REQ'D
04442 ; R.H. = ROUTINE ADDRESS TO CALL (0=NONE)
04444 >; END OF IFN %SS055
04446 IFN %SS061, <
04448 OLDPDS: BLOCK 1 ;OLD "DSKFUL" SETTING (IN SETUUO FMT)
04450 >; END OF IFN %SS061
04452
04454 IFN %SS066, <
04456 SAILSW: BLOCK 1 ;NON-ZERO FOR SAIL/CCL ENTRY
04458 >; END OF IFN %SS066
04460
04462 IFN %SS071, <
04464 FILSIZ: BLOCK 1 ;CURRENT ESTIMATED FILE SIZE (BLKS)
04466 >; END OF IFN %SS071
04468
04494 TTYPRM: BLOCK 2 ;TRMOP. OUTPUT-TESTING PARMS ;** FIX **
04496 TTYUDX==TTYPRM+1 ;TTY UDX FOR THIS JOB ;** FIX **
04498
04500 INPG: BLOCK 1 ;CURRENT INPUT PAGE SEEN
04600 OPG: BLOCK 1 ;COUNT OF PAGES OUTPUT
04700 WC: BLOCK 1 ;WORD COUNT IN EDIT BUFFER
04800 OLDLIN: BLOCK 1
04900 SSAVEN: BLOCK 1
05000 SAVEN: BLOCK 1
05100 SISAVN: BLOCK 1
05200 ISAVEN: BLOCK 1
05300 ALTSN: BLOCK 1 ;ALTMODE SEEN FLAG (I&R)
05400 ALTINC: BLOCK 1 ;ALTER MODE I CMD INCR
05500 ALTFLG: BLOCK 1
05600 CASEBT: BLOCK 1
05700 BGPG: BLOCK 1
05800 ACCUM: BLOCK 1
05900 SVT1E: BLOCK 1
06000 SVERN: BLOCK 1
06100 SAVCHR: BLOCK 1
06200 TECINC: BLOCK 1
06300 TECFST: BLOCK 1
06400 TEMINC: BLOCK 1
06500 REINC: BLOCK 1
06600 INCST: BLOCK 1
06700 REFST: BLOCK 1
06800 ALTCNT: BLOCK 1
06900 LOGPG: BLOCK 1
07000 LSTCNT: BLOCK 1
07100 SVCCNT: BLOCK 1
07200 SAVC: BLOCK 1
07300 IFN EXTEND,<
07400 LSHIPG: BLOCK 1
07500 LSHILN: BLOCK 1
07600 LSCNT: BLOCK 1
07700 LSPG: BLOCK 1
07800 LSBUF: BLOCK <SRBLG/5+2>*LSNUM
07900 LSPNT: BLOCK SRNUM*LSNUM
08000 >
08100 IFN LSTSW,< LOBUF: BLOCK 3 >
08200 LIMBO: BLOCK 1 ;LIMBO CHAR AFTER BELL
08300 CHIN: BLOCK 1 ;INPUT PNTR
08400 SVCCIN: BLOCK 1 ;SAVED INPUT ROUTINE FOR @ CMDS
08500 SVPCIN: BLOCK 1 ;SAVED INPUT ROUTINE FOR PARSE
08600 TTOBUF: BLOCK ^D80/5+1
08700 TTOCNT: BLOCK 1 ;OUTPUT CNTR
08800 TTOPNT: BLOCK 1 ;OUTPUT PNTR
08900 TTIBH: BLOCK 3 ;BUFFER RING HEADER
09000 TTIBUF: BLOCK 23 ;TTY INPUT BUFFER
09100 OBUF: BLOCK 4 ;DISK OUTPUT
09200 IBUF: BLOCK 4 ;DSK INPUT
09300 AUXFIL: BLOCK 1
09400 PDL: BLOCK PDLSIZ+1 ;PUSHDOWN LIST
09500 P.TEXT: BLOCK 1
09600 CMDBUF: ;COMMAND BUFFER
09700 LIBUF: BLOCK MXWPL+2 ;LINE INPUT BUFFER
09800 CRSX: BLOCK 1 ;PLACE FOR CR'S
09900 LIBUF2: BLOCK MXWPL+2
10000 IFN LSTSW,< LPTBUF: BLOCK 203>
10100 SVPT: BLOCK 1
10200 CODEBF: BLOCK 4*SRNUM+2
10300 BUFSAV: BLOCK 1
10400 STRNAM: BLOCK 5
10500 ARBBUF: BLOCK MXWPL*2+1
10600 ARBCNT: BLOCK 1
10700 SRHIPG: BLOCK 1
10800 SRHILN: BLOCK 1
10900 SRCNT: BLOCK 1
11000 SRBUF: BLOCK SRBLG/5+2
11100 SRPG: BLOCK 1
11200 SRPNT: BLOCK SRNUM
11300 BOTLIN: BLOCK 1
11400 PGDELS: BLOCK 1
11500 STARTD: BLOCK 1 ;WHERE TO START TO DELETE ON TRANSFER
11600 ENDD: BLOCK 1 ;WHERE TO END DELETING ON TRANSFER
11700 TRANST: BLOCK 1
11800 PGINSD: BLOCK 1
11900 DESTLN: BLOCK 1
12000 DESTPG: BLOCK 1
12100 ALTBF: BLOCK 3
12200 FINCR: BLOCK 1
12300 SINCR: BLOCK 1
12400 SVLNUM: BLOCK 1
12500 LSTPG: BLOCK 1
12600 SVJRL: BLOCK 1
12700 SVJRL2: BLOCK 1
12800 COPDL: BLOCK 1
12900 HIGH1: BLOCK 1
13000 NLIN1: BLOCK 1 ;# OF LINES ON FIRST PAGE OF C/T
13100 NLIN2: BLOCK 1 ;# OF LINES ON LAST PAGE OF C/T
13200 START2: BLOCK 1 ;STARTING LINE # FOR LAST PG OF C/T
13300 LSTLN: BLOCK 1 ;LAST LINE # SEEN DURING C/T
13400 PARCNT: BLOCK 1
13500 RPPG: BLOCK 1
13600 RPCNT: BLOCK 1
13700 FNDFLG: BLOCK 1
13800 R1BUF: BLOCK SRBLG/5+2
13900 R2BUF: BLOCK SRBLG/5+2
14000 RPHILN: BLOCK 1
14100 RPHIPG: BLOCK 1
14200 R1PNT: BLOCK SRNUM
14300 R2PNT: BLOCK SRNUM
14400 CCNT: BLOCK 1
14500 RSTRCT: BLOCK 1
14600 IFN JUSTSW,<
14700 OCNT1: BLOCK 1
14800 OPTR: BLOCK 1
14900 LINL: BLOCK 1
15000 LWRD: BLOCK 1
15100 WRDL: BLOCK 1
15200 TPNT: BLOCK 1
15300 ELIN: BLOCK 1
15400 TCHR: BLOCK 1
15500 WCNT: BLOCK 1
15600 BPW: BLOCK 1
15700 REM: BLOCK 1
15800 BLIN: BLOCK 1
15900 INDNT: BLOCK 1
16000 >
16100 SVOCIN: BLOCK 1
16200 OPTION: BLOCK 1
16300 OPTBHD: BLOCK 3
16400 OPTBUF: BLOCK 203
16500 COMBUF: BLOCK 203
16600 INDBUF: BLOCK 3
16700 SVALTP: BLOCK 1
16800 DPG: BLOCK 1
16900 SVINC: BLOCK 1
17000 SVCNT: BLOCK 1
17100 OCNT: BLOCK 1 ;OLD WC FOR INSED
17200 NCNT: BLOCK 1 ;NEW WC FOR INSED
17300 SRCALP: BLOCK 1
17400 VAR ;IF ANY (I HOPE THIS WORKS)
17500 ZEROE==.-1
17600 HILN: BLOCK 1 ;RESULTS OF RANGE PARSE
17700 HIPG: BLOCK 1 ; <LOLN>/<LOPG>:<HILN>/<HIPG>
17800 LOLN: BLOCK 1
17900 LOPG: BLOCK 1
18000 IMPEND:
18100 IFN RENTSW,< RELOC >
18200
18300
18400 END STPT