{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: IPBLISTB867)}}
====== IPBLISTB867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:CHAIN|CHAIN]], [[george:macro:COOR1|COOR1]], [[george:macro:EMPTY|EMPTY]], [[george:macro:FPUT|FPUT]], [[george:macro:HUNT2|HUNT2]], [[george:macro:HUNTW|HUNTW]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JBWS|JBWS]], [[george:macro:LBW|LBW]], [[george:macro:LFBBS|LFBBS]], [[george:macro:LFBBUS|LFBBUS]], [[george:macro:LFBITCLR|LFBITCLR]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:PHOTO|PHOTO]], [[george:macro:REM|REM]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:TESTMOVE|TESTMOVE]]
22*P ... SEG IPBLISTB,,,,G170 [R.WEYAND
22PD # (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982.
22^= #LIS K0IPBLISTB>K0IPB>K0ALLGEO
2357 ...#OPT G170 = 0
2394 ...#SKI G170&1
23#^ ...# WITH UGUG EDIT M170 (CHANGE REMOTE *LP WIDTHS.)
23YG #
24D6 SEGENTRY K1IPBLISTB,SK1IPBLISTB
24XQ SEGENTRY K2IPBLISTB,SK2IPBLISTB
25CB SEGENTRY K3IPBLISTB,SK3IPBLISTB
25PQ SEGENTRY K4IPBLISTB,SK4IPBLISTB
25X2 #
266S #DEF SAFETMARGIN=5
26W= SEMP 20H SETUP FILE EMPTY
27*W PCONT #20203576,#32000000
27TG SDEL #76
28*6 SHIFT #74
28SQ SPACE #20
294J XDC3 #76357603 [CR + DC3
29#B PMAGIC +7036875 [2**46/10**7
29S2 PRINT #76327632,#76207620,#76207620
2=?L SHTAB #763173
2=R= STESC #76130075
2?5L PAGESEQ #76007631,#763500
2?8= XMSK #77700037
2?=W #
2?#D [
2?F6 RECHE [SEE IF RESD ERROR ON STEP
2?GN LFBBUS M,2,(7) [J IF NO READ ERROR
2?J= STO 4 IWORK15(2)
2?KS LDN 3 0
2?MB BRN WOBL [J TO CLEAR UP IOUT
2?QG # ROUTINE TO SEE WHETHER RECORD WILL FIT ON ONE LINE ; ON EXIT X5
2#=6 # CONTAINS "A7021WIDTH-4" IF MORE THAN 1 LINE, SIZE OF RECORD IF LESS
2#PQ #
2*9B REM LDX 5 IWORK13(1)
2*P2 SRC 5 1
2B8L BPZ 5 NOTS [SPECIAL NOT REQUESTED
2BN= SBN 3 1 [MOVE RECORD POINTER FOR SPECIAL
2C7W NOTS SLC 5 3
2CMG ANDN 5 12 [EXTRA WORDS FOR SPECIAL AND NUMBER
2D76 ADX 5 ACOMMUNE5(1)
2DLQ SEGENTRY K50IPBLISTB
2DN^ ...#SKI G170&1
2DR8 ...(
2DTC ... SBX 5 IWIDTH(1)
2DXL ... SBN 5 1
2D^T ...)
2F44 ...#SKI G170&1$1
2F6B SBN 5 A7021WIDTH+1
2FL2 BNG 5 SMALL [RECORD LESS THAN ONE LINE
2G5L ADN 5 5 [ADD 5 CHARS FOR CONTINUATION MARKER
2GK= DSA 5 IWORK9(1) [PRESERVE REMAINDER COUNT
2H4W SEGENTRY K52IPBLISTB
2H75 ...#SKI G170&1
2H9# ...(
2H?H ... LDX 5 IWIDTH(1)
2H*Q ... SBN 5 4
2HC^ ...)
2HG8 ...#SKI G170&1$1
2HJG LDN 5 A7021WIDTH-4
2J46 STO 5 IWORK20(1) [INITIALISE 'LAST SPACE ' MARKER
2JHQ LDX 4 GSIGN [TO PRESERVE POINTERS AFTER SPACES
2K3B EXIT 7 0
2KH2 SEGENTRY K51IPBLISTB
2KK9 ...#SKI G170&1
2KMD ...(
2KPM ...SMALL ADX 5 IWIDTH(1)
2KRW ... ADN 5 1
2KW5 ...)
2KY# ...#SKI G170&1$1
2L2L SMALL ADN 5 A7021WIDTH+1
2LG= LDN 4 0 [NO CONTINUATION AT END OF LINE
2L^W EXIT 7 0
2MFG #
2M^6 # STORE SPACES OR HORIZONTAL TAB CHARACTERS ; NO OF SPACES IN X7
2NDQ #
2NYB STOSP LDX 1 FX2
2PD2 STOZ ACOMMUNE4(1)
2PXL STO 3 IWORK18(1) [PRESERVE RECORD POINTER
2QC= BPZ 4 SAC [LAST LINE OF RECORD
2QWW STO 6 IWORK19(1)
2RBG STO 5 IWORK20(1) [PRESERVE COUNTS AND DCH POINTER
2RW6 SAC SBN 6 3
2S*Q BNG 6 OPUND [NOT ENOUGH ROOM IN THIS NPU
2STB BZE 6 OPUND
2T*2 LDX 3 7
2TSL SBN 7 3
2W#= BPZ 7 SPAN [MORE THAN 2 SPACES : USE HORIZ. TAB
2WRW SBX 6 7
2X?G LDN 1 ACES
2XR6 MVCH 1 0(3) [INSERT 1 OR 2 SPACES
2Y=Q BRN STLS
2YQB SPAN SMO FX1
2^=2 LDX 3 SHTAB [#763173
2^PL LDN 1 3
329= BCHX 1 £
32NW SBN 7 24
338G BPZ 7 STAB [>26 SPACES : INSERT 27 FOR PRESENT
33N6 ADX 3 7 [<27 SPACES : FINAL HORIZ. TAB
347Q STAB MVCH 1 3 [INSERT HORIZONTAL TAB CHARS
34MB BZE 7 STLS [EXACTLY 27 SPACES
3572 BPZ 7 SAC
35LL STLS SMO FX2
366= LDX 3 IWORK18 [RETRIEVE RECORD POINTER
36KW SMO FX2
375G STO 2 ACOMMUNE6 [PRESERVE DCH POINTER
37K6 SMO FX2
384Q STO 6 IWORK19 [UPDATE COUNT OF IOUT UNUSED CHARS
38JB LDX 1 FX1
3942 EXIT 0 0
39HL #
3=3= # RE-FIND BLOCK IF IT MOVES DURING ALTLENG
3=GW #
3?2G RFND MHUNTW 2,ADATA,ACONV
3?G6 EXIT 1 0
3?^Q #
3#FB # GET AMXOR/IOUT BLOCK FOR OUTPUT ; WORD COUNT IN X3 ON ENTRY
3#^2 #
3*DL SAMIO LDXC 3 AWORK1(2)
3*Y= SRL 3 12
3BCW LDX 6 3
3BXG SBN 6 SAFETMARGIN
3CC6 SRL 3 2
3CWQ SETU SBX 7 FX1
3DBB ... SETNCORE IDATA-A1(3),2,AMXOR,IOUT
3DW2 SMO FX2
3F*L STO 2 ACOMMUNE2 [PRESERVE AMXOR/IOUT ADDRESS
3FT= LDN 0 1
3G#W SMO FX2
3GSG ADS 0 AWORK1 [COUNT OF BLOCKS FOR OUTPUT
3H#6 STOZ IMOPTY(2) [MADE NON-ZERO IF OUTPUT ALONE
3HRQ LDN 0 IDATA
3J?B SLL 3 2
3JR2 STO 0 IBSW(2) [START ADDRESS FOR DEPOSITING
3K=L SBN 3 SAFETMARGIN
3KQ= SMO FX2
3L9W LDX 0 JSOURCE1 [IDENTIFIER NUMBER
3LPG ORX 3 GSIGN
3M96 ANDN 0 #7777
3MNQ STO 0 IPBIDE(2) [IDENTIFIER NUMBER
3N8B ADX 7 FX1
3NN2 STO 3 IPBIDE+1(2) [INITIAL ROOM IN BLOCK
3P7L EXIT 7 0
3PM= #
3Q6W # TEST FOR MOP OFF OR FINISH
3QLG #
3R66 TMF MHUNTW 3,AMXOR,ADCB
3RKQ LDX 1 A1+FPTR(3)
3S5B LDX 0 FOURTHWD(1)
3SK2 ORX 0 FINISH
3T4L SLL 0 2
3TJ= BPZ 0 (7)
3W3W ACROSS IPBLISTC,5
46TX #
47#Q #
47DK SK4IPBLISTB
47FW CALL 7 TMF [CHECK FOR MOP OFF ETC.
47H7 CALL 7 SAMIO [GET NEW IOUT
47JD STEPAGAIN [REFIND RECORD
47KP LDX 4 IWORK15(2)
47M2 BZE 4 REOK [J TO CONTINUE LISTING
47N? LDX 5 IWORK1(2) [RESET X5 IF NOT REACHED START REC.
47PJ BRN STEPOK [AND GO O FIND IT
47SB #
48#2 # ENTRY FROM IPBLISTA TO LISTFILE TO A 7020 BULK DEVICE VIA THE IPB
48RL # STEP RECORDS TO START RECORD NUMBER , OR TO NEXT RECORD
49?= # AWORK2 IS UNTOUCHED AS IT CONTAINS GMODE FOR ENTERING LISTEND
49QW #
4==G #
4=Q6 # K1 ENTRY FOR LISTING MAINFILE ; K2 ENTRY FOR LISTING TESTPATTERN
4?9Q #
4?PB SK2IPBLISTB
4#92 LDN 6 IWORK1(2) [MAINFILE INFO. STORE
4#NL LDN 5 IWORK10(2) [WORKING AREA
4*8= LDN 4 IWORK5(2) [SETUP FILE INFO. STORE
4*MW MOVE 5 4 [PRESERVE MAINFILE INFORMATION
4B7G MOVE 4 4 [ACCESS REQUIRED FILE INFORMATION
4D62 LDCT 0 #200
4DKL ORS 0 AWORK4(2) [OUTPUT 'PLEASE LINE UP' IMMEDIATELY
4FJW CALL 7 SAMIO [GET IOUT BLOCK
4FX? STEP
4G9N BZE 3 SEMPT [ J IF SETUP FILE EMPTY
4GJ5 BRN START
4GWG [
4H8X [
4HH# SK1IPBLISTB
4HTP CALL 7 SAMIO
4J86 STEPAGAIN
4JGH BZE 3 SEMPT [ J IF SETUP FILE EMPTY
4JSY [ ( ON REENTRY FROM IPBLISTC )
4K7* STEPOK
4KFW LDX 0 IWORK9(2)
4LF6 BRN START
4LYQ #
4MDB NEWS CALL 7 TMF
4MG# HUNTW 3,AMXOR,#77
4MJ= BNG 3 NEWNPU [NO UNPACKED NPU(IOUT)
4ML8 NAME 3,AMXOR,IOUT [USE UNPACKED NPU (LP ONLY)
4MN6 LDN 0 1
4MQ4 ADS 0 AWORK1(2) [RESET COUNT OF NPUS(IOUTS) FOR OUTPU
4MS2 BRN NXREC [PACK IN NEXT RECORD IF POSSIBLE
4MTY NEWNPU
4MY2 CALL 7 SAMIO [GET NEW IOUT BLOCK
4N2X SEGENTRY K62IPBLISTB [USED BY IPBNOPCK RESTORE MACRO
4N5S NXREC LDN 4 0
4N7Q STEP
4NMC CALL 7 RECHE
4NQ2 REOK [RETURN LABEL FROM READ RROR
4NX= BZE 3 WOBL [END OF FILE REACHED
4P9L LDX 6 IWORK17(2) [PAGE LINE COUNT
4P=X SEGENTRY K56IPBLISTB
4P#9 SBN 6 A7021PAGE-1<62
4P*G LDXC 0 IWORK9(2) [ENSURE END OF RESTART SECTION BIT IS UNSET
4PBS BNG 6 START [NOT END OF PAGE
4PFC LDCT 4 #010
4PJ2 ADX 0 4 [ADD 1 TO RESTART SECTION NUMBER
4PLK ORX 0 GSIGN [RESTART SECTION=1 PAGE FOR LP
4PP8 BRN START
4SS= #
4T?W START LDX 7 IWORK13(2)
4TRG STO 3 IWORK15(2) [SAVE INITIAL RECORD POINTER
4W?6 ANDN 7 4
4WQQ BZE 7 NOMON [NOT MONFILE
4X=B LDX 7 1(3) [MONFILE CATEGORY WORD
4XQ2 ANDX 7 IWORK14(2) [MONFILE DISCARD MASK
4Y9L BNZ 7 NOMON [DON'T DISCARD THIS RECORD
4YP= LDN 7 1
4^8W ADS 7 IWORK10(2) [UPDATE RECORD NUMBER
4^NG BRN NXREC
5286 #
52MQ NBSS PHOTO 4
537B SETUPCORE 6,1,ADATA,ACONV
53M2 TESTMOVE 4,SMVE
546L BRN STAN
54L= NOMON STO 0 IWORK9(2)
5656 LDN 6 #140 [B17 : ALLCHAR ; B18 : NORMAL
56JQ ANDX 6 IWORK13(2)
574B BZE 6 STT1
57J2 LDX 0 IWORK13(2)
583L SRC 0 1
58H= BNG 0 STT1 [J IF SPECIAL REQUESTED
592W HUNTW 1,ADATA,ACONV
59GG LDEX 6 FRH(3)
5=26 BNG 1 NBSS
5=FQ TXU 6 ALOGLEN(1)
5=^B BCC SMVE
5?F2 PHOTO 4
5?YL ALTLENG 1,6,RFND
5#D= TESTMOVE 4,SHNT
5#XW STAN STEPAGAIN
5*CG SHNT HUNTW 1,ADATA,ACONV
5*X6 SMVE LDN 4 A1+FRH(1)
5BBQ SMO 6
5BWB MOVE 3 0
5CB2 LDN 4 2
5CTL LDN 6 #40 [B18 : NORMAL
5D*= ANDX 6 IWORK13(2)
5DSW BNZ 6 NMD
5F#G LDN 4 #22
5FS6 NMD LDN 6 #10
5G?Q TRANSFOR 4,6
5GRB HUNTW 1,ADATA,ACONV
5H?2 LDN 3 A1+FRH(1)
5HQL STO 3 IWORK15(2)
5J== STT1 LDCH 5 IWORK9(2)
5JPW MHUNTW 2,AMXOR,IOUT
5JSF LDX 1 FX2
5JX4 LDCT 6 4
5J^M ANDX 6 IWORK9(1)
5K4= ERS 6 IWORK9(1) [UNSET"FIRST REC OF SECTION"BIT IFSET
5K6T BZE 6 NSOS [NOT FIRST REC OF SECTION
5K9G ANDN 5 #37
5KP6 BCHX 2 £
5L8Q DCH 5 IPBIDE+1(2) [RESTART NO. IN CHAR 1
5LNB ANDX 2 BITS22LS
5M82 NSOS LDX 6 IPBIDE+1(2)
5N7= STO 2 ACOMMUNE2(1) [PRESERVE AMXOR/IOUT ADDRESS
5NLW ANDN 6 #7777
5P6G ADX 2 IBSW(2) [POINTER TO DEPOSIT NEXT CHARACTER
5PL6 LDCT 4 #400
5Q5Q ANDX 4 IWORK13(1) [B0 SET IF PERI-TYPE FILE
5QKB LDX 5 4
5R52 BZE 4 SPON
5RJL LDCT 4 #600
5S4= ANDX 4 1(3) [POSITION OF LAST CHARACTER
5SHW BNZ 4 SPLAS [LAST WORD OF RECORD SPACE-FILLED
5T3G SPON ADN 4 1
5TH6 SPLAS ADX 4 0(3) [WORD COUNT OF RECORD
5W2Q SLC 4 2
5WGB SBN 4 12 [RECORD HEADER AND LAST WORD
5X22 PERY BPZ 4 PER1
5XFL LDN 4 0
5X^= PER1 STO 4 ACOMMUNE5(1) [NO OF CHARS IN RECORD
5^D6 #
5^XQ # OUTPUT TO REMOTE LINE PRINTER : INSERT FE CHARS FOR PFCC , END OF
62CB # PRINT LINE AND MORE THAN 3 SUCCESSIVE SPACES ; TRANSLATE SHIFT
62X2 # CHARS INTO LINE CODE ; INSERT '-' IF NEWLINE WITHIN RECORD
63BL #
63YC LDCT 0 #100
63^6 ANDX 0 AWORK4(1)
63^T BZE 0 XNNEWPAG [J IF NOT ON NEW PAGE
642J ERS 0 AWORK4(1)
643? SMO FX2
6442 LDX 0 IWORK11
644P ANDN 0 #37 [MODULO 32
645D SRC 0 6
6467 SMO FX1
646W LDN 1 PAGESEQ [PAGE SEQUENCE
647K MVCH 1 4
648# ADX 0 0(1)
6493 LDN 1 0
649Q MVCH 1 3
64=F SBN 6 7 [CHAR COUNT
64?8 LDX 1 FX2
64?X XNNEWPAG
64#2 LDEX 0 AWORK4(1)
64#3 BZE 0 XNLOOP [ J IF NOT FAILED
64#4 LDN 0 0
64#5 DEX 0 AWORK4(1) [ CLEAR FAILED STATUS
64#6 MHUNTW 1,AMXOR,ADCB
64#7 JBS XNLOOP,1,ADCBTSPOOL [ J IF SPOOLING
64#8 JBC XNLOOP,1,ADCB7502LP [ J IF NOT 7502 LP
64#9 HUNTW 1,ADATA,FORMLOOP
64#= BNG 1 XNLOOP [ J IF NO FORMAT LOOP DATA
64#? LDX 0 FORMCHAR(1)
64## LDN 1 FORMDATA(1)
64#* SMO 0
64#B MVCH 1 0
64#C SBX 6 0 [ CHAR COUNT LEFT IN IOUT BLOCK
64#D SMO FX2
64#F LDXC 5 AWORK1 [NPU SIZE IN CHARS IN B1-11
64#G SRL 5 12
64#H SBN 5 SAFETMARGIN [REPLACE SAFETY MARGIN
64#J MHUNT 2,AMXOR,IOUT
64#K SBX 5 6 [X5 = CT. OF CHARS DEPOSITED
64#L STOZ IBSW(2)
64#M DSA 5 IPBIDE+1(2)
64#N ADN 5 IDATA-A1*4+3
64#P SRL 5 2 [REQUIRED AMXOR/IOUT BLOCK LENGTH
64#Q ALTLEN 2,5
64#R CALL 7 SAMIO [ GET ANOTHER IOUT BLOCK
64#S STEPAGAIN
64#T MHUNTW 2,AMXOR,IOUT
64#W SMO FX2
64#X STO 2 ACOMMUNE2
64#Y ADX 2 IBSW(2)
64#^ XNLOOP
64*2 LDX 1 FX2
64*P SBN 6 4 [MAXIMUM PFCC SIZE
64*W LDN 0 #76
64TG DCH 0 0(2)
65*6 BCHX 2 £
65SQ LDN 0 #32
66#B DCH 0 0(2) [STORE #7632 = NEWLINE
66S2 LDX 0 IWORK17(1) [PAGE POSITION INDICATOR
673S SEGENTRY K57IPBLISTB
67?L SBN 0 A7021PAGE-1<62
67R= LDX 4 IWORK13(1)
68=W LDN 7 0 [TO INDICATE NO PFCC SO ONE NEWLINE
68QG BPZ 4 NOPFC [NO PFCC IN RECORD
69=6 ANDN 4 1
69PQ BNZ 4 NOPFC [IGNORE PFCC IF SPECIAL
6=9B #
6=P2 # INTERPRET PFCC IF PRESENT ; FORM FEED IF AT BOTTOM OF PAGE
6?8L #
6?N= LDX 7 1(3)
6#7W LDCH 4 7
6#MG ANDN 7 7
6*76 SRC 4 6
6*LQ BNG 4 WIP [PFCC WITH PRINTING
6B6B LDN 3 0 [WITHOUT PRINTING
6BL2 WIP BZE 7 NOMOV
6C5L SLC 4 2
6CK= BNG 4 VTAB [VERTICAL TAB REQUIRED
6D4W ORX 6 GSIGN [SET NL PFCC FLAG
6DJG NOPFC BNG 0 NOFF [NOT AT BOTTOM OF PAGE
6F46 LDN 7 1
6FHQ VTAB
6G3B BNG 6 PR [J IF NL PFCC
6GH2 LDCH 0 0(2)
6H2L ADN 0 1
6HG= DCH 0 0(2) [CONVERT TO #7633 = VERTICAL TAB
6H^W BCHX 2 £
6JFG DCH 7 0(2) [CHANNEL NUMBER
6J^6 ADN 6 1
6KDQ BCHX 2 £
6KQ6 XIGPG BCT 7 NCHN1 [THROW TO CHANNEL 2-7 PFCC
6L3G # FORM FEED PFCC
6L88 XPR
6L#W LDXC 0 IWORK9(1)
6LH6 BCS PR [ALREADY FLAGGED "END OF RESTART SECTION"
6LPB LDCT 4 #010 [UPDATE RESTART SECTION NUMBER
6LXL ADX 0 4
6M5W ORX 0 GSIGN [INDICATE END OF RESTART SECTION
6M#6 STO 0 IWORK9(1)
6MMB # NEW PAGE
6MP= PR
6MQ8 STOZ IWORK17(1) [CLEAR PAGE LINE COUNT
6MR6 LDX 7 IWORK10(1)
6MWW MHUNTW 1,ADATA,IPTEMP
6NBG LDX 0 ALOGLEN(1)
6NDD SBN 0 2
6NGB LDX 5 A1+1(1)
6NJ# DVS 4 0
6NL= SMO 4
6NN8 LDX 5 A1+2(1)
6NQ6 SBX 5 7
6NS4 BZE 5 PRX
6NW6 LDX 5 A1(1) [NO. OF PAGES OUTPUT ALREADY
6PTB ADN 5 1
6Q*2 STO 5 A1(1)
6QGS LDX 5 A1+1(1) [NO OF CURRENT FILE PAGES PRINTED
6QJQ ADN 5 1
6QLN STO 5 A1+1(1)
6QSL DVS 4 0 [REMAINDER WILL BE POINTER DOWN BLOCK
6R#= SMO 4
6RJ4 STO 7 A1+2(1)
6RXR PRX
6S?G LDX 1 FX2
6SB5 LDX 0 IWORK11(1)
6SDN ADN 0 1
6SH? SMO FX1
6SKW ANDX 0 XMSK
6SNF STO 0 IWORK11(1)
6SR6 NPR BPZ 6 PRES [J IF NOT NL PFCC
6T=Q SMO IWORK15(1) [SET X7 TO ZERO IF NL PFCC
6TQB LDX 7 1
6W=2 ANDN 7 7
6WPL SBN 7 2
6X9= UICC ADN 6 2 [UPDATE IOUT CHAR COUNT
6XNW ANDX 6 BITS22LS [CLEAR NL PFCC FLAG
6Y8G BCHX 2 PFC1 [UPDATE IOUT PTR
6YN6 #
6^7Q NOMOV LDCH 0 0(2)
6^MB ADN 0 3
7272 DCH 0 0(2) [CONVERT TO #7635 = CARRIAGE RETURN
72LL ADN 6 2
736= BCHX 2 PRES
73KW NOFF SBN 7 2
745G BNZ 7 UPLC [J IF SINGLE NL PFCC
74K6 ADN 0 1 [TWO NLS
754Q SEGENTRY K58IPBLISTB
75JB UPLC ADN 0 A7021PAGE<63 [UPDATE PAGE LINE COUNT
7642 STO 0 IWORK17(1)
76HL BRN UICC
76JB NCHN1
76K6 LDX 0 IWORK17(1)
76KW SEGENTRY K55IPBLISTB
76LL SBN 0 A7021PAGE-1<62
76MB ADX 0 7
76N6 BPZ 0 XPR
76NW SEGENTRY K59IPBLISTB
76PL ADN 0 A7021PAGE<63
76QL STO 0 IWORK17(1)
76SB BRN PRES
76W6 [ THROWS TO CHANNEL 2-7 PFCCS ARE TREATED AS
76XW [ 2-7 NEWLINES FOR LINE COUNT & RESTART PURPOSES
76^N #
773= PFC1 BNZ 7 PRES [J IF SINGLE NL PFCC
77GW SBN 6 2 [PFCC = 2 OR #42 : TWO NEWLINES
782G LDN 0 #7632
78G6 LDX 1 GSIGN
78^Q MVCH 1 2
79FB LDX 1 FX2
79^2 PRES BZE 3 PEND [NON-PRINTING PFCC
7=DL CALL 7 REM [CALCULATE & PRESERVE REMAINDER COUNT
7=Y= ADN 3 2 [MOVE PAST RECORD HEADER
7?CW #
7?XG # INSERT LINE NUMBER IF REQUIRED AT BEGINNING OF LINE
7#C6 #
7#WQ PINS LDX 7 IWORK13(1)
7*BB ANDN 7 2 [B22 SET IF NUMBERING REQUIRED
7*W2 STOZ ACOMMUNE4(1)
7B*L BZE 7 PST
7BT= LDX 0 IWORK10(1)
7C#W BPZ 0 PUNUM [LINE NO. NOT TOO LARGE
7CSG SMO FX1
7D#6 LDX 0 SHTAB
7DRQ SBN 0 19 [HORIZ. TAB FOR 8 SPACES
7F?B LDCT 1 #200 [START MVCH AT CHAR. 1 OF X0
7FR2 MVCH 1 3
7G=L SBN 6 3
7GGD BNZ 6 PROOM [STILL ROOM IIN NPU X6 = ROOM STILL L
7GQ= ADN 6 3 [RESET X6
7H24 BRN NPUND [J. NEW NPU REQUIRED
7H9W PUNUM SMO FX1
7HPG MPY 0 PMAGIC
7J96 LDN 7 6 [CHARACTER COUNT
7JNQ MODE 1
7K8B PCBD CBD 0 0(2) [CONVERT LINE NO. TO DECIMAL
7KN2 BCHX 2 £
7L7L BCT 7 PCBD
7LM= MODE 0 [DON'T ZERO-SUPPRESS LAST CHAR
7M6W CBD 0 0(2)
7MLG BCHX 2 £
7N66 LDN 1 #20
7NKQ DCH 1 0(2)
7P5B BCHX 2 £
7PK2 SBN 6 8 [ROOM LEFT IN AMXOR/IOUT
7PNX BNZ 6 PROOM [STILL ROOM IN NPU
7PSS SBN 5 8
7PYP BRN NPUND
7Q4L PROOM SBN 5 8 [ROOM LEFT ON PRINT LINE
7QJ= PST LDX 1 FX1
7R3W SMO FX2
7RHG LDX 7 ACOMMUNE4 [INITIAL SPACE COUNT
7S36 BZE 5 PUNL [NULL RECORD OR NPUND EXIT FROM STOSP
7SGQ #
7T2B # PRINT TRANSFER LOOP : SPACE CT. IN X7 , X4<0 IF MULTI-LINE RECORD
7TG2 #
7T^L PLOOP LDCH 0 0(3)
7WF= TXU 0 SPACE(1)
7WYW BCS PNOS [NOT A SPACE
7XDG SBN 5 1
7XY6 ADN 7 1
7YCQ BCHX 3 £
7YXB BZE 5 PUNL [END OF LINE
7^C2 BRN PLOOP
7^WL PNOS BZE 7 NOSP [NO SPACES TO BE INSERTED
82B= CALL 0 STOSP [STORE SPACES OR HORIZ. TAB
82TW LDN 7 0 [ZEROISE SPACE COUNT
83*G LDCH 0 0(3)
83T6 NOSP TXL 0 SHIFT(1) [#74
84#Q BCS PLOP [CHAR < #74 : NO CONVERSION NEEDED
84SB LDN 7 #76
85#2 DCH 7 0(2) [CONVERT E.G. #74 TO #7664
85RL BCHX 2 £
86?= SBN 6 1
86QW LDN 7 0
87Q6 SBN 0 #10
87X# BNZ 6 PLOP [NPU NOT FULL
884G BUX 6 NPUND [ RESET(+1) HOOM LEFT IN IOUT
889Q PLOP DCH 0 0(2)
88PB SBN 5 1
8992 BCHX 3 £
89NL SBN 6 1 [SPACE LEFT IN NPU
8=8= BCHX 2 £
8=MW BZE 5 PUNL [END OF LINE
8?7G BNZ 6 PLOOP
8?M6 BRN NPUND [END OF NPU
8#6Q #
8#LB # END OF LINE ; IF NOT END OF RECORD INSERT '-' AND INDENT NEXT LINE
8*62 #
8*=D PUNL
8*BW SEGENTRY K53IPBLISTB
8*H# NULL
8*MQ NULL
8*S8 NULL
8*YL BZE 4 PEND [ALSO END OF RECORD
8B5= BZE 7 PUATE [LINE NOT ENDED WITH SPACE(S)
8HF6 PUNOW CALL 0 STOSP
8HYQ PUATE LDX 1 FX1
8JDB ADN 1 PCONT [#2020357632
8JY2 MVCH 1 5 [INSET HYPHEN
8KCL SBN 6 5 [UPDATE ROOM LEFT IN IOUT BLK
8KX= LDX 1 FX2
8LBW LDX 7 IWORK13(1)
8LWG LDX 5 IWORK9(1) [CHAR COUNT FOR NEXT LINE
8MB6 LDX 0 7
8MTQ ANDN 5 #3777
8N*B ANDN 7 2 [B22 SET IF NUMBER SPECIFIED
8NT2 LDN 4 1
8P#L ADS 4 IWORK17(1) [UPDATE PAGE LINE COUNT
8PS= ANDN 0 1 [B23 SET IF SPECIAL LISTING
8Q?W ADN 7 1 [PLUS WORD FOR INDENTATION
8QRG SLL 7 2
8R?6 BNZ 0 NOAD [4 ADDED IN REM IF SPECIAL
8RQQ ADN 5 4 [ADD INDENTATION TO CHAR COUNT
8S=B NOAD STO 5 ACOMMUNE5(1) [IN CASE END OF NPU BEFORE NEXT NL
8SQ2 ADX 3 0 [COUNTERACT 'SBN 3 1' IN REM IF SPEC.
8T9L STO 7 ACOMMUNE4(1) [NUMBER OF SPACES FOR INDENTING
8TP= CALL 7 REM [GET COUNT OF CHARS IN NEXT LINE
8W8W LDX 7 ACOMMUNE4(1)
8WNG SBX 5 7
8X86 LDX 1 ACOMMUNE2(1) [START ADDRESS OF AMXOR/IOUT
8XMQ BNG 6 NPUND [J IF HAVE RUN INTO SAFETY MARGIN
8Y7B BZE 6 NPUND [J IF NPU FULL
8YM2 DSA 6 IPBIDE+1(1) [ROOM LEFT IN AMXOR/IOUT
8^6L BRN PST [CONTINUE CONVERSION
?L5B #
?LK2 # AMXOR/IOUT BLOCK FULL : END OF NPU ; SEND WHOLE BLOCK IF IT DOES
?M4L # NOT CONTAIN NEWLINE ; IF IT DOES , COPY CHARACTERS SINCE LAST
?MJ= # NEWLINE INTO NEW AMXOR/IOUT AND SHORTEN OLD ONE
?N3W #
?NHG NPUND LDX 1 FX2
?P36 LDX 0 IWORK18(1) [SAVE OLD VALUE OF IWORK18
?PGQ SBX 0 IWORK15(1) [RELATIVE TO START OF BLOCK
?Q2B STO 0 ACOMMUNE6(1) [IN ACOMMUNE6
?QG2 STO 3 IWORK18(1) [PRESERVE RECORD POINTER
?Q^L BRN PPUND
?RF= OPUND LDX 1 FX2 [ENTRY FROM STOSP SUBROUTINE
?RYW ADN 6 3
?SDG PPUND LDX 2 ACOMMUNE2(1) [START ADDRESS OF AMXOR/IOUT
?SY6 LDX 0 IWORK15(1) [INITIAL RECORD POINTER
?TCQ SBS 0 IWORK18(1)
?TXB PHOTO 0
?WC2 STO 0 ACOMMUNE7(1)
?WWL LDX 0 6 [NO PREV. NL SO TAKE FULL BLOCK
?XB= STO 7 ACOMMUNE4(1) [SPACE COUNT IF ENTERED FROM STOSP
?XTW STO 5 ACOMMUNE5(1) [CURRENT REMAINDER COUNT
?Y*G LDX 6 IPBIDE+1(2) [CHAR. REM. CT. AT LAST NEWLINE
?YT6 LDXC 5 AWORK1(1)
?^#Q SRL 5 12 [INITIAL CHARACTER COUNT
?^SB ORX 6 CACT
#2#2 STOC 6 IPBIDE+1(2)
#2RL ANDN 6 #7777
#3?= LDX 3 5 [PRESERVE FOR SETUPCORE
#3QW SBN 5 SAFETMARGIN
#4=G SRL 3 2
#4Q6 SBX 5 6 [EQUAL IF NO NL IN BLOCK
#59Q SBX 6 0 [NO OF CHARS SINCE NL OR START
#5PB BNZ 5 WHOB
#692 LDX 5 6 [NO OF CHARS DEPOSITED SINCE START
#6NL LDN 6 0
#78= WHOB DSA 5 IPBIDE+1(2) [CHAR. COUNT FOR OUTPUT
#7MW CALL 7 SETU [GET NEW AMXOR/IOUT
#87G LDX 3 6
#8M6 LDN 7 IDATA(2)
#96Q LDX 1 2
#9LB HUNT2 1,AMXOR,IOUT [FIND OVERFLOWED BLOCK
#=62 BZE 6 OWFUL
#=KL LDX 6 5
#?5= SRC 6 2
#?JW ADN 6 IDATA(1) [POINT TO FIRST CHAR TO REPLACE
##4G MVCH 6 0(3) [MOVE CHARS SINCE NL INTO NEW BLOCK
##J6 OWFUL ADN 5 IDATA-A1*4+3
#*3Q SBX 7 2
#*HB SRL 5 2
#*R8 STOZ IBSW(1) [SET BLOCK STATUS WORD FOR DATA SEG
#B32 ALTLEN 1,5 [SHORTEN OLD BLOCK
#BGL LDX 1 FX2
#C2= LDXC 6 AWORK1(1)
#CFW SRL 6 12
#C^G SBN 6 SAFETMARGIN(3) [ROOM LEFT IN BLOCK
#DF6 LDX 5 ACOMMUNE5(1) [RECORD REMAINDER COUNT
#DYQ LDX 0 ACOMMUNE7(1)
#FDB TESTMOVE 0,NSTL
#FY2 HUNTW 3,ADATA,ACONV
#GCL ADN 3 A1
#GX= BPZ 3 NST
#HBW LDX 0 ACOMMUNE4(1)
#HWG STO 0 IWORK15(1)
#JB6 STEPAGAIN
#JTQ LDX 1 2
#K*B LDX 0 IWORK15(1)
#KT2 STO 0 ACOMMUNE4(1)
#L#L BRN NST
#LS= NSTL LDX 3 IWORK15(1)
#M?W NST STO 3 IWORK15(1)
#MRG ADX 3 IWORK18(1)
#N?6 MHUNTW 2,AMXOR,IOUT
#NQQ STO 3 IWORK18(1)
#P=B STO 2 ACOMMUNE2(1)
#PQ2 ADX 2 7
#R8W LDX 0 ACOMMUNE6(1) [REPLACE ABSOLUTE PTR IN OLD IWORK18
#RNG ADX 0 IWORK15(1)
#S86 STO 0 IWORK18(1)
#SMQ LDX 0 2 [GET PTR IN IWORK19 TO POINT TO LAST
#T7B SLC 0 2 [GROUP OF SPACES(SUBTRACT NO OF CHARS
#TM2 SBX 0 IWORK19(1) [LEFT IN OLD AMXOR BLK TO GET
#W6L SRC 0 2 [POSITION)
#WL= STO 0 ACOMMUNE6(1)
#X5W ADS 6 IWORK19(1) [ADD TO NO OF CHARS LEFT IN NEW BLOCK
#XKG BRN PST
#^4B #
#^J2 # END OF RECORD : OUTPUT IF END OF RESTART SECTION ; GET NEXT RECORD
*23L #
*2H= PEND LDX 1 FX2
*32W LDX 4 2
*3=M LDXC 0 IWORK9(1)
*3*= BCC NDC3 [NOT END OF RESTART SECTION
*3*F # END OF RESTART SECTION : APPEND CR + DC3 CHARS IF
*3*N # SPOOLING. (AND IF PF778 RJE WHEN S1901A MACRO IN USE).
*3*X MHUNTW 3,AMXOR,ADCB
*3B6 LDX 0 AWORK4(1)
*3B* SRL 0 11
*3BJ SEGENTRY K30IPBLISTB
*3BR BRN NRJE [IF NULLIFIED BY S1901A APPEND IF RJE
*3C2 SMO A1+FPTR(3)
*3C9 ORX 0 FOURTHWD
*3CD NRJE ANDN 0 #1000
*3CM BZE 0 NDC3 [NOT SPOOLING.
*3CW SMO FX1 [INSERT CR + DC3
*3GG LDN 1 XDC3
*3K6 MVCH 1 4
*3MQ LDX 1 FX2
*3N= JBC XNDC3,3,ADCBTSPOOL
*3NQ JBC XNDC3,3,ADCB7502LP
*3P= ADN 6 2
*3PQ XNDC3
*3QB SBN 6 4 [UPDATE ROOM LEFT IN IOUT BLK
*3TJ LDCT 0 #40
*3TS ANDX 0 AWORK4(1)
*3W4 BZE 0 XNSPL [J IF NOT SPOOLING
*3W# SLL 0 1 [PAGE NO SEQUENCE TO BE
*3WJ ORS 0 AWORK4(1) [INSERTED BEFORE NEXT OUTPUT
*3WS XNSPL
*3XC NDC3 LDX 2 ACOMMUNE2(1) [START ADDRESS OF AMXOR/IOUT
*426 LDX 0 IWORK11(1) [B2 SET IF THIS WAS 2000-CHAR RECORD
*4FQ SLL 0 2
*4S7 BNG 0 NOWTH [QUEUE THIS 2000-CHAR TP RECORD AND
*56J [CONCATENATE NEXT RECORD
*5F2 LDN 0 1
*5YL ADS 0 IWORK10(1) [UPDATE LINE NUMBER
*68D LBW 3,ADCB7502LP,7 [LD. BIT TO INDICATE IF 7502 LP
*6D= LDX 3 IWORK12(1)
*6XW BNG 3 RESEC [PRINT ALL LINES
*7CG SBN 3 1
*7X6 STO 3 IWORK12(1)
*8BQ BZE 3 NOTF [END OF LISTING : ALL LINES OUTPUT
*8KD RESEC LDX 5 IWORK9(1)
*8S6 BNG 5 NOTF [END OF RESTART SECTION
*8Y# JBWS PNOW,7 [J IF X7 SAYS 7502 LP
*94G SEGENTRY K60IPBLISTB [IPBNOPCK - RESTORE TIME MACRO
*98N NULL
*9#W NULL
*9F4 NULL
*9K= NULL
*9PD SEGENTRY K64IPBLISTB [USED BY IPBNOPCK RESTORE MACRO
*9TL PNOW LDX 0 6
*=*= SBN 0 12 [LENGTH OF PFCC + NUMBER IF PRINT
*=SW BNG 0 NOWTH [NOT WORTH STARTING NEXT RECORD HERE
*?#G DSA 6 IPBIDE+1(2) [ROOM LEFT IN BLOCK
*?S6 SBX 4 2
*#?Q STO 4 IBSW(2) [POINTER TO DEPOSIT NEXT CHAR.
*##8 JBWS PNOWA,7 [J IF X7 SAYS 7502 LP
*##L SEGENTRY K61IPBLISTB [IPBNOPCK - RESTORE TIME MACRO
*#*4 NULL
*#*G PNOWA
*#CY LDXC 5 AWORK1(1)
*#GC # LP : OUTPUT IF COUNT OF NPUS(IOUTS) EXCEEDS THRESHOLD
*#JL # (DEFAULT=2) BUT RETAIN CURRENT UNPACKED NPU FOR NEXT REC
*#LT ANDN 5 #777
*#P4 SEGENTRY K40IPBLISTB
*#R? SBN 5 3
*#TG BNG 5 NXREC [NPU COUNT NOT EXCEEDING THRESHOLD :
*#XP [PACK IN NEXT RECORD IF POSSIBLE
*#^Y NAME 2,AMXOR,#77 [DISGUISE UNPACKED NPU
**47 LDN 0 1
**6B SBS 0 AWORK1(1) [ADJUST COUNT OF NPUS FOR OUTPUT
**8K BRN SK3IPBLISTB [OUTPUT "PACKED" NPUS
**?2 #
**QL WOBL LDX 1 FX2
*B== MHUNTW 2,AMXOR,IOUT
*BPW LDX 6 IPBIDE+1(2) [ROOM LEFT IN BLOCK AFTER FIRST
*C9G ANDN 6 #7777 [RECORD INSERTED
*CP6 NOTF LDCT 0 4 [INDICATE END OF RESTART SECTION
*D8Q ORS 0 IPBIDE+1(2)
*DDJ ORS 0 IWORK9(1) [SET "FIRST REC OF SECTION" BIT
*DJF SEGENTRY K63IPBLISTB [USED BY IPBNOPCK RESTORE MACRO
*DNB NOWTH LDXC 5 AWORK1(1) [NPU SIZE IN CHARS IN B1-11
*F82 SRL 5 12
*FML SBN 5 SAFETMARGIN [REPLACE SAFETY MARGIN
*G7= STOZ IBSW(2)
*GLW SBX 5 6 [X5 = CT. OF CHARS DEPOSITED
*HL6 DSA 5 IPBIDE+1(2)
*J5Q ADN 5 IDATA-A1*4+3
*JKB SRL 5 2 [REQUIRED AMXOR/IOUT BLOCK LENGTH
*K52 TXU 5 ALOGLEN(2)
*KJL BCC PREN
*L4= ALTLEN 2,5
*LHW PREN BZE 3 OUDEL [END OF LISTING
*M3G #
*MH6 # RETURN HERE FROM IPBLISTC IF PRINTER HELD AND THEN RE-ENGAGED
*N2Q #
*NGB SK3IPBLISTB
*P22 CALL 7 TMF [TEST MOP OFF OR FINISH
*PFL LDXC 5 ISTATUS(3)
*P^= BCS TINOP [IDENTIFIER INOPERABLE
*Q57 LDCH 0 ISTATUS(3)
*Q94 ANDN 0 2
*Q#^ BNZ 0 TINOP
*QDW LDCT 0 #400
*QYG ADXC 5 5
*RD6 BCC NOWAR
*RXQ ADN 0 #2000
*SCB ORS 0 IWAIT(3)
*SX2 COOR1
*TBL BRN K3IPBLISTB [TRY AGAIN
*TW= #
*W*W NOWAR ORS 0 IWAIT(3)
*WTG LDX 3 IADIN(3) [ADDRESS OF IPBIN ACTIVITY
*X*6 LDX 3 IPBRING(3)
*XSQ SBN 3 IPBRING [ADDRESS OF IPBOUT ACTIVITY
*Y#B LDX 2 ACTRING(3)
*YS2 SBN 2 ACTRING [FIND ACTIVITY AFTER IPBOUT
*^?L LDX 4 BPTR(2)
*^R= LDX 2 FX2
B2=W LDEX 5 AWORK1(2)
B2GN SEGENTRY K54IPBLISTB
B2QG ADS 5 ALFTRANS(2) [UPDATE TRANSMISSIONS COUNT
B3=6 MHUNTW 1,AMXOR,IOUT [THIS WILL BE THE LAST OUTPUT
B3PQ LDN 0 1
B49B ERS 0 IMOPTY(1) [WAKE ME AFTER OUTPUT
B4P2 BRN NOWCH
B58L NEBO MHUNTW 1,AMXOR,IOUT
B5N= NOWCH LDX 0 ALOGLEN(1)
B67W SBN 0 IDATA-A1
B6MG ADS 0 ALFWORDS(2) [COUNT OF WORDS TRANSFERRED
B776 CHAIN 1,4
B7LQ BCT 5 NEBO
B86B DEX 5 AWORK1(2) [CLEAR COUNT OF OUTPUT BLOCKS
B8L2 #
B95L LDCT 0 #100
B9K= ANDX 0 IPBSW(3) [B2 SET IF IPBOUT ASLEEP
B=4W BZE 0 WAKE
B=JG ERS 0 IPBSW(3) [INDICATE ON LIST
B?46 LDX 2 3
B?HQ FPUT
B#3B WAKE COOR1
B#H2 BRN NEWS
B*2L #
B*G= TINOP LDN 7 0 [INDICATE LISTING NOT FINISHED
B*^W LDCH 0 ISTATUS(3) [B4 SET IF UNAV RATHER THAN HELD
BBFG LDX 2 FX2
BB^6 ANDN 0 2
BCDQ DEX 0 AWORK4(2) [0 IF HOLD BUTTON ; 2 IF STOP BUTTON
BCJM LDCT 0 #030
BCNJ ORS 0 ISTATUS(3)
BCSF ERS 0 ISTATUS(3)
BCYB ACROSS IPBLISTC,2
BDD2 #
BDXL # SETUP FILE EMPTY
BFC= #
BFWW SEMPT
BGBG LDN 4 24
BGW6 LDN 3 5
BK#= LDN 6 SEMP(1) [SETUP FILE EMPTY
BKRW MHUNTW 2,AMXOR,IOUT
BQ8G SBS 4 IPBIDE+1(2) [DECREASE ROOM LEFT IN BLOCK
BRMB LDX 0 PRINT(1) [#76327632
BS72 STO 0 IDATA(2) [INSERT TWO NEWLINES FOR LP
BSLL LDN 7 IDATA+1(2)
BT6= MOVE 6 0(3)
BTKW LDN 3 0 [INDICATE END OF LISTING
BW5G BRN WOBL
BWK6 [
BX4Q [
BXPH OUDEL LDX 2 FX2
BXR? LDX 0 AWORK4(2)
BXR# BNG 0 OUDEM
BXR* MHUNTW 2,AMXOR,ADCB
BXRB JBC OUDEM,2,ADCBTSPOOL
BXRC JBC OUDEM,2,ADCB7502LP
BXRD ACROSS IPBLISTD,7
BXRF OUDEM
BXRM MHUNT 2,AMXOR,IOUT
BXS4 LDCT 0 #40
BXSF ORS 0 IPBIDE+1(2) [ REPORT OUTPUT SENT
BXSM LDX 2 FX2
BXSP LFBBS M,2,SAYCOR [J IF READ ERROR
BXS^ ACROSS IPBLISTC,1
BY97 [
BY=W [
BY#K SAYCOR
BYB# LFBITCLR M,2
BYD3 ACROSS IPBLISTC,3
B^3= #END
^^^^ ...63203135000700000000