(George Source)
Macros used: ABANDCOM, ACROSS, ADDREC, BACKSPACE, BXE, BXU, CLOSE, CLOSEABANDON, CLOSEMULT, COMERRX, ENDCOM, ERASEMULT, ERROR, FINDCORE, FREECORE, GEOERR, GETCORE, HUNT2, HUNTW, INFINB, INPUTFULL, LONGSET, LONGSTOP, MENDAREA, MHUNT, MHUNTW, NAME, PARAMSUB, READ, SEG, SEGENTRY, STEP, TESTMULT, TESTREP2
22FL SEG INPUTJDF,74,P STANSFIELD,USERCOMS 22^= [ 23DW [ 23YG SEGENTRY K1INPUTJDF,Z1INPUTJDF 24D6 [ 24XQ [THIS SEGMENT IS ENTERED FROM PREPREAD IF INPUT IS FROM JDF/MDF 25CB [ 25X2 [ 26BL [THIS SUBROUTINE STEPS FOR APPENDING A RECORD WHOSE LENGTH IS IN X1 AND 26W= [MOVES THE RECORD INTO THE FUAB 27*W [ 27TG XAPP SBX 5 FX1 28*6 STEP LDX 2 A1(2) 28SQ ... SBN 2 503 [ >2000 CHARACTERS IN RECORD ? 29#B BNG 2 XSTEP [ J IF OK 29S2 BRN M2XCEED [ ERROR-RECORD OVERFLOW 2=?L XSTEP 2=R= ... ADN 2 503 2?=W STEP ,0(2),XBREAK 2?QG TESTREP2 FILEFULL,XFULL,REFUSED,REFUS,APPWAIT,WAIT 2#=6 MHUNTW 2,FILE,FRB 2#PQ LDX 4 2 2*9B LDX 1 A1(2) 2*P2 ADN 2 A1 2B8L MOVE 2 0(1) 2BN= ADX 5 FX1 2C7W EXIT 5 0 2CCN WAIT 2CMG LONGSET IWTDEST,XGEOERR 2CX# LONGSTOP XBREAK 2D76 XHUNT MHUNTW 2,FILE,FRB 2DLQ BRN STEP 2F6B [ 2FL2 XALAS LDX 3 FX2 2G5L NEXT HUNT2 3,CPB,CALAS 2GK= LDX 0 CPBCPLEV(3) 2H4W BNG 0 NEXT 2HJG EXIT 5 0 2J46 [ 2JHQ [THIS SUBROUTINE READS A RECORD FROM JDF AND TESTS IT FOR TERMINATOR. 2K3B [THE TERMINATOR HAS BEEN READ: EXIT 7 0 2KH2 [THE TERMINATOR HAS NOT BEEN READ: EXIT 7 1 2L2L [ 2LG= SREAD LDX 1 AWORK3(2) [AWORK3=1 IF MULTIFILE 2L^W SBX 7 FX1 2MFG READ 1(1) 2NDQ CALL 5 XALAS 2NYB MHUNT 2,FILE,FRB [FIND THE RECORD BLOCK 2PD2 LDX 1 A1(2) 2PXL BZE 1 XERR [J IF NO RECORD 2QC= ADDREC 3,0 [STEP THE RECORD COUNT 2QWW SMO FX2 2RBG LDX 3 AWORK1 2RW6 ANDN 3 #4000 2S*Q BZE 3 NOPS [ PARAMSUB SPECIFIED? 2STB LDCT 4 #600 2T*2 ANDX 4 A1+1(2) 2TSL BNZ 4 SPARECHARS 2W#= LDN 4 1 2WRW SPARECHARS 2X?G ADX 4 A1(2) 2XR6 SBN 4 3 2Y=Q BZE 4 NOPS 2YQB SLC 4 2 2^=2 LDX 5 A1+1(2) 2^PL HUNTW 1,FI,FUTILITY 329= NAME 2,FI,FUTILITY 32NW BPZ 1 SETFRB 333? ... LDX 3 2 33*N ... GETCORE A1(3),1 33N6 FINDCORE 1 347Q SETFRB 34MB NAME 1,FILE,FRB 3572 ANDX 5 BITS22LS 35LL STO 5 A1+1(1) 366= PARAMSUB FI,FUTILITY,A1+2,FILE,FRB,,4 36KW TESTREP2 NALL,XGER,IPID,PIDERR 375G LDX 4 ACOMMUNE2(2) 37K6 MHUNTW 2,FILE,FRB 384Q #SKI K6PREPREAD>599-599 38JB BLOCKTRA 2,FILEFRB 3942 LDX 3 4 39HL SLC 4 2 3=3= SBN 4 A1*4 3=GW LDN 5 0 3?2G SRL 45 2 3?G6 BZE 5 NOODD 3?^Q ORS 5 A1+1(2) 3#FB ADN 4 1 3#^2 ADX 3 2 3*DL SLC 5 2 3*Y= LDN 0 4 3BCW SBX 0 5 3BXG LDN 5 #20 3CC6 SPACEFILL 3CWQ DCH 5 0(3) 3DBB BCHX 3 £ 3DW2 BCT 0 SPACEFILL 3F*L NOODD STO 4 A1(2) 3FN3 ...NOPS ADX 7 FX1 3FQL ... LDX 0 A1(2) 3FT9 ... SBN 0 3 3FXS ... BNG 0 NOTRM 3G2D ... BXE 6 A1+2(2),YTRM 3G7M ...NOTRM 3G#W LDX 0 A1+1(2) 3GSG ANDN 0 #7700 3H#6 BZE 0 YNTM [J IF GRAPHIE 3HRQ LDCH 5 A1+2(2) 3J?B SBN 5 #74 [OF LAST RECORD ALPHA? 3JR2 BNZ 5 YNTM [J IF NOT 3K=L LDX 5 A1+2(2) 3KQ= SLL 5 6 [REMOVE ALPHA 3L9W LDCH 0 A1+3(2) 3LPG ORX 5 0 [INSERT CHARACTER 3M96 BXU 6 5,YNTM [TEST FOR TERMINATOR 3MNQ YTRM EXIT 7 0 [TERMINATOR HAS BEEN READ 3N8B YNTM EXIT 7 1 [TERMINATOR HAS NOT BEEN READ 3NN2 [ 3P7L [ 3PM= [ 3Q6W Z1INPUTJDF 3QLG LDX 6 AWORK2(2) [PICK UP TERMINATOR 3R66 LDN 7 1 3RKQ TESTMULT NOTDEPTH1 3S5B LDN 7 0 3SK2 NOTDEPTH1 3T4L STO 7 AWORK3(2) 3TJ= RD CALL 7 SREAD [READ RECORD 3W3W BRN TERM 3WHG NOTTM CALL 5 XAPP 3X36 FREECORE 4 [FREE RECORD BLOCK 3XGQ BRN RD [READ NEXT RECORD 3Y2B TERM 3YG2 MHUNTW 3,FILE,FRB [FIND THE RECORD BLOCK 3Y^L NAME 3,ADATA,ALINE 3^F= ACROSS TIDYREAD,1 3^YW XFULL INPUTFULL XBRK,XHUNT,JOVER1 42DG NGN 6 1 [ JDF,MDF IS THE OMLY FILE NOW OPEN 42Y6 STO 6 AWORK3(2) [ AWORK3=-1 TO REFLECT LEVEL 0 43CQ LDX 6 AWORK2(2) 43XB SRD CALL 7 SREAD 44C2 BRN QUIT 44WL FREECORE 2 45B= BRN SRD 45TW QUIT FREECORE 2 [FREE THE INPUT BUFFER 46*G CALL 5 SINFIN [UNSET BIT FOR FINISH 46T6 ENDCOM 47#Q XBRK 47SB CALL 5 SINFIN 48#2 ABANDCOM 48RL XERR [COME HERE IF READ OFF END OF FILE 49?= LDX 2 FX2 49QW LDX 1 AWORK3(2) 4==G BACKSPACE 1(1) 4=Q6 ERROR BMISS,JTERM [ERROR 'TERMINATOR MISSING' 4?9Q CALL 7 SCLOSE 4?PB ENDCOM 4#92 REFUS 4#NL CALL 7 SCLOSE 4*8= CALL 3 XCOMERR 4*MW +EREXQUOTA 4B7G PIDERR 4BM6 CALL 7 XABAND [ CLOSE FILE+ABANDON 4C6Q CALL 3 XCOMERR 4CLB +JPARIDERR 4D62 XCOMERR 4DKL LDX 3 0(3) 4F5= COMERRX 3 4FJW XGER GEOERR 1,PSLEVEL 4G4G XBREAK 4GJ6 CALL 7 SCLOSE 4H3Q ABANDCOM 4HHB SCLOSE 4J32 SBX 7 FX1 4J88 ... LDX 0 AWORK3(2) 4J*B ... BNG 0 XENDC [J IF FILE CLOSED BY INPUTFULL 4JGL TESTMULT STRM 4K2= CLOSE 4KFW BRN XENDC 4K^G STRM CLOSE 4LF6 CLOSEMULT 4LYQ XENDC 4MDB CALL 5 SINFIN 4MY2 ADX 7 FX1 4NCL EXIT 7 0 4NX= [ 4PBW [ THIS SUBROUTINE UNSETS BIT FOR FINISH COMMAND 4PWG SINFIN 4QB6 INFINB 4QTQ EXIT 5 0 4R*B # 4RT2 M2XCEED 4S4S ... LDX 2 FX2 4S#L CALL 7 XABAND [ CLOSE FILE+ABANDON 4SS= CALL 3 XCOMERR [ ERROR-RECORD OVERFLOW 4T?W +JRECOFLOW 4TRG XABAND 4W?6 SBX 7 FX1 4WD# ... LDX 0 AWORK3(2) 4WKG ... BNG 0 XENDC [J IF FILE CLOSED BY INPUTFULL 4WQQ TESTMULT XMULT [ J IF M,F 4X=B CLOSEABANDON 4XQ2 BRN XENDC 4Y9L XMULT CLOSE 4YP= ERASEMULT 4^8W BRN XENDC 4^B4 XGEOERR 4^H= GEOERR 1,LONGSET? 4^NG SEGENTRY K99INPUTJDF 5286 MENDAREA 100,K99INPUTJDF 52MQ #END ^^^^ ...47027426001100000000