READBULK867
(George Source)
Macros used: ABANDCOM, ACROSS, ALTLEN, ALTLEND, CCERROR, CHAIN, CLOSE, CLOSEABANDON, CLOSEMULT, COOR1, DEMAND, ENDCOM, ERASEMULT, FPUT, FREECORE, GEOERR, HUNTW, INFINB, ISITJOB, LONGOFF, LONGSET, LONGSTOP, MENDAREA, MFREEW, MHUNTW, MONOUT, NAME, OUTPARAM, OUTPER, OUTPERA, RESET, RESTART, SEGENTRY, SETERR, SETNCORE, STEP, T, TESTMULT, TESTREP2, TOPFCB2, UP, VFREEW
- READBULK867.txt
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<X0<#70 : ADJUST CHARACTER 8CJ6 NILL LDN 0 #10 [IS1 (SUPPRESSED BLANK) OR ILL. CHAR 8D3Q NADJ ADN 0 #10 8DHB STOR DCH 0 0(3) 8F32 BCHX 3 £ 8FGL BCHX 2 £ 8G2= BCT 6 RCT 8GFW SPCH LDN 0 #20 8G^G SBN 3 1 [POINT TO LAST WORD AT END OF LOOP 8HF6 ...SPACE SBN 5 1 8HYQ ...PLAST TXL 3 BITS22LS 8JDB ... BCS TRAIL [REMOVE COUNT OF TRAILING SPACES 8JY2 DCH 0 1(3) [SPACE FILL REMAINDER OF LAST WORD 8KCL BCHX 3 SPACE 8KPJ ...RCT BCT 5 RLOOP 8L3G ...# > 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