{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: READBULK867)}}
====== READBULK867 ======
(George Source)
**Macros used:** [[george:macro:ABANDCOM|ABANDCOM]], [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:ALTLEND|ALTLEND]], [[george:macro:CCERROR|CCERROR]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLOSE|CLOSE]], [[george:macro:CLOSEABANDON|CLOSEABANDON]], [[george:macro:CLOSEMULT|CLOSEMULT]], [[george:macro:COOR1|COOR1]], [[george:macro:DEMAND|DEMAND]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERASEMULT|ERASEMULT]], [[george:macro:FPUT|FPUT]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNTW|HUNTW]], [[george:macro:INFINB|INFINB]], [[george:macro:ISITJOB|ISITJOB]], [[george:macro:LONGOFF|LONGOFF]], [[george:macro:LONGSET|LONGSET]], [[george:macro:LONGSTOP|LONGSTOP]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAME|NAME]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:OUTPER|OUTPER]], [[george:macro:OUTPERA|OUTPERA]], [[george:macro:RESET|RESET]], [[george:macro:RESTART|RESTART]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETERR|SETERR]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:STEP|STEP]], [[george:macro:T|T]], [[george:macro:TESTMULT|TESTMULT]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TOPFCB2|TOPFCB2]], [[george:macro:UP|UP]], [[george:macro:VFREEW|VFREEW]]
22FL #SEG READBULK8 [R.WEYAND
22PD ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
22^= #LIS K0READBULK>K0IPB>K0ALLGEO
23DW 8HREADBULK
23YG #
24D6 SEGENTRY K1READBULK,SK1READBULK
24XQ SEGENTRY K2READBULK,SK2READBULK
253M ... SEGENTRY K3READBULK,SK3READBULK
257J ... SEGENTRY K4READBULK,SK4READBULK
25?F ... SEGENTRY K5READBULK,SK5READBULK
25CB NBLANK #76322020
25X2 RUNOUT #20
2648 ...SALPHA #74
269B ...SBETA #75
26BL ...SHIFT #76
27*W SUPSEG #01270000
27TG T #64
28SQ XDEL #73
29#B XIS1 #17
29B5 ...XERR +CCNOT80CHS
29CS ... +CCWRONGILL
29S2 XIDATSG
2=?L #HAL AMXOR+IDATSG,0
2=R= #
2?=W # SUBROUTINE TO RE-FIND BLOCK BEING LENGTHENED BY ALTLENG
2?QG #
2#=6 REH MHUNTW 2,ADATA,CREADL
2#PQ EXIT 1 0
2#R7 ...#
2#SJ ...# SUBROUTINES TO TEMPORARILY PRESERVE(OVER A DEMAND) AND TO RESTORE
2#T^ ...# THE CONTENTS OF ACOMMUNE3 AND ACOMMUNE6 IN X6 AND X7 RESPECTIVELY
2#XB ...#
2#YR ...PACOM LDX 6 ACOMMUNE3(2) [SHIFT AT START OF DATA BLOCK
2*28 ... LDX 7 ACOMMUNE6(2) [RELATIVE (ADATA/CREADL) DCH POINTER
2*3K ... EXIT 0 0
2*52 ...RACOM STO 6 ACOMMUNE3(2)
2*6C ... STO 7 ACOMMUNE6(2)
2*7S ... EXIT 0 0
2*9B #
2*HR ...# SEND STOP INPUT IF NOT ALREADY SENT (AFTER UNSETTING ONE SHOT
2*W8 ...# MARKER) ; CALL ON X7
2B8L #
2BN= STOP MHUNTW 3,AMXOR,ADCB
2C7W LDCT 0 #10
2CMG LDN 5 #123 [STOP INPUT CODE
2D76 ORS 0 IWAIT(3)
2DLQ LDCT 6 #400 [DON'T WAIT FOR REPLY IN SUPER
2F6B ERS 0 IWAIT(3)
2F=? ... SLL 0 2
2FB8 ... ANDX 0 ISTATUS(3)
2FG5 ... BNZ 0 (7) [EXIT IF ALREADY STOPPED (B3)
2FL2 BRN SUPER
2G5L #
2GK= # SEND ONE SHOT INPUT IF NOT ALREADY SENT ; DROPS THROUGH TO 'SUPER'
2H4W #
2HJG ONE MHUNTW 3,AMXOR,ADCB
2J46 LDCT 0 #10
2JHQ ANDX 0 IWAIT(3)
2K3B BNZ 0 (7) [ALREADY SENT ONE SHOT
2K7? ... LDCT 0 #40
2K?8 ... ANDX 0 ISTATUS(3)
2KC5 ... BNZ 0 (7) [STOPPED-CLEARING DATA:SKIP ONE SHOT
2KH2 LDN 5 #122 [CODE FOR ONE SHOT INPUT
2L2L LDCT 0 #10
2LG= LDCT 6 #400 [DONT WAIT IN SUPER
2L^W ORS 0 IWAIT(3) [INDICATE ONE SHOT SENT
2MFG #
2M^6 # SEND SUPERVISORY SEGMENT AND AWAIT REPLY ; CODE IN X5 , REPLY X6
2NDQ #
2NYB SUPER SBX 7 FX1
2PD2 MHUNTW 3,AMXOR,ADCB
2PXL LDCT 0 #100 [SKIP SUPER IF IDENTIFIER IS CLOSED :
2QC= ANDX 0 ISTATUS(3) [MOP OFF OR FINISH NOW
2QWW BZE 0 SOUT
2RBG ERN 5 #120
2RW6 BNZ 5 SEX [UNLESS SENDING OPEN SUPERVISORY SEG
2S5Y ... ORN 5 #120 [RESET X5
2S*Q SOUT
2STB LDX 3 5
2T*2 SRL 3 6
2TSL ... SETNCORE IPBIDE-A1(3),1,AMXOR,IOUT
2W#= MHUNTW 3,AMXOR,ADCB
2WRW LDX 0 GSIGN
2X?G SLL 5 12 [WORD COUNT (=1) + SUPERVISORY CODE
2XR6 STO 0 IBSW(1) [INDICATE NO DATA
2Y=Q ADX 5 IDENTNO(3)
2YQB STOZ IMOPTY(1) [DON'T WAKE AFTER OUTPUT
2^=2 STO 5 IPBIDE(1)
2^PL BNZ 6 NOSI [NOT START INPUT
329= LDX 0 AWORK2(2)
32NW STO 0 IPBIDE+1(1) [START INPUT UP TO TERMINATOR.
338G NOSI LDX 2 IADIN(3) [ADDRESS OF IPBIN ACTIVITY
33N6 LDX 2 IPBRING(2)
347Q SBN 2 IPBRING [ADDRESS OF IPBOUT ACTIVITY
34MB LDX 4 2
3572 LDX 2 ACTRING(2)
35LL SBN 2 ACTRING
366= LDX 2 BPTR(2)
36KW CHAIN 1,2 [PUT ON END OF IPBOUT'S QUEUE
375G LDX 2 4
37K6 LDCT 0 #100
384Q ANDX 0 IPBSW(2)
38JB BZE 0 WAKAL
3942 ERS 0 IPBSW(2)
39HL FPUT
3=3= #
3=GW WAKAL LDN 4 0 [IN CASE JUMP TO PBNOP
3?2G SMO IADIN(3)
3?G6 LDXC 0 IPBSW
3?^Q BCS PBNOP [IPB INOPERABLE
3#FB BZE 6 SEX [DON'T WAIT AFTER START INPUT
3#^2 BNG 6 SEX [OR ONE SHOT INPUT
3*DL LDCT 0 #401 [SET B8 TO RECEIVE SUPERVISORY INPUT
3*Y= ORS 0 IWAIT(3) [INDICATE ASLEEP
3BCW COOR1
3BXG MHUNTW 3,AMXOR,ADCB
3CC6 LDN 4 1
3CWQ YSUG HUNTW 2,AMXOR,IDATSG
3DBB ... BNG 2 WAKALA
3DW2 LDX 0 A1+1(2)
3F*L BNG 0 SSE [J IF A SUPERVISORY SEGMENT
3FT= LDX 0 6
3G#W SBN 0 52
3GSG BNZ 0 NOSSE [J IF NOT AWAITING INPUT CLEARED REP.
3H#6 NAME 2,AMXOR,#77 [PRESERVE DATA BEING CLEARED
3HRQ BRN YSUG
3HSP ...WAKALA
3HTN ... LDX 2 A1+FPTR(3)
3HWM ... LDX 0 FOURTHWD(2) [LD FOURTHWD OF@ADEVS
3HXL ... ORX 0 FINISH [PLUS FINISH
3HYK ... SLL 0 2
3H^J ... BPZ 0 WAKAL [J. NOT FINISH OR MOPPING OFF
3J2H ... LDX 0 6
3J3G ... SBN 0 54
3J4F ... BNG 0 OPOF [J. NOT CRASH CLOSING SUP.
3J5D ... SMO IADIN(3)
3J6C ... LDX 2 IPBRING [PTR TO AMOP IPBOUT
3J6W ... SBN 2 IPBRING
3J7B ... LDCT 0 #420
3J8* ... ANDX 0 IPBSW(2) [TEST B4 AMOP - MOP OFF PM
3J9# ... BZE 0 WAKAL [J. BIT NOT SET - WAIT
3J=* ... BRN SCCX [J. BIT SET
3J?B SSE
3JR2 BCHX 2 £
3K=L LDCH 4 A1+2(2) [PICK UP SUPERVISORY CODE
3KQ= ANDX 2 BITS22LS
3KW7 ... SBN 4 #45
3KX6 ... BNZ 4 NOILL
3KY5 ... LDX 4 A1+3(2)
3K^4 ... SRL 4 12
3L23 ... SBN 4 #2420
3L32 ... BZE 4 REDS
3L3^ ... BRN XILL
3L4Y ...NOILL
3L5^ ... ADN 4 #45
3L9W SBX 4 6
3LPG NOSSE FREECORE 2
3M96 BNZ 4 YSUG
3MNQ PBNOP HUNTW 2,AMXOR,IDATSG
3N8B BPZ 2 NOSSE
3NN2 SEX ADX 7 FX1
3P7L LDX 2 FX2 [ENSURE X2-> TO CURRENT ACT.
3PM= EXIT 7 0
3PP8 ...[
3PR6 ...[ ILLEGAL SUPERVISORY RECEIVED IN ERROR
3PT4 ...[
3PX2 ...XILL
3PYY ... LDX 5 XERR+1(1) [LD. 8CHS TO RECONISE ERR
3Q29 ... LDX 6 A1+3(2)
3Q3G ... FREECORE 2
3Q4S ... BRN XCERR
3Q6W #
3QLG #
3R66 # ENTRY POINT FROM COMMAND PROCESSOR VIA READLINE MACRO FOR NEW
3RKQ # BULK INPUT FROM IPB ; INPUT WILL BE IN AN AMXOR/IDATSG BLOCK
3S5B #
3SK2 SK1READBULK
3T4L LDCT 6 #420 [READ TAPE IN NORMAL MODE
3TJ= STO 6 AWORK4(2) [INDICATE READLINE ENTRY
3W3W CALL 7 ONE [SEND ONE SHOT INPUT IF NECESSARY
3WHG BRN NEWEN
3X36 #
3XGQ # ENTRY FROM INPUT COMMAND FOR REMOTE BULK INPUT FROM THE IPB
3Y2B # CONVERT AND APPEND INPUT RECORDS TO FILE(OPENED BY PREPREAD)
3YG2 #
3Y^L SK2READBULK
3^F= # SET B0-5 OF AWORK4 TO FILE'S MODE
3^YW STOZ AWORK4(2)
42DG TOPFCB2 3 [GET PTR TO FILE'S FCB
42Y6 LDEX 0 FETM(3)
43CQ DCH 0 AWORK4(2)
43XB #
44C2 BRN NEWIN
44WL #
45B= SLOOP MHUNTW 3,ADATA,CREADL
45TW LDX 6 A1(3) [COUNT OF CHARS IN OUTPUT
46*G LDX 2 FX2
46T6 ADN 3 CPDATA
47#Q LDCH 0 0(3)
47SB SBN 0 #74
48#2 BNZ 0 NOL
48RL BCHX 3 £ [FIRST CHAR = #74 : TEST NEXT FOUR
49?= NOL LDN 4 0
49QW MVCH 3 4
4==G TXU 0 AWORK2(2)
4=Q6 BCC TERMF [TERMINATOR FOUND
4=QQ ...#UNS JPGLTER
4=RB ...(
4=XQ ... TXU 0 GTERM [UNIVERSAL TERMINATOR?
4=YB ... BCS NOTUT
4=^2 ... MHUNTW 2,AMXOR,ADCB
4=^L ... SMO IADIN(2)
4?2= ... LDX 0 IPBSW
4?2W ... ANDN 0 4 [APPLICABLE?
4?3G ... BNZ 0 TFJP [YES, TREAT AS TERMINATOR
4?46 ... LDX 2 FX2
4?4Q ... LDN 7 JSOURCE1(2) [NO, OUTPUT INFORMATORY MESSAGE
4?5B ... LDN 0 ACOMMUNE1(2)
4?62 ... MOVE 7 2
4?6L ... OUTPERA
4?7= ... OUTPARAM ACOMMUNE1(2),ACOMMUNE2
4?7W ... MONOUT JPUTIGN [UNIVERSAL TERMINATOR IGNORED
4?8G ...NOTUT
4?96 ...)
4?9Q LDX 0 AWORK1(2)
4?PB BNG 0 STBIG [J IF FILE FULL MESSAGE SENT
4#92 ADN 6 11 [RED TAPE + ROUNDING
4#NL LDN 7 0
4*8= SRL 67 2
4*MW BCHX 7 £ [TO GET POSITION OF LAST CHAR
4B7G LDX 0 ACOMMUNE3(2) [SHIFT AT START OF THIS DATA BLOCK
4BM6 SLL 0 6
4C6Q DSA 0 7 [NOT ADX AS BCHX MAY HAVE SET B23
4CLB ROK LDX 2 6
4D62 STEP ,0(2)
4DKL TESTREP2 FILEFULL,XFULL,APPWAIT,XWAIT
4F5= ADN 7 #41 [PFCC
4FJW STO 6 0(3) [WORD COUNT
4G4G STO 7 1(3) [LAST CHAR POS. AND STARTING SHIFT
4GJ6 MHUNTW 2,ADATA,CREADL
4H3Q SBN 6 2
4HHB BZE 6 NULEN [NO DATA : NULL ENTRY
4J32 ADN 2 CPDATA
4JGL ADN 3 2
4K2= SMO 6
4KFW MOVE 2 0 [INSERT RECORD
4K^G SBN 2 CPDATA
4LF6 NULEN LDN 3 CPDATA-A1+32 [MINIMUM TAPE BLOCK LENGTH
4LYQ LDN 0 128
4MDB STO 0 A1(2) [TAPE CHAR COUNT
4MY2 TXL 3 ALOGLEN(2) [LESS ONLY IF HAD LONG TAPE RECORD
4NCL BCC RILAL [RIGHT LENGTH ALREADY
4NX= ALTLEN 2,3 [REDUCE TO INITIAL SIZE
4PBW RILAL LDX 2 FX2
4PWG BRN STBIG
4QB6 #
4QTQ # FILE FULL : IF MULTIFILING OPEN ANOTHER STREAM COMPONENT
4R*B #
4RP5 ...XFULL
4S4S ... INPUTFUL XBRK1,ROK,JOVER [OUTPUT "FILE %A OVERFLOWED..."
4S#L # IF ISSUED BY JOB,FILE IS CLOSEDABANDONED AND SETERR
4SS= # OBEYED ELSE FILE IS JUST CLOSED
4S^D ... LDCT 0 #400
4T6L ... ORS 0 AWORK1(2) [SET FILE FULL FLAG AND
4T?W BRN STBIG [J TO SEARCH FOR TERMINATOR
4TRG XWAIT LONGSTOP XBRK [AWAIT FILE SPACE FROM GDR
4W?6 BRN ROK [TRY APPEND AGAIN
4WQQ XBRK CLOSE
4X=B XBRK1 CALL 5 SINFIN
4XQ2 ABANDCOM
4Y9L SINFIN
4YP= INFINB [FLIP "INPUT IN PROGRESS" BIT FOR FINISH COMMAND
4^8W EXIT 5 0
4^NG #
5286 # CLOSE FILE WHEN TERMINATOR FOUND , HAVING APPENDED IT AND A DUMMY
52MQ # RECORD (BLANK IF CARDS , NEWLINE IF TAPE) IF S-TYPE TERMINATOR
537B #
53M2 TFOUN CALL 7 STOP [PLEASE ENGAGE TERMINATED:STOP INPUT
53WS ...TFJP
546L MHUNTW 3,ADATA,CREADL [SIMULATE TERMINATOR READ
54L= LDN 0 4
555W STO 0 A1(3)
55KG LDX 0 AWORK2(2)
5656 STO 0 CPDATA(3)
56JQ TERMF LDX 1 FX2
574B LDX 6 AWORK2(1) [TERMINATOR
57J2 LDXC 4 AWORK1(1) [TYPE OF TERMINATOR : S OR T
57WC ... BCS NCLOS [J IF FILE FULL FLAG UP
58H= SBN 4 #64
592W BZE 4 NSTO [T-TYPE : DON'T STORE
59GG # S-TYPE TERMINATOR : STORE ENTIRE RECORD
5=26 MHUNTW 3,ADATA,CREADL
5=FQ LDX 6 A1(3) [RECORD CHAR COUNT
5=^B ADN 6 11 [RED TAPE+ROUNDING(8+3)
5?F2 LDN 7 0 [GET RECORD WORD COUNT IN X6
5?YL SRL 67 2
5#D= BCHX 7 £ [& POS OF LAST CHAR+1 IN X7
5#XW LDX 5 ACOMMUNE3(1) [SHIFT AT START OF BLOCK
5*CG SLL 5 6
5*M# ... ORN 5 #41 [SET PFCC IN B18-23
5*X6 DSA 5 7 [SET SHIFT IN B12-17
5BBQ LDX 3 6 [RECORD LENGTH
5BWB STEP ,0(3) [GET PTR FOR APPENDING RECORD
5CTL STO 6 0(3) [INSERT RECORD WORD COUNT
5D*= STO 7 1(3) [INSERT LAST CHAR POS+1 AND STARTING
5DSW MHUNTW 2,ADATA,CREADL
5F#G ADN 2 CPDATA [RECORD PTR
5FS6 ADN 3 2 [MOVE APPEND PTR PASS RED TAPE
5G?Q SBN 6 2 [FOR RED TAPE
5GRB SMO 6
5H?2 MOVE 2 0 [APPEND RECORD
5HQL #
5J== STEP ,2
5JPW LDN 0 2 [WORD COUNT
5K9G STO 0 0(3) [INSERT BLANK RECORD AFTER
5KP6 [TERMINATOR FOR CARDS
5L8Q STO 5 1(3) [SECOND WORD OF DUMMY RECORD HEADER
5LNB NSTO ISITJOB NOTIN
5M82 BRN NCLOS [INPUT FROM WITHIN JOB
5MML NOTIN TESTMULT STEM
5N7= CLOSE
5NLW BRN NCLOS
5P6G STEM CLOSE
5PL6 CLOSEMULT [MULTIFILING : CLOSE ELEMENT
5Q5Q NCLOS CALL 5 SINFIN
5QKB ENDCOM
5R52 #
5RJL # RESTART REQUEST RECEIVED 'CANT DO' REPLY : ERASE FILE
5S4= #
5SHW NORES CALL 7 STOP [STOP INPUT
5SRN ... LDX 4 AWORK1(2)
5T3G ... BNG 4 NCLOS [FILE FULL FLAG UP : FILE CLOSED
5T?# ... TESTMULT STREM
5TH6 CLOSEABANDON [CATERS FOR THE APPEND QUALIFIER
5W2Q BRN TISIS
5WGB STREM CLOSE
5X22 ERASEMULT [MULTIFILING : ERASE ELEMENT
5XFL TISIS ISITJOB NCLOS
5X^= SETERR [INDICATE ERROR TO COMMAND PROCESSOR
5YDW BRN NCLOS
5YYG #
5^D6 # COMMON ROUTINES TO FIND AN AMXOR/IDATSG BLOCK CONTAINING INPUT
5^XQ # FROM IDENTIFIER DEFINED IN THE AMXOR/ADCB BELONGING TO THIS CPA
62CB # AND CONVERT IT INTO LOCAL FORMAT IN ADATA/INPUSG BLOCKS
62X2 #
63BL # WAIT FOR INPUT BLOCK AND CONVERT IF VALID AND IDENTIFIER OPERABLE
63W= #
64*W WAIT MHUNTW 3,AMXOR,ADCB
64KN ... LDX 2 FX2
64L^ ... LDX 0 AWORK4(2)
64N= ... BPZ 0 WAIT1 [J. ENTRY POINT 2
64PH ... LDX 0 FINISH
64QS ... BNZ 0 OPOF [J. FINISH
64S5 ...WAIT1
64TG LDCT 0 4
65*6 ANDX 0 ISTATUS(3)
65SQ BNZ 0 STEND [END OF DATA STREAM ON PREVIOUS INPUT
668F ... LDCT 4 #450 [IF IDENTIFIER IS INOPERABLE OR
66J8 ... ANDX 4 ISTATUS(3) [STOPPED BY STOP INPUT & CLEAR,
66XX ... BNZ 4 TINOP [J TO TINOP
67?L LDCT 0 #400
67R= ADN 0 #2000 [WAKE UP IF UNAVAILABLE RECEIVED
68=W ORS 0 IWAIT(3) [INDICATE 'ACTIVITY ASLEEP'
68QG COOR1 [WAIT FOR BLOCK TO APPEAR
69=6 BRN START
69PQ #
69WY ...NEWIN MHUNTW 3,AMXOR,ADCB
6=46 ... LDCT 0 #40
6=9# ... ANDX 0 ISTATUS(3)
6=BG ... BNZ 0 NEWEN [STOPPED-CLEARING DATA:SKIP START
6=HN ... LDN 5 #221 [START INPUT : TERMINATOR IN 2ND WORD
6=P2 LDN 6 0
6?8L CALL 7 SUPER
6?N= NEWEN STOZ AWORK3(2) [NEW ENTRY
6#7W LDN 3 20
6#MG LDCH 7 JSOURCE1(2)
6*76 BNZ 7 SETU [J IF INPUT FROM CR
6*LQ ADN 3 12
6B6B LDCT 0 #100
6BL2 ANDX 0 AWORK4(2)
6C5L BNZ 0 SETU [GRAPHIC MODE
6CK= LDN 0 #74
6D4W STO 0 AWORK3(2) [INITIAL SHIFT FOR NORMAL OR ALLCHARS
6DJG SETU SETNCORE CPDATA-A1(3),1,ADATA,CREADL
6F46 STOZ CPDATA-1(1) [FOR ROUTINE AT TRAIL
6FHQ SLL 3 2
6G3B STO 3 A1(1) [INITIAL CHAR COUNT
6GH2 STBIG LDX 7 AWORK3(2) [CURRENT SHIFT IS PREVIOUS SHIFT
6H2L LDCT 4 #200
6HG= ANDX 4 7 [B1 SET IF JUST STORED 2000 CHARS
6H^W LDN 0 CPDATA
6JFG STO 7 ACOMMUNE3(2) [FOR NEXT RECORD APPENDED TO FILE
6J^6 ERS 4 AWORK3(2)
6KDQ SBN 7 #75
6KYB STO 0 ACOMMUNE6(2) [INITIAL CREADL POINTER
6LD2 BNZ 4 START [B0 WILL ALREADY BE SET IF NECESSARY
6LXL BNZ 7 START [CURRENT SHIFT NOT BETA
6MC= LDCT 0 #400
6MWW ORS 0 AWORK3(2) [STORE ALPHA IF SHIFT-SENS CHAR. MET
6NBG START MHUNTW 3,AMXOR,ADCB [DEVICE CONTROL BLOCK
6NW6 LDX 2 A1+FPTR(3) [POINT TO AMXOR/ADEVS ENTRY
6P*Q LDX 0 FOURTHWD(2) [BIT 2 SET IF MOPPING OFF
6PTB ORX 0 FINISH [B2 SET IF 'FINISH NOW'
6Q*2 SLL 0 2
6QSL BNG 0 OPOF
6QXQ ... LDCT 0 #10 [IF LINE/TERMINAL FAIL EVENT OCCURRED
6R2W ... ANDX 0 ISTATUS(3) [(B5), UNSET FLAG & DEAL W/ EVENT
6R62 ... ERS 0 ISTATUS(3)
6R96 ... BNZ 0 TLFAIL
6R#= LDX 4 IMDNPU(3) [MODE OF INPUT
6RRW HUNTW 2,ADATA,INPUSG
6S?G BNG 2 SEA [NO PARTIALLY DEALT WITH INPUT BLOCK
6SR6 LDX 1 FX2
6T=Q LDX 6 A1(2) [NO. OF CHARS STILL TO BE CONVERTED
6TQB ANDN 6 #7777
6W=2 LDX 0 A1+1(2)
6WPL STO 0 ACOMMUNE4(1)
6X9= BRN USGAL
6X#B ...[
6XCG ...[ K5 READBULK
6XGL ...[
6XKQ ...SK5READBULK
6XNW SEA HUNTW 2,AMXOR,IDATSG [LOOK FOR ORDINARY DATA
6Y8G BNG 2 WAIT [INPUT BLOCK MISSING
6YN6 MHUNTW 3,AMXOR,ADCB
6^7Q LDCT 6 #10
6^MB LDCH 0 A1(2)
7272 ANDX 6 IWAIT(3)
72LL SRC 0 3
736= ERS 6 IWAIT(3) [UNSET ONE SHOT MARKER , IF SET
73KW BPZ 0 NOTER
745G FREECORE 2 [B3 SET : INPUT DATA ENDED WITH SUB
74K6 BZE 6 SEA [NOT SET : MUST BE K2 ENTRY
754Q CALL 7 ONE [WAS ONE SHOT : REQUEST ONE MORE
75JB BRN SEA
7642 #
76HL NOTER LDX 6 A1(2)
773= SRC 0 1
77GW ANDN 6 #7777 [NO. OF CHARS IN INPUT SEGMENT
782G BPZ 0 YES [NOT MARKED 'END OF DATA STREAM'
78G6 BNZ 6 NONUL [NOT A NULL TRANSFER
78^Q FREECORE 2 [NULL TRANSFER BLOCK
79FB BRN STOVE
79^2 STEND ERS 0 ISTATUS(3) [UNSET B6 IF SET
7=DL ...# END OF DATA STREAM : IF K2 ENTRY,DEMAND 'PLEASE ENGAGE' ELSE
7=Y= ...# INDICATE END TO COMPRO
7?CW ...STOVE BRN RESTART
7*W2 NONUL LDCT 0 4
7B*L ORS 0 ISTATUS(3) [MARK 'END OF DATA' FOR NEXT ENTRY
7BT= #
7C#W # CONVERT INPUT INTO ADATA/CREADL BLOCK(S) ACCORDING TO DEVICE TYPE
7CSG # AND THE MODE OF IPB INPUT
7D#6 #
7DRQ YES BNZ 6 NOTND [J IF NOT NULL DATA TRANSFER
7DYY ... LDX 1 FX2
7F66 ... LDX 0 AWORK4(1)
7F?# ... BPZ 0 NOTND
7FDG ... FREECORE 2
7FKN ... CALL 7 ONE
7FR2 BRN SEA
7G=L NOTND LDN 0 A1+2
7GQ= LDX 1 FX2
7H9W STO 0 ACOMMUNE4(1) [START OF AMXOR/IDATSG BLOCK
7HPG NAME 2,ADATA,INPUSG
7HTY ...USGAL
7J2B ... LDCH 0 JSOURCE1(1)
7J6S ... BNZ 0 XCARD
7J?= ... ACROSS IPBTAPE,1
7JCN ...#
7JJ6 ...XCARD MHUNTW 3,ADATA,CREADL
7JNQ STO 3 ACOMMUNE5(1)
7K8B LDEX 5 A1(3) [ROOM LEFT IF PARTIALLY FULL OR 128
7KN2 ADX 3 ACOMMUNE6(1) [CPDATA OR DCH POINTER IF PART FULL
7L7L ADX 2 ACOMMUNE4(1) [LDCH POINTER IF PART USED OR A1+2
7LM= SBS 2 ACOMMUNE4(1)
7N66 #
7NKQ # INPUT FROM REMOTE CARD READER ; NPU IS ONE CARD ;
7P5B # CONVERSION COMPLETE AFTER 80 CONVERTED CHARS OR INPUT EXHAUSTED
7PK2 # COMPLETE LAST WORD WITH SPACES & REMOVE TRAILING WORDS OF SPACES
7Q4L #
7QJ= SLL 4 7
7R3W BNG 4 REMOT [INPUT MODE 2 : REMOTE
7RHG MOVE 2 20 [LOCAL CARD READER FORMAT
7S36 ADN 3 19 [POINT TO LAST WORD
7SGQ LDN 5 0 [INITIAL REMAINDER COUNT
7T2B #SKI K6IPB>100-100
7TG2 (
7T^L SBN 6 80
7WF= BNZ 6 NBIG [TP DID NOT PRODUCE 80 CHARS
7WYW )
7XDG LDN 6 0
7XY6 TRAIL LDX 0 0(3) [REMOVE TRAILING SPACE-FILLED WORDS
7YCQ TXU 0 ACES
7YXB BCS TSCS [WORD NOT SPACE FILLED
7^C2 ADN 5 4
7^WL BCT 3 TRAIL [STEP BACK A WORD
82B= # UPDATE REM COUNT FOR TRAILING SPACE CHARS IN LAST WORD
82TW TSCS ORX 3 CACT [-> CHAR 3
83*G NSCH LDCH 0 0(3)
83T6 SBN 0 #20
84#Q BNZ 0 TEND [NOT SPACE CHAR
84SB ADN 5 1 [UPDATE REMAINDER COUNT
85#2 LDCT 0 #200
85RL SBX 3 0 [STEP BACK 1 CHAR
86?= TXL 3 BITS22LS
86QW BCC NSCH [NOT -> CHAR 0
87=G BRN TEND
87Q6 #
889Q REMOT LDX 1 FX1 [REMOTE CARD READER FORMAT
88PB LDN 5 80
8992 BZE 6 TEND [BLANK CARD
89NL LDN 4 #67
8=8= RLOOP LDCH 0 0(2)
8=9D ... SEGENTRY K70READBULK
8==L ... BRN TDEL
8=?S ... TXU 0 SALPHA(1)
8=*2 ... BCC SKIAB
8=B8 ... TXU 0 SBETA(1)
8=CB ... BCS TDEL
8=DJ ...SKIAB
8=FQ ... BCHX 2 £
8=GY ... BCT 6 RLOOP
8=J6 ... BRN SPCH
8=K# ...TDEL
8=LG ... SEGENTRY K71READBULK
8=MW TXU 0 SHIFT(1)
8?7G BCS STOR [NOT #76
8?M6 BCHX 2 £
8#6Q SBN 6 1 [COUNT OF CHARS IN IDATSG IN X6
8#LB BZE 6 SPCH [BLOCK FINISHED WITH #76
8*62 LDCH 0 0(2)
8*KL TXL 0 T(1) [#64
8B5= BCS NILL
8BJW TXL 4 0 [#67
8C4G BCC NADJ [#63 80 CHARS
8L7Q ... ORX 6 GSIGN [SET B0 TO INDICATE REMOTE MODE 2 IN
8L#2 ... [USE : EXTRA INFO FOR CCERROR MACRO
8LD= ...NBIG
8LDT ... LDX 5 XERR(1) [LD 8CH RECON. FOR NOT 80 CHS
8LFD ...[
8LG3 ...[
8LGL ...[ COMERR ROUTINE
8LH9 ...[
8LHS ...XCERR
8LNQ ... CCERROR 5,6 [REPORT DCP PROTOCOL ERROR
8LT2 ... [EXTRA INFO : B0 SET&B1-10 UNSET =
8L^= ... [MODE 2 IN USE;B11-23=NO OF CHARS
8M5G ... [> 80 (+OR-)
8M6X ... [IF WRONGILL EXTRA INFO :-
8M8# ... [ REASON FOR ILLEGAL
8MMY ... BRN TLFAIL [CD,MP OFF,OR FN NOW EVENT OCCURRED
#3QW #
#4=G # END OF MESSAGE : STORE CHARACTER COUNT IN ADATA/CREADL
#4Q6 #
#4T= ...[
#4YB ...[ K3 READBULK
#53G ...[
#56L ...SK3READBULK
#59Q TMAR LDCT 0 #200 [ENTRY FOR STORING 2000 CHAR RECORD
#5PB ORS 0 AWORK3(1) [INHIBIT REVERSION TO ALPHA FOR NEXT
#5R^ ...[
#5WJ ...[
#5^7 ...[ K4 READBULK
#63Q ...[
#66* ...SK4READBULK
#672 ... MHUNTW 3,ADATA,CREADL
#67M ... SMO FX2
#68# ... STO 3 ACOMMUNE5
#692 TEND LDX 2 FX2
#6NL LDX 3 ACOMMUNE5(2) [START ADDRESS OF ADATA/CREADL
#78= LDX 0 ALOGLEN(3)
#7MW SBN 0 CPDATA-A1
#87G SLL 0 2
#8M6 SBX 0 5 [REMAINDER COUNT IN X5
#96Q STO 0 A1(3)
#9LB MHUNTW 1,ADATA,INPUSG
#=62 BNZ 6 NOTOV [INPUSG NOT FINISHED WITH YET
#=KL FREECORE 1
#?5= BRN NOFIN
#?JW NOTOV LDX 0 ACOMMUNE4(2)
##4G STO 0 A1+1(1) [PRESERVE POINTER THROUGH COMPRO
##J6 NOFIN LDX 2 FX2
#*3Q LDX 5 AWORK4(2)
#*HB ERN 5 #6000
#B32 ANDS 5 AWORK4(2) [UNSET B12 IF SET
#BGL BPZ 5 SLOOP [K2 ENTRY : APPEND TO FILE
#C2= UP [K1 ENTRY : RETURN TO COMPRO
#CFW #
#C^G # MOP OFF IN PROGRESS : CRASH CLOSE IDENTIFIER , FREE RECENT INPUT
#DF6 #
#DS9 ...XMPOF MHUNTW 3,AMXOR,ADCB
#DYQ OPOF LDCT 0 4
#FDB ANDX 0 ISTATUS(3) [B6 SET IF END OF DATA STREAM
#FY2 BNZ 0 PREC [CRASH CLOSE SENT ALREADY
#GCL SMO IADIN(3)
#GX= LDX 2 IPBRING
#HBW LDCT 0 #420 [B0 : INOP ; B4 : MOP OFF,PM
#HWG ANDX 0 IPBSW-IPBRING(2)
#JB6 BZE 0 SCC [J IF CRASH CLOSE NECESSARY
#JKY ...SCCX
#JTQ LDCT 0 #100
#K*B ORS 0 ISTATUS(3) [SIMULATE IDENTIFIER CLOSED
#KK8 ... BRN REDS
#KT2 SCC
#L#L LDN 5 #127
#LS= LDN 6 54
#M?W CALL 7 SUPER [SEND CRASH CLOSE
#MRG REDS LDCT 0 4
#N?6 ORS 0 ISTATUS(3) [INDICATE END OF DATA STREAM
#NQQ ...PREC LDX 2 FX2
#P=B ... LDX 5 AWORK4(2)
#PQ2 BRN REPCD
#Q9L #
#QP= # EITHER IDENTIFIER INOPERABLE BECAUSE PERIPHERAL NOT ENGAGED OR
#R3M ...# ERROR RESTART NEEDED : CLEAR ANY REMAINING INPUT (EXCEPT IF LINE
#RB4 ...# FAIL) THEN OUTPUT MESSAGE TO REMOTE CONSOLE AND TAKE
#RNG # ACTION APPROPRIATE TO THE REPLY
#S86 #
#S=H ...TINOP SLC 4 5 [B5 SET IF LINE OR TERMINAL FAILURE
#S#Y ... BNG 4 TLFAIL
#S*H ... LDN 0 #40
#SB6 ... ANDX 0 IWAIT(3)
#SBP ... BNZ 0 TLFAIL
#SC* ... SRC 4 2
#SFQ ... BNG 4 RESTART [IDEN ALREADY STOP INPUT & CLEARED
#SJ7 ... LDCT 0 #10
#SLJ ... ORS 0 IWAIT(3)
#SN^ ... ERS 0 IWAIT(3) [UNSET"ONE SHOT INPUT SENT"BIT IF SET
#SRB ... LDN 5 #124 [SEND STOP INPUT AND CLEAR
#STR ... LDN 6 52 [AND WAIT FOR INPUT CLEARED REPLY
#SY8 ... CALL 7 SUPER
#T2K ... LDCT 4 #40
#T52 ... ORS 4 ISTATUS(3) [SET IDEN STOPPED-CLEARING DATA FLAG
#T7C ... HUNTW 3,AMXOR,#77
#T9S ... BNG 3 NODATA [J IF NO DATA CLEARED
#T#9 ...RENAM NAME 3,AMXOR,IDATSG [UNPRESERVE DATA BLOCKS CLEARED
#TBL ... HUNTW 3,AMXOR,#77
#TF3 ... BPZ 3 RENAM
#THD ... BRN START [J TO DEAL WITH DATA CLEARED
#TKT ...NODATA
#TN= ... MHUNTW 3,AMXOR,ADCB
#TQM ...RESTART [RESET IDENTIFIER TO STARTED STATE
#TT4 ... LDCT 4 #40
#TXF ... ANDX 4 ISTATUS(3)
#T^W ... BZE 4 RESTA
#W4? ... ERS 4 ISTATUS(3) [UNSET IDENTIFIER STOPPED FLAG
#W6N ... LDX 5 AWORK4(2)
#W95 ... BNG 5 SOSI [K1 ENTRY : SEND ONE SHOT INPUT
#W?G ... LDN 5 #221 [K2 ENTRY : SEND START INPUT
#W*X ... LDN 6 0
#WD# ... CALL 7 SUPER
#WGP ... BRN XSTREAM
#WH# ...RESTA
#WHX ... LDX 5 AWORK4(2)
#WJG ... BPZ 5 XSTREAM
#WK6 ...SOSI CALL 7 ONE
#WMH ...XSTREAM
#WPY ... LDXC 4 ISTATUS(3)
#WS* ... BCC START [IDENTIFIER HAS BECOME AVAILABLE
#WWQ ... LDX 7 IDENTNO(3)
#W^7 ... LONGSET #36,SET,7 [PUT IDENTIFIER NO. IN CLONG2
#X3J ... SLL 4 4
#X4Q ... LDX 5 AWORK4(2) [SET X5 FOR REPCD & TERM
#X5^ ... BNG 4 RESET [DEV. FAILURE: ERROR RESTART REQUIRED
#X=R ... BNG 5 RNGN [END OF DATA AFTER COMPRO ENTRY
#X*N ... CALL 0 PACOM [PRESERVE ACOMMUNE3 & ACOMMUNE6
#XKG OUTPER
#Y56 DEMAND 0,JMARY,REPCD,TERM,YTER,2
#Y?B ... MFREEW ADATA,ADEMAND
#YFL ... VFREEW GMON,AOUT
#YMW ... CALL 0 RACOM
#YW6 ... BRN START
#^4B ...TLFAIL [LINE OR TERMINAL FAILURE
*2H= LDN 5 #127
*32W LDN 6 54
*3GG CALL 7 SUPER [CRASH CLOSE
*426 LDN 0 #40
*4FQ ANDX 0 IWAIT(3)
*4^B BNZ 0 REDS [ON-TEST REQUESTED : LEAVE CLOSED
*5F2 LDN 5 #120
*5YL LDN 6 48
*6D= CALL 7 SUPER [OPEN
*6FH ... LDCT 0 #40
*6GS ... ORS 0 ISTATUS(3) [IDENTIFIER NOW STOPPED:FLAG FACT(B3)
*6J5 ...#
*6KB ... [TO AID TERM OPERATOR WITH RESTART :
*6LM ... SETERR [INDICATE ERROR TO COMMAND PROCESSOR
*6MY ... [SO THAT THE IDENTIFIER IS WRONGED
*6P9 ... [(SOON AFTER ENDCOM) IF K2 ENTRY
*6QG ... LDN 0 #1000
*6RR ... ORS 0 IWAIT(3) [SET WAITING TO BE WRONGED FLAG (B14)
*6T4 ... [SO THAT THE IDENTIFIER IS WRONGED IF
*6W* ... [K1 ENTRY
*6XW BRN REDS
*7CG #
*7X6 RESET OUTPER
*8BQ MHUNTW 1,ADATA,CREADL
*8WB LDN 4 128
*9B2 LDN 0 32+CPDATA-A1
*9TL STO 4 A1(1) [START THIS BLOCK AGAIN
*=*= LDN 3 CPDATA
*=SW ... TXL 0 ALOGLEN(1)
*?#G BCC SHRAL [CREADL HAS NOT BEEN LENGTHENED
*?S6 ALTLEND 1,32+CPDATA-A1
*#?Q SHRAL STO 3 ACOMMUNE6(2) [OPERATOR SHOULD REPOSITION TAPE
*#HJ ... CALL 0 PACOM [PRESERVE ACOMMUNE3 & ACOMMUNE6
*#RB DEMAND 0,JRESET,REPCD,TERM,RETY,2 ['ENGAGE FOR ERROR RESTART'
**?2 STRID MFREEW ADATA,ADEMAND
**QL VFREEW GMON,AOUT
*B2D ... CALL 0 RACOM [RESTORE ACOMMUNE3 & ACOMMUNE6
*B== ... BNG 5 START
*BG4 ... BRN NORES
*BPW #
*B^N ...TERM [INPUT TERMINATED
*C9G ... CALL 0 RACOM [RESTORE ACOMMUNE3 & ACOMMUNE6
*CF# ... LDN 4 0
*CP6 BPZ 5 TFOUN [K2 ENTRY : AS IF TERMINATOR FOUND
*D8Q BRN SDUM
*DNB ...#
*FML REPCD BPZ 5 NORES [K2 ENTRY : NO RESTART
*FXD ...RNGN
*G7= ... LONGOFF [IF NECESSARY.
*GC4 ... NGN 4 1 [REPLY 'CANT DO'
*GLW SDUM MHUNTW 3,ADATA,CREADL
*H6G ALTLEND 3,2 [SHORTEN FOR DUMMY BLOCK
*HL6 STO 4 A1(3)
*TBL MHUNTW 3,AMXOR,ADCB
*TW= LDN 0 #40
*W*W ANDX 0 IWAIT(3) [B18 SET IF ON-TEST REQUESTED
*WTG BZE 0 NOTST
*W^C ... LDCT 5 #100
*X5# ... ANDX 5 ISTATUS(3)
*X99 ... BNZ 5 NOCC
*X*6 LDN 5 #127
*XSQ LDN 6 54
*Y#B CALL 7 SUPER
*YS2 BRN NOCC
*^?L NOTST CALL 7 ONE [SEND ONE SHOT IF NECESSARY
*^R= NOCC UP [RETURN TO COMMAND PROCESSOR
B2=W #
B3PQ SET GEOERR 1,ALRDYSET [LONGSET GIVEN TWICE
B49B MENDAREA 50,K99READBULK
B4P2 #END
^^^^ ...07060501001500000000