{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: EDWRITE867)}}
====== EDWRITE867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CURTAIL|CURTAIL]], [[george:macro:EDCOM|EDCOM]], [[george:macro:EDERR|EDERR]], [[george:macro:FI|FI]], [[george:macro:FIXTRA|FIXTRA]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNTW|HUNTW]], [[george:macro:IF|IF]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAME|NAME]], [[george:macro:OUTBLOCN|OUTBLOCN]], [[george:macro:OUTMON|OUTMON]], [[george:macro:OUTMONX|OUTMONX]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:PHOTO|PHOTO]], [[george:macro:READAGAIN|READAGAIN]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:STEP|STEP]], [[george:macro:TESTMOVE|TESTMOVE]], [[george:macro:TESTREP|TESTREP]], [[george:macro:THEN|THEN]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]]
22FL #LIS K0EDWRITE>K0ALLGEO>0
22LS ... SEG EDWRITE,867,COMM,,G571
22S2 ...[
22^8 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
236B ...[ THIS EXCLUDES CODE UNDER #SKI G571
23?J ...[
23DQ ...#OPT G571 = 0
23KY ...#SKI G571&1
23R6 ...# WITH UGUG EDIT M571 (IMPROVED EDIT AMORPHOUS FILE)
23YG #
24D6 # ENTRY POINT TABLE
24XQ #
25CB SEGENTRY K1EDWRITE,N1EDWRITE [WRITE RECORD TO NEW FILE
25X2 SEGENTRY K2EDWRITE,OH
26BL SEGENTRY K3EDWRITE,OH
26W= SEGENTRY K4EDWRITE,OH
27*W SEGENTRY K5EDWRITE,OH
27TG SEGENTRY K7EDWRITE,OH
28*6 SEGENTRY K8EDWRITE,OH
28SQ SEGENTRY K9EDWRITE,N9EDWRITE [F INSTRUCTION
29#B SEGENTRY K10EDWRITE,N10EDWRITE [OUTPUT FOR W-FACILITY
29S2 SEGENTRY K11EDWRITE,N11EDWRITE [JOB ABANDONED ACTION
2=?L OH GEOERR 1,EDWRITE
2=R= #
2?=W MNUM #32657713 [MAGIC NUMBER
2?QG SPWRD #40772020 [@_ PRECEDES W LISTINGS
2#=6 #
2#PQ # RLOF RELOCATES THE OLD FILE BLOCK
2*9B #
2*P2 RLOF LDX 5 IEOM(2) [GET BLOCK PHOTO
2*YS LDX 3 IEOA(2)
2B8L TESTMOVE 5,RO1 [J IF STILL THERE
2BN= MHUNTW 3,EDIT,FRB [ELSE FIND IT
2C7W PHOTO 5 [GET NEW PHOTO
2CMG STO 5 IEOM(2) [AND STORE
2D76 STO 3 IEOA(2) [STORE ADDRESS
2DLQ RO1 EXIT 6 0 [AND EXIT
2F6B #
2FL2 #
2G5L # RLNF RELOCATES THE NEW FILE BLOCK.
2GK= #
2H4W RLNF LDX 5 IENM(2) [GET BLOCK PHOTO
2H#N LDX 3 IENA(2)
2HJG TESTMOVE 5,RN1 [J IF STILL THERE
2J46 MHUNTW 3,FILE,FAPB [ELSE FIND IT
2JHQ PHOTO 5 [GET NEW PHOTO
2K3B STO 3 IENA(2) [STORE ADDRESS OF BLOCK
2KH2 STO 5 IENM(2) [STORE PHOTO OF BLOCK
2L2L RN1 EXIT 6 0 [AND EXIT
2LG= #
2L^W #
2MFG SETAPPEND [SETS APPEND POINTERS = READ PTRS FOR NEWFILE
2M^6 #
2NDQ CURTAIL [NEWFILE AT LEVEL 0
2NYB EXIT 6 0
2PD2 #
2PXL #
2QC= # K1EDWRITE IS THE ENTRY POINT FOR WRITING A RECORD TO
2QWW # THE NEW FILE. THE RECORD IS LISTED TO THE MONITORING
2RBG # FILE IF REQUIRED
2RW6 # EXTREME OVERSIGHT ON MY PART I WROTE THE SPECIFICATION TO ALLOW
2S*Q # FOR ANY SORT OF FILE TO BE USED BY THE EDITOR. THE FOLLOWING CODE,
2STB # WHICH IS AS NASTY AS THE SYNTAX ANALYSIS ROUTINES IN EDITOR ARE
2T*2 # BEAUTIFUL, REPRESENTS THE ALMOST UNBELIEVABLE MESS THAT THE
2TSL # DESIGNERS OF GEORGE 3 HAVE MADE OF PERIPHERAL FILES. (THE FILE-
2W#= # STORE WAS ACTUALLY DESIGNED?)
2WRW # BE CONSOLED BY THE THOUGHT THAT THE PAPER TAPE MODE CONVERSION
2X?G # IS NOT NEEDED HERE THANKS TO LADISLAV KUTILECK'S CUNNING ROUTINES
2XR6 # EXIT IF FILE FULL OR B. S. LIMIT: UP
2Y=Q # EXIT IF BREAK-IN UPPLUS 1
2YQB # EXIT IF OK UPPLUS 2
2^=2 #
2^PL # NOW READ ON - -
329= #
32NW N1EDWRITE
338G #
33N6 BVSR £ [MAKE SURE V IS CLEAR
347Q CALL 6 RLNF [GET OUTPUT BLOCK AGAIN.
34MB WR6 LDX 5 BITS22LS [NOW WE HAVE TO SET
3572 LDX 6 IENC(2) [UP THE FILESTORE
35LL BXL 6 IENH(2),WR60 [RED TAPE WORDS,
366= BXE 6 IENH(2),WR60 [LOPPING OFF
36KW BVCI £ [AT MAXIMUM LENGTH
375G LDX 6 IENH(2) [IF REQUIRED
37K6 STO 6 IENC(2)
384Q WR60 LDN 7 0 [AND SETTING UP THE
38JB SRL 67 2 [PECULIAR FORMAT
3942 BZE 7 WR7 [ADDING IN FOR ALL
39HL ADN 6 1 [MANNER OF THINGS
3=3= #SKI JDIAG1
3=GW (
3?2G WR7 ADX 6 IENG(2) [SET RECORD HEADER LENGTH
3?G6 SBN 6 A1 [WE MUST NOT OVERWRITE
3?^Q )
3#FB #SKI JDIAG1<1$1
3#^2 WR7 ADN 6 2 [WE MUST NOT OVERWRITE
3*DL LDX 3 IENA(2) [BITS 2 TO 23 OF THE
3*Y= ANDS 5 A1+1(3) [SECOND WORD BECAUSE
3BCW STO 6 A1(3) [WE HAVE MOST PAINFULLY
3BXG ORS 7 A1+1(3) [PUT THEM THERE
3CC6 LDX 0 A1+1(3) [CHECK IF PFCC TO BE CHANGED
3CWQ LDX 5 IEPF(2)
3DBB BNG 5 WR7A [J IF NOT
3DW2 SRL 0 6
3F*L SLL 0 6
3FT= ORX 0 5 [RESET
3G#W STO 0 A1+1(3)
3GSG WR7A STO 0 AWORK1(2) [SAVE 2ND RED TAPE WORD
3H#6 BZE 7 WR71 [J IF INTEPRAL NUMBER OF WORDS
3HRQ ADS 6 3 [END ADDRESS OF BLOCK
3J?B ADN 3 A1-1 [ADJUST FOR RED TAPE
3JR2 ORS 7 3 [SET CHARACTER ADDRESS
3K=L SLC 7 2 [CONVERT TO COUNT WHICH
3KQ= LDN 5 #20 [IS COMPLEMENT
3L9W SBN 7 4 [CONVERT TO NEGATIVE COUNT
3LPG WR70 DCH 5 0(3) [SPACE FILL THE LAST
3M96 BCHX 3 £ [WORD OF THE RECORD
3MNQ ADN 7 1 [INCREMENT COUNT AND
3N8B BNZ 7 WR70 [LOOP UNTIL FULL
3NN2 WR71 BVCR WR8 [J IF LENGTH WAS OK
3P7L EDCOM YRTL [ELSE COMMENT ON THE CHOPPING
3PM= WR8 CALL 6 RLNF [GET FAPB
3Q6W CALL 6 RLOF
3QLG LDX 3 IENA(2)
3R66 STO 3 5
3RKQ LDX 7 A1(3)
3S5B #SKI JDIAG1
3SK2 (
3T4L LDN 4 #4
3TJ= ANDX 4 IESW(2)
3W3W BZE 4 NOTG [J IF NOT GEDIT
3WHG SMO IEOA(2)
3X36 LDX 4 A1+2 [PASS ACROSS
3XGQ STO 4 A1+2(3) [SEQUENCE WORD
3Y2B NOTG
3YG2 )
3Y^L CALL 6 SETAPPEND [SET APPEND PTRS = READ PTRS
3^2H ...#SKI G571&1
3^3D ...(
3^4* ... LDN 6 0
3^5= ... IF +IEOT(2),ZE [ NEWFILE AMORPHOUS
3^67 ... THEN
3^74 ... LDN 6 1
3^7^ ... SBN 7 1
3^8W ... IF 6,E,7 [ EMPTY RECORD, X7=1
3^9R ... THEN
3^=N ... LDX 0 ACES
3^?K ... LDN 7 2 [ SET TO 4 SPACES
3^#G ... SMO 5
3^*C ... STO 0 A1+2
3^B# ... FI
3^C9 ... FI
3^D6 ...)
3^F= LDX 2 7
3^YW STEP ,0(2),WRBI
42DG STO 3 4
42Y6 LDX 3 5
43CQ TESTREP FILEFULL,WR9 [J IF FILE FULL
43XB TESTREP REFUSED,WR90 [J IF NO MORE B. S.
44C2 TESTREP OK,WR8A [J IF NOT COORDINATED
44WL MHUNTW 3,FILE,FAPB
45B= WR8A ADN 3 A1
45DT ...#SKI G571&1
45HD ...(
45L3 ... ADX 3 6 [ IF AMORPHOUS, OVERWRITE
45NL ... STO 7 0(3) [ 2ND RED TAPE WORD WITH 1ST
45R9 ...)
45TW SMO 7
46*G MOVE 3 0 [MOVE DATA
46T6 STEP [UPDATE READ PTRS
47#Q LDX 0 IENR(2) [GET REC COUNT INTO X0
47SB LDX 6 IESW(2) [COLLECT SWITCH WORD
482L ... BXL 0 IENL(2),WR10 [J IF NO. OF RECORDS < LIMIT
488W ... LDCT 6 #400 [SET LIMIT MESSAGE MARKER
48C6 ... ORS 6 IENL(2)
48KB ... BRN WR9A
48RL WR9 STOZ IENL(2)
49?= WR9A LDX 6 IESW(2)
49QW WR10 LDX 5 IENC(2) [KEEP NUMBER OF CHARACTERS
4==G STOZ IENC(2) [CLEAR COUNT
4=Q6 BPZ 6 WR13 [J IF NOT LISTING
4?9Q LDCT 7 #200 [ELSE WE ARE LISTING SO...
4?PB ANDX 7 IESW(2)
4#92 SLC 7 5
4#NL ADX 5 7 [USING THE NUMBERING SWITCH BIT
4*8= ERN 7 #10 [ADJUST CHARACTER COUNT AND START
4*MW STO 5 AWORK2(2) [ADDRESSES SO THAT IT WORKS OUT
4B7G SRL 7 2 [CORRECTLY. THIS AVOIDS A RATHER
4BM6 LDN 5 A1 [MESSY BIT OF CODE
4C6Q STO 7 AWORK3(2) [STORE CALCULATED
4CLB ADS 5 AWORK3(2) [VALUES
4D62 CALL 6 RLNF [RELOCATE OUTPUT BLOCK
4DKL LDN 1 0 [NEEDED BY NS SP CHOPPER
4F5= BNZ 7 WR12 [J IF NOT NUMBERING
4FJW LDX 7 IENR(2) [AND OVERWRITE THE RED TAPE
4G4G SMO FX1 [WORDS WITH
4GJ6 MPY 7 MNUM [THE DECIMAL
4H3Q LDX 1 IENA(2) [RECORD NUMBER. WE HAVE TO
4HHB #SKI JDIAG1
4J32 (
4JGL ADX 1 IENG(2)
4K2= SBN 1 A1+2
4KFW )
4K^G MODE 1 [ALLOW FOR THE FACT THAT
4LF6 LDN 5 6 [THE FIRST RECORD IS NUMBER
4LYQ WR11 CBD 7 A1(1) [ZERO, ALSO THAT THE NUMBER
4MDB BCHX 1 £ [FIELD IS SEVEN CHARACTERS
4MY2 BCT 5 WR11 [SO WE HAVE TO INSERT AN EXTRA
4NCL MODE 0 [SPACE AT THE END.
4NX= LDN 6 #20
4PBW CBD 7 A1(1) [HAVING DONE THAT WE MUST NOW
4PWG BCHX 1 £ [SET UP FOR THE LISTING (LISTING
4QB6 DCH 6 A1(1) [CATEGORY IS 4) PS ARE THERE
4QTQ NGN 1 8 [NEEDED BY NS SP CHOPPER
4R*B WR12 LDN 7 4 [STILL REDUNDANT WORDS IN THE
4RT2 LDX 3 IENA(2) [NOW TO LOP OFF TRAILING
4S#L ADX 1 AWORK2(2) [SPACES. DONE HERE
4SS= ADN 1 3 [BY SCANNING
4T?W SRL 1 2 [BLOCK BACKWARDS
4TRG LDN 4 0 [AND COUNTING
4W?6 #SKI JDIAG1
4WQQ (
4X=B ADX 1 3
4XQ2 ADX 1 IENG(2)
4Y9L SBN 1 1 [THE NUMBER
4YP= )
4^8W #SKI JDIAG1<1$1
4^NG ADN 1 A1+1(3) [THE NUMBER
5286 LDX 5 ACES [OF WORDS OF SPACES
52MQ WR21 BXU 5 0(1),WR22 [J NOT SPACE
537B ADN 4 1 [COUNT
53M2 SBN 1 1 [ADDRESS
546L BRN WR21 [LOOP
54L= WR22 LDX 5 AWRK2(2) [SO GET LENGTH OF RECORD
555W LDX 1 AWRK3(2) [ROUND UP TO WORDS
55KG #SKI JDIAG1
5656 (
56JQ ADX 1 IENG(2)
574B SBN 1 A1+2
57J2 )
583L ADN 5 3 [AND SUATRACT THE NUMBER OF
58H= SRL 5 2 [WORDS WITH SPACES THEN
592W SBS 4 5 [CONVERT BACK TO CHARACTERS
59GG SLL 5 2 [C_ULD BE A REC-RD TH_T
5=26 BPZ 5 WR23 [IS ALL SPQACES AND A NON-
5=FQ LDN 5 0 [INTEGRAL NNUMBER OF WORDS
5=^B WR23 OUTMON 5,0(1),7,FILE,FAPB [SOCK IT TO CLKENT
5?F2 WR13 CALL 6 RLNF [FIND THE OUTPUT
5?YL LDX 5 AWORK1(2) [GET THE PFCC FROM THE
5#D= LDX 3 IENA(2) [FILE FAPB AND PUT IT
5#XW LDN 4 1 [OF O/P'S RED TAPE
5*CG #SKI JDIAG1
5*X6 STOZ A1+2(3) [NULL OUT SEQUENCE WORD
5BBQ STO 5 A1+1(3) [INCREMENT RECORD
5BWB LDX 0 IENL(2) [NUMBER AND CHACK THAT
5CB2 ADS 4 IENR(2) [THE NEW FILE IS NOT FULL
5CH8 FIXTRA ESP [****EDITOR SPECIAL FOR PLESSEY****
5CNB NULL
5CTL BNZ 0 WR14 [J NOT FULL
5D*= EDERR YFYN ['YOUV'E FILLED YOUR NEW FILE'
5DSW UP [SHUTDOWN EXIT
5F#G ...WR14 BNG 0 WR15 [J IF REFUSED OR LIMIT EXCEEDED
5FS6 UPPLUS 2 [EXIT IN GOOD ORDER
5FWP ...WR15 LDCT 0 #400 [UNSET REFUSED OR LIMIT EXCEEDED
5F^# ... ERX 0 IENL(2)
5G3X ... BZE 0 WR17 [J IF BS LIMIT REACHED
5G6G ... BXE 0 AZVOLUME,WR16 [J IF LIMIT IS IP VOLUME
5G95 ... EDERR YESL ['YOU'VE EXCEEDED YOUR SPECIFIED
5G?N ... [LIMIT'
5GB? ... UP [SHUTDOWN EXIT
5GDW ...WR16 EDERR YEDL ['YOU'VE EXCEEDED INSTALLATION
5GHF ... [DEFAULT LIMIT'
5GL4 ... UP [SHUTDOWN EXIT
5GNM ...WR17 EDERR YBSL ['YOU'VE REACHED YOUR BS LIMIT'
5GRB UP [SHUTDOWN EXIT
5H?2 #
5HQL WR90 LDCT 7 #400 [IF REFUSED,SET
5J== STO 7 IENL(2) [B0 OF IENL
5JPW BRN WR9A [AND CONTINUE
5K9G #
5KP6 # IF BREAK-IN WHILE WAITING FOR BACKING STORE:
5L8Q WRBI UPPLUS 1 [TERMINATING EXIT
5LNB #
5M82 #
5MML #
5N7= #
5NLW # FILE REPOSITION ROUTINE
5P6G # X = REQURED POSITION Y = CURRENT POSITION
5PL6 # FILE NUMBER IS IN AWORK1
5Q5Q # NB NO ADVANTAGE IS TAKEN OF THE FACT THAT WE
5QKB # COULD REWIND THE FILE BECAUSE WE MAY NOT
5R52 # ACTUALLY HAVE THE ABSOLUTE RECORD NUMBERS
5RJL #
5S4= REPO LDX 1 AWORK1(2)
5SHW SBX 6 FX1 [RELATIVISE LINK
5T3G SLL 1 1
5TH6 ADX 1 2
5W2Q LDX 0 IENZ+1(1) [SWITCH CHARACTER POINTERS
5WGB STO 0 IENC(1)
5X22 LDX 7 IENR(1)
5XFL LDX 0 IENZ(1) [SWITCH RECORD POINTERS
5X^= STO 0 IENR(1)
5YDW BXE 0 7,REPEX [J IF X = Y
5YYG BXL 0 7,REP3 [J IF X Y AND FORWARDS
5^XQ STO 0 7 [SO MUST BE OLD FILE
62CB REP1 LDX 1 AWORK1(2)
62X2 STEP 0(1)
63BL BZE 3 REP2 [J IF HIT EOF
63W= BCT 7 REP1
64*W BRN REP6
64TG REP2 LDCT 4 #4 [SET EOF BIT
65*6 ORS 4 IESW(2)
65SQ BRN REP6
66#B REP3 SBX 7 0 [X7 = Y-X
66S2 LDX 1 AWORK1(2)
67?L BZE 1 REP4 [J IF NEW FILE
67R= LDCT 4 #4 [ELSE OLD FILE SO
68=W ORS 4 IESW(2) [CLEAR EOF BIT
68QG ERS 4 IESW(2)
69=6 BRN REP5
69PQ REP4 SBN 7 1 [X7-1 BSP'S FOR N/F
6=9B BZE 7 REP6 [J IF NONE
6=P2 REP5 LDX 1 AWORK1(2)
6?8L BACKSPACE 0(1)
6?N= BCT 7 REP5
6#7W REP6 LDX 1 AWORK1(2)
6#MG READAGAIN 0(1) [BSP + READ
6*76 MHUNTW 3,FILE,FRB
6*LQ NAME 3,EDIT,FAPB
6B6B REPEX ADX 6 FX1
6BL2 EXIT 6 0
6C5L #
6CK= #
6D4W # THIS CODE EXECUTES GRUEL'S F(*CK) INSTRUCTION
6DJG #
6F46 N9EDWRITE
6FHQ #
6G3B LDN 6 #3 [SEE IF F IS CURRENTLY
6GH2 ANDX 6 IESW(2) [ALLOWED
6H2L BZE 6 UCKER [J IF SO
6HG= LDN 6 1
6H^W ORS 6 IESW(2)
6JFG EDCOM TWOF [ERROR MESSAGE
6J^6 BRN NCK [J TO NEXT INSTRUCTION
6KDQ UCKER LDN 6 1 [SET BIT TO SHOW WE HAVE
6KYB ORS 6 IESW(2) [JUST ENTERED F MODE
6LD2 STOZ AWORK1(2) [FIRST DO NEW FILE
6LXL CALL 6 REPO
6MC= HUNTW 3,EDIT,FAPB [SEE IF WE HAVE TO SWAP BLOCKS
6MWW BNG 3 UCK [J IF NOT
6NBG MFREEW FILE,FAPB
6NW6 NAME 3,FILE,FAPB [SWAP BLOCKS
6P*Q STO 3 IENA(2)
6PTB PHOTO 5 [RESET WHERE AND WHEN
6Q*2 STO 5 IENM(2)
6QSL BACKSPACE [GET POINTERS CORRECT
6R#= LDX 7 IENR(2) [TO PUT IN EOF MARKER
6RRW BZE 7 RCK1 [SKIP IF BOF
6S?G READAGAIN [BSP+READ
6SR6 MHUNTW 3,FILE,FRB
6T=Q ADN 3 A1 [GET PTR TO RECORD
6TQB LDX 5 3 [SAVE
6W=2 BRN RCK2
6WPL RCK1 STEP [DONT BSP IF BOF
6X9= RCK2 LDEX 4 0(3) [GET LENGTQ LAST RECORD
6XNW BACKSPACE [REPOSITION FOR REWRITING
6Y8G CALL 6 SETAPPEND [RESET APP PTRS TO READ PTRS
6YN6 LDX 2 4 [STORED LENGTH
6^7Q STEP ,0(2),UCK [GET PTR INTO FUWB
6^MB BZE 7 RCK3 [J IF BOF
7272 SMO FX2
72LL LDX 0 IENM
736= TESTMOVE 0,RCONT
73KW MHUNTW 2,FILE,FRB [RE-FIND RECORD
745G ADN 2 A1
74K6 BRN RCONTA
754Q RCONT LDX 2 5
75JB RCONTA SMO FRH(2) [REWRITE RECORD
7642 MOVE 2 0 [AT END OF FILE
76HL SBN 2 A1
773= FREECORE 2 [FREE TEMPORARY BLOCK
77GW STEP [UPDATE READ PTRS
782G BRN UCK
78G6 RCK3 STOZ 0(3)
78^Q UCK LDN 6 1 [NOW DO OLD FILE
79FB STO 6 AWORK1(2)
79^2 CALL 6 REPO
7=DL HUNTW 3,EDIT,FAPB [SEE IF WE HAVE TO SWAP BLOCKS
7=Y= BNG 3 NCK [J IF NOT
7?CW NAME 3,EDIT,FRB
7?XG PHOTO 5
7#C6 STO 3 IEOA(2) [RESET WHERE AND WHEN
7#WQ STO 5 IEOM(2)
7#X9 ...#SKI G571&1
7#XN ...(
7#Y7 ... LDXC 0 IEOT(2)
7#YL ... BCS UCK3
7#^5 ... LDEX 6 A1(3)
7#^J ... LDN 4 1
7*23 ... ADX 4 6
7*2G ... LDX 7 ALOGLEN(3)
7*2^ ... BXGE 7 4,UCK1
7*3D ... ALTLEN 3,4
7*3X ... MHUNTW 3,EDIT,FRB
7*4B ... STO 3 IEOA(2)
7*4T ... PHOTO 5
7*5# ... STO 5 IEOM(2)
7*5R ...UCK1
7*6= ... LDN 0 #41
7*6P ... STO 4 A1(3)
7*78 ... SBN 4 2
7*7M ... BZE 4 UCK2
7*86 ... LDN 6 A1(3)
7*8K ... LDN 7 A1+1(3)
7*94 ... ADX 6 4
7*9H ... ADX 7 4
7*=2 ...UCK1A
7*=F ... MOVE 6 1
7*=Y ... SBN 6 1
7*?C ... SBN 7 1
7*?W ... BCT 4 UCK1A
7*#* ...UCK2
7*#S ... STO 0 A1+1(3)
7**? ...UCK3
7**Q ...)
7*BB LDEX 6 A1(3)
7*W2 LDX 7 A1+1(3) [NOW WE HAVE TO FIND
7B*L ANDX 7 CACT [HOW MANY CHARACTERS
7BT= SBN 6 3 [THERE WERE IN THAT
7C#W BNZ 7 NCK1 [BLOCK AND RESET IEOH
7CSG ADN 6 1
7D#6 NCK1 SLL 67 2
7DRQ #SKI JDIAG1
7F?B (
7FR2 LDN 4 #4
7G=L ANDX 4 IESW(2)
7GQ= BZE 4 NOG [J IF NOT GEDIT
7H9W LDX 4 A1+2(3)
7HPG STOZ A1+2(3) [NULL SEQUENCE WORD AS DEFAULT
7J96 STO 4 IESD(2) [SAVE NEW SEQUENCE WORD
7JNQ SBN 6 8 [TAKE ACCOUNT OF EXTRA WORDS
7K8B NOG
7KN2 )
7L7L STO 6 IEOH(2)
7LM= NCK UP
7M6W #
7MLG # THIS CODE CAUSES THE CURRENT RECORD IN THE OLDFILE TO BE LISTED, I.E.
7N66 # IT'S THE OUTPUT FOR THE W-FACILITY
7NKQ N10EDWRITE
7P5B LDCT 7 #4 [FIRST CHECK THAT WE ARE NOT
7PK2 ANDX 7 IESW(2) [TRYING TO W FROM OFF EOF
7Q4L BNZ 7 WR103 [J IF WE ARE
7QJ= LDX 3 IEOA(2)
7R3W LDX 7 IEOM(2)
7RHG TESTMOVE 7,WR100 [CHECK IF BLOCKS MOVED
7S36 MHUNTW 3,EDIT,FRB
7SGQ PHOTO 7
7T2B STO 3 IEOA(2) [UPDATE BLOCK ADDRESS AND
7TG2 STO 7 IEOM(2) [COUNT OF BLOCKS MOVED
7T^L #SKI JDIAG1
7WF= (
7WYW WR100 LDX 4 IEOG(2)
7XDG SBN 4 A1+2
7XY6 SMO 4
7YCQ LDX 0 A1+1(3)
7YXB STO 0 AWORK1(2) [SAVE REDTAPE WORD
7^C2 LDX 0 A1+1(3)
7^WL )
82B= #SKI JDIAG1<1$1
82TW WR100 LDX 0 A1+1(3) [STORE RED TAPE TEMPORARILY
83*G LDN 7 0
83T6 #SKI JDIAG1<1$1
84#Q STO 0 AWRK1(2)
84SB SLL 70 2 [GET CHAR POINTER
85#2 LDX 5 SPWRD(1)
85RL LDEX 0 A1(3) [RECORD LENGTH IN WORDS
86?= #SKI JDIAG1
86QW SMO 4
87=G STO 5 A1+1(3)
87Q6 ADN 3 A1-1
889Q ADX 3 0 [X3 => LAST WORD IN RECORD
88PB WR101 LDX 6 0(3) [WE NOW SCAN THE RECORD BACKWARDS
8992 BXU 6 ACES,WR102 [CHOPPING OFF TRAILING SPACES
89NL SBN 3 1 [LOSES SPACE WORDS
8=8= LDN 7 0 [END CHARS DON'T MATTER
8=MW BRN WR101
8?7G WR102 SBX 3 IEOA(2)
8?M6 #SKI JDIAG1
8#6Q SMO 4
8#LB SBN 3 A1
8*62 SLL 3 2
8*KL BZE 7 WR104 [NO ODD CHARS AT END
8B5= ADX 3 7 [ELSE ADJUST
8BJW SBN 3 4 [CHARACTER COUNT
8C4G WR104 LDN 5 4 [X5 = %C OF OUTMON(CATEGORY)
8CJ6 #SKI JDIAG1
8D3Q (
8DHB SMO 4
8F32 LDN 6 A1+1 [START ADDRESS
8FGL OUTMONX 3,6,5,EDIT,FRB
8G2= )
8GFW #SKI JDIAG1<1$1
8G^G OUTMON 3,A1+1,5,EDIT,FRB
8HF6 LDCT 7 #20
8HYQ ORS 7 IESW(2) [SET B4 TO SHOW LISTED
8JDB MHUNT 3,EDIT,FRB
8JY2 LDX 0 AWRK1(2)
8KCL #SKI JDIAG1
8KX= SMO 4
8LBW STO 0 A1+1(3) [REPLACE RED TAPE
8LWG WR103 UP
8MB6 #
8MTQ # THIS IS ACTION FOR JT EXCEEDED OR JOB ABANDONED
8N*B #
8NT2 N11EDWRITE
8P#L OUTBLOCN 6
8PS= OUTNUM IEOR(2),0 [PARAMETERS FOR
8Q?W OUTNUM IENR(2),0 [MONOUT
8QRG MONOUT FILEUP [MESSAGE SAYS WHERE EDIT HALTED
8R?6 EDERR EDAB ['EDIT ABANDONED'
8RQQ LDCT 0 #400 [SWITCH OFF L
8S=B ORS 0 IESW(2)
8SQ2 ERS 0 IESW(2)
8T9L ACROSS EDITPT,2 [SIMULATE 'E'
8TP= #
8W8W MENDAREA 100,K100EDWRITE
8WNG #END
^^^^ ...00063062000500000000