TIDYREAD850
(George Source)
Macros used: ABANDCOM, APPEND, BRUSEN, BXE, CLOSE, CLOSEMULT, DISENGPER, ENDCOM, ENGPER, GEOERR, INFINB, INPUTFULL, ISITJOB, LONGSET, LONGSTOP, LTYPE, MENDAREA, MFREE, MHUNTW, NAME, SEG, SEGENTRY, SETNCORE, TESTCODE, TESTMULT, TESTREP2, TRACE, TRACEVER
- TIDYREAD850.txt
22FL SEG TIDYREAD,60,C DONG,USERCOMS 22^= [ 23DW [ 23YG SEGENTRY K1TIDYREAD,Z1TIDYREAD 24D6 # 24XQ # 25CB # THIS SEGMENT FREES ALL THE BLOCKS USED BY THE INPUT ROUTINES, AND 25X2 # CLOSES THE FILE USED FOR INPUT. 25YY ...#SKI JSKI38 262W ...( 264S ...PARANUM #2 266Q ... #00010004 268N ...X1900 4H1900 26=L ...XKDF9 4HKDF9 26#J ...) 26BL Z1TIDYREAD 26W= # 26WN ...#SKI JSKI38 26X6 ...( 26XJ ... LDN 0 #400 26Y2 ... ANDX 0 AWORK1(2) 26YD ... BZE 0 XCONT [ J - IF NOT BINARY 26YW ... LTYPE ,5 26^# ... BNZ 5 XCONT [ J - NOT PPT READER 26^Q ... DISENGPER [ DISENGAGE TAPE READER 2728 ... SETNCORE 5,3,CPB,CUNI [ FOR ENGPER MACRO 272L ... ADN 3 JPARNUM 2734 ... LDN 2 PARANUM(1) 273G ... MOVE 2 2 273Y ... LDX 2 FX2 274B ... TESTCODE ,READER,S1900,SKDF9 274S ...S1900 275= ...# REQUEST TO BE SWITCHED TO 1900 MODE 275N ... LDX 5 X1900(1) 2766 ... BRN STORECODE 276J ... 2772 ...SKDF9 277D ...# REQUEST TO BE SWITCHED TO KDF9 MODE 277W ... LDX 5 XKDF9(1) 278# ...STORECODE 278Q ...# FINISH SETTING UP CPB.CUNI FOR ENGPER MACRO 2798 ... STO 5 2(3) [ APARA OF CPB.CUNI 279L ... 27=4 ...# REQUEST TO RE-ENGAGE TAPE READER 27=G ... ENGPER XCANTDO,,XCANTDO,4 27=Y ... 27?B ...XCANTDO 27?S ... MFREE CPB,CUNI 27#= ...XCONT 27#N ...) 27*6 ... 27*W #SKI K6PREPREAD>199-199 27TG TRACE 1,TIDYREAD 28*6 LDEX 4 AWORK1(2) [GET TERMINATOR TYPE 28SQ SBN 4 #64 [X4 ZERO IF A T TERMINATOR 29#B BZE 4 Z7B [JUMP IF T TERMINATOR 29S2 MHUNTW 3,ADATA,ALINE [FIND THE INPUT BLOCK 2=?L #SKI K6PREPREAD>599-599 2=R= TRACEVER A1+2(3),TIDYADAT 2?=W LDX 4 A1+1(3) [GET MODE WORD 2?QG ANDN 4 #7700 [ISOLATE MODE DESCRIPTION CHARACTER 2#=6 ZCDGR BXE 6 A1+2(3),ZINAP [J IF TERMINATOR HAS BEEN READ 2#PQ BZE 4 ZGRCD [J IF GRAPHIC OR CARDS 2*9B LDX 0 A1+2(3) 2*P2 SLC 0 6 2B8L ANDN 0 #77 [TEST FOR 2BN= SBN 0 #74 [ALPHA CHARACTER 2C7W BNZ 0 ZGRCD [J IF NOT 2CMG LDX 0 A1+2(3) 2D76 LDX 1 A1+3(3) 2DLQ SLL 0 6 2F6B SLC 1 6 [TEST FOR 2FL2 DCH 1 0 [TERMINATOR 2G5L BXE 6 0,ZINAP [J IF IT IS 2GK= ZGRCD STO 6 A1+2(3) [STORE TERMINATOR 2H4W LDX 0 BITS22LS [ISOLATE MODE WORD 2HJG ANDS 0 A1+1(3) [EXCEPT B0 AND B1 2J46 ZCG LDN 0 3 2JHQ STO 0 A1(3) [STORE RECORD LENGTH=4 2K3B ZINAP NAME 3,FILE,FAPB [PREPARE BLOCK TO WRITE AWAY RECORD 2KH2 ZINAPX 2L2L APPEND ,FORCED 2LG= TESTREP2 FILEFULL,XFULLTERM,APPWAIT,WAITTERM 2L^W LDN 7 2 [BASIC DUMMY RECORD COUNT 2MFG MHUNTW 3,FILE,FAPB [FIND THE APPEND BLOCK 2M^6 LDX 0 BITS22LS [LEAVE MODE DESCRIPTION CHARACTER 2NDQ ANDS 0 A1+1(3) [BUT REMOVE THE SPACE POSITION POINT 2NYB XGRAF STO 7 A1(3) [STORE THE RECORD COUNT 2PD2 XAPPEND 2PXL APPEND ,FORCED 2QC= TESTREP2 FILEFULL,XFULLDUMMY,APPWAIT,WAITDUMMY 2QWW Z7B 2RBG ISITJOB NOTJOBEND 2RW6 XENDC CALL 5 SINFIN 2S*Q BRN XENDCOM 2STB NOTJOBEND 2T*2 CALL 7 SCLOSE 2TSL XENDCOM 2W4D ... CALL 7 XUSER 2W#= ENDCOM 2WRW XBREAK 2X?G CALL 7 SCLOSE 2XR6 XABANDCOM 2Y2Y ... CALL 7 XUSER 2Y=Q ABANDCOM 2YQB XFULLTERM 2^=2 CALL 7 XFULL 2^PL BRN ZINAPX 329= XFULLDUMMY 32NW CALL 7 XFULL 338G BRN XAPPEND 33N6 XFULL SBX 7 FX1 347Q INPUTFULL XBRK,NEXTEL,JOVER1 34MB BRN XENDC 3572 XBRK CALL 5 SINFIN 35LL BRN XABANDCOM 366= NEXTEL 36KW MHUNTW 3,ADATA,ALINE 375G ADX 7 FX1 37K6 EXIT 7 0 384Q WAITTERM 38JB CALL 7 WAIT 3942 BRN ZINAPX 39HL WAITDUMMY 3=3= CALL 7 WAIT 3=GW BRN XAPPEND 3?2G WAIT SBX 7 FX1 3?#X LONGSET IWTDEST,XGEOERR 3?M# LONGSTOP XBREAK 3?^Q BRN NEXTEL 3#FB [ 3#H5 ...XUSER 3#JS ... BRUSEN NOUS [J IF NOUSER CONTEXT 3#LH ... EXIT 7 0 3#N= ...NOUS 3#P^ ... STOZ CPREFIX(2) 3#RN ... STOZ CPREFIX+1(2) 3#TC ... STOZ CPREFIX+2(2) 3#X6 ... EXIT 7 0 3#^2 [ THIS SUBROUTINE CLOSES THE INPUT FILE 3*DL SCLOSE 3*Y= SBX 7 FX1 3BCW TESTMULT STRM 3BXG CLOSE 3CC6 BRN TOCL 3CWQ STRM CLOSE 3DBB CLOSEMULT 3DW2 TOCL 3F*L #SKI K6PREPREAD>199-199 3FT= TRACE 2,OUTTDYRD 3G#W CALL 5 SINFIN 3GSG ADX 7 FX1 3H#6 EXIT 7 0 3HRQ SINFIN 3J?B INFINB 3JR2 EXIT 5 0 3K=L # 3KCS XGEOERR 3KK2 GEOERR 1,LONGSET? 3KQ= SEGENTRY K99TIDYREAD 3L9W MENDAREA 50,K99TIDYREAD 3LPG #END ^^^^ ...43005140000200000000