SPOOL83
(George Source)
Macros used: CLOSE, COMERRX, ENDCOM, ERRORX, FMOPG, GEOERR, HUNT2B, HUNT2J, HUNTW, IDFWRITE, MFREEW, MHUNT, MHUNTW, MSEARCH, MXB, NEW, OUTPARAM, OVER, PARAMOVE, PARSORT, SAWCEJX, SEGENTRY, SPARAPAS
- SPOOL83.txt
22FL #SEG SPOOL [LEN WAGSTAFF 22^= #OPT K0SPOOL=0 23DW #LIS K0SPOOL>K0GREATGEO>K0ALLGEO 23YG 8HSPOOL 24D6 # 24XQ # 25CB # THIS SEGMENT IMPLEMENTS THE SPOOL COMMAND (8.30 ONWARDS) IE 25X2 # CHANGES THE MODE OF OPERATION OF A 7503. THE 1ST PARAMETER TO 26BL # THE COMMAND IS 'MODE OF OPERATION', IE 'OFF', 'ATTENDED', OR 26W= # 'UNATTENDED'. ALL THE OTHER PARAMETERS ARE PERIPHERAL 27*W # DESCRIPTION PARAMETERS EACH DEFINING AN INTERFACE OF A 7503 27TG # 28*6 SEGENTRY K1SPOOL,X1SPOOL 28SQ # 29#B STRING 4H00OF 29S2 4H00AT 2=?L 4H00UN 2=R= # 2?=W # READY MADE BIT MASKS. 2?QG # 2#=6 SPOFFMASK1 #74777777 [OFF ;IDF IDENT CELL 2#PQ SPMASK1 #03000000 [UNATTENDED 2*9B #02000000 [ATTENDED 2*P2 # 2B8L SPOFFMASK2 #77777771 [OFF ;AMXOR/ADCB 2BN= SPMASK2 #00000006 [UNAT 2C7W #00000004 [AT 2CMG # 2D76 SPOFFMASK3 #76377777 [OFF ;IDF 7020 CELL 2DLQ SPMASK3 #01400000 [UNAT 2F6B #01000000 [AT 2FL2 # 2G5L SPOFFMASK4 #77757577 [OFF ;A7020/INFORM 2GK= SPOFFMASK5 #77767677 [UNAT 2H4W SPMASK4 #00020200 [UNAT 2HJG #00020000 [AT 2J46 SPMASK5 #00010100 [UNAT 2JHQ #00010000 [AT 2K3B # 2KH2 # CONVERSION TABLE FOR DEVICE TYPES; IN IDF 2L2L # LP=1,CR=2,TW=3,TR=4,TP=5 2LG= # IN CPAR/JSCE, GEORGE DEVICE TYPES ARE USED - 2L^W # LP=2,CR=3,TW=63,TR=0,TP=1 2MFG # 2M^6 PCTTAB #020000 2NDQ #030000 2NYB #770000 2PD2 +0 2PXL #010000 2QC= # 2QWW PAPFERR +APFERR 2RBG PJPARMIS +JPARMIS 2RW6 PJSETP8 +JSETP8 2S*Q PJSPNOTPER +JSPNOTPER 2STB PJUSNOTPER +JUSNOTPER 2T*2 # 2TSL # ERROR PATHS 2W#= # 2WRW NUTS GEOERR 1,SPOOLBUG 2X?G # 2XR6 W1 LDX 1 FX1 2Y=Q LDX 7 PJSETP8(1) [1ST PARAM MISSING 2YQB LDX 6 PJPARMIS(1) 2^=2 COMERRX 6,7 2^PL # 329= W2 LDX 1 FX1 32NW LDX 6 PAPFERR(1) [FORMAT ERROR 338G COMERRX 6 33N6 # 347Q W3 LDX 1 FX1 34MB LDX 6 PJSPNOTPER(1) [SPOOLING NOT PERMITTED 3572 BRN W34 35LL # 366= W4 LDX 1 FX1 36KW LDX 6 PJUSNOTPER(1) [UNATTENDED SPOOLING NOT PER. 375G W34 MHUNTW 3,CPAR,JSCE [ON UNIT SO-AND-SO 37K6 LDX 0 JSCEQ(3) [CT OF CHARS 384Q ANDN 0 #7777 38JB OUTPARAM 0,JSCER,CPAR,JSCE 3942 ERRORX 6 39HL BRN XFREE 3=3= # 3=GW # SUBROUTINES 3?2G # 3?G6 SEARCH 3?^Q SBX 7 FX1 3#FB MSEARCH 1,2,4 3#^2 ADX 7 FX1 3*DL EXIT 7 0 3*Y= # 3BCW XHUNT SBX 0 FX1 3BXG LDX 2 FX2 3CC6 STO 0 AWORK4(2) 3CWQ LDXC 7 6 [IDF RECORD NUMBER 3DBB LDEX 6 6 [INTERNAL CELL PTR 3DW2 SRL 7 9 3F*L STO 7 ACOMMUNE3(2) 3FT= MXB 2 [X2=PTR TO RECORD (IN CORE) 3G#W ADX 2 6 [X2=PTR TO CELL (IN CORE) 3GSG SMO FX2 3H#6 LDX 0 AWORK4 3HRQ ADX 0 FX1 3J?B EXIT 0 0 3JR2 # 3K=L # 3KQ= # 3L9W # SET MARKER ACCORDING TO OFF,AT,UNAT; FIND APPROPRIATE IDF 3LPG # CELL; SET OR UNSET BITS THEREIN; IF MOPPED ON, SET OR UNSET 3M96 # BITS IN AMXOR/ADCB OR A7020/INFORM; WHEN FINISHED, WRITE 3MNQ # TO IDF, CLOSE IT, AND ENDCOM. 3N8B # 3NN2 X1SPOOL 3P7L SPARAPAS [GET 1ST PARAMETER 3PM= MHUNT 3,CPB,CUNI 3Q6W LDX 0 ANUM(3) 3QLG BNG 0 W1 [MISSING OR NULL 3R66 BZE 0 W1 3RKQ ANDN 0 #7777 3S5B SBN 0 2 3SK2 BNG 0 W2 [FORMAT ERROR 3T4L LDX 0 APARA(3) 3TJ= SRL 0 12 3W3W TXU 0 STRING(1) 3WHG BCC SPOFF [SPOOL OFF 3X36 TXU 0 STRING+1(1) 3XGQ BCC SPAT [SPOOL ATTENDED 3Y2B TXU 0 STRING+2(1) 3YG2 BCC SPUN [SPOOL UNATTENDED 3Y^L BRN W2 [FORMAT ERROR 3^F= # 3^YW SPOFF LDX 0 GSIGN [SET MARKER IN AWORK2 42DG BRN STO 42Y6 SPAT LDN 0 1 43CQ BRN STO 43XB SPUN LDN 0 0 44C2 STO STO 0 AWORK2(2) 44WL # 45B= LDX 0 ANUM(3) [THROW AWAY 1ST PARAMETER.. 45TW ANDN 0 #7777 [..SO WE CAN DO "PARSORT ALL" 46*G PARAMOVE 0 [SET MARKER "NO PERIPHERAL.. 46T6 LDN 0 1 [DESC. PARAMETERS ACCESSED.. 47#Q STO 0 AWORK1(2) [ YET" 47SB # 48#2 PARSORT NUTS,ALL,IDF 48RL # 49?= NEXT HUNTW 3,CPAR,JSCE [GET NEXT PARAM 49QW BNG 3 OVER 4==G LDX 0 JSCEB(3) 4=Q6 BPZ 0 W3 [J IF LOCAL 4=RN ... LDX 4 JSCEB(3) 4=T= ... SRL 4 21 4=WS ... SBN 4 5 4=YB ... BNZ 4 NEXTA [J IF NOT PCT 4=^Y ... LDX 4 JSCEA(3) 4?3G ... BZE 4 NEXTA [J IF MOP LINE 4?54 ... ANDN 4 #77 4?6L ... BZE 4 W3 [J IF NO INTERFACE 4?88 ...NEXTA 4?9Q STOZ AWORK1(2) [="PERIPH.DESC.PARAM ACCESSED" 4?PB LDX 0 JSCEA(3) 4#92 BZE 0 W3 [J IF MOP LINE 4#NL LDCH 0 JSCEA(3) [GET DEVICE TYPE 4*8= BZE 0 TOK [TR 4*MW SBN 0 2 4B7G BZE 0 TOK [LP 4BM6 SBN 0 1 4C6Q BZE 0 TOK [CR 4CLB SBN 0 60 4D62 BZE 0 TOK [TW 4DKL BRN W3 [WRONG DEVICE TYPE 4F5= # 4FJW TOK STOZ ACOMMUNE3(2) [FIND ZERO RECORD OF IDF 4G4G NEW 1 4GJ6 # 4H3Q SAWCEJX JSCEB(3),W3,SPIPB,SPMX 4HHB # 4J32 # MESSAGE BUFFERING: FIRST WE HAVE A NUMBER OF CHECKS. 4JGL # FOR INPUT DEVICES (A) UNATTENDED IS NOT ALLOWED (B) 7503 4K2= # BIT IN IDF MAY NOT BE SET - SO WE MUST BRN ROUND OUT 4KFW # TEST. FOR OUTPUT DEVICES ALL CASES ARE ALLOWED & 7503 BIT ALWAYS 4K^G # CHECKED. 4LF6 # 4LNY ...SPIPB LDEX 0 JSCEB(3) 4LYQ ... BZE 0 W3 [J IF CI 4M8J ... STOZ 6 [INITIALISE MARKER ;CHECK 4MDB LDCH 0 JSCEA(3) [ 7503 BIT" 4MY2 SBN 0 2 4NCL BZE 0 SPOUT [J IF OUTPUT DEVICE 4NX= LDX 6 GSIGN [SETMARKER"DONTCHECK7503BIT" 4PBW SBN 0 61 4PWG BZE 0 SPOUT [J IF TW 4QB6 LDX 0 AWORK2(2) 4QTQ BZE 0 W4 [J IF UNAT INPUT 4R*B # 4RT2 SPOUT LDN 2 BIPB 4S#L LDEX 4 JSCEB(3) 4SS= LDX 5 JSCEA(3) 4T?W ANDN 5 #7777 4TRG CALL 7 SEARCH [FIND IPB CELL 4W?6 ADN 2 BLINE 4WQQ LDX 4 5 4X=B CALL 7 SEARCH [FIND IDENTIFIER CELL 4XQ2 ADX 2 1 [X2=ABS PTR TO CELL 4Y9L LDX 1 FX1 4YP= ... BNZ 6 SM0 [J IF "DONTCHECK7503BIT" 4^8W LDX 0 BTYPE(2) 4^NG SLL 0 8 5286 BPZ 0 W3 [J IF NOT 7503 52MQ # 537B SM0 LDX 0 SPOFFMASK1(1) 53M2 ANDS 0 BNUMB(2) [UNSET BITS FOR STARTERS 546L SMO FX2 54L= LDX 0 AWORK2 555W ... BNG 0 SM1 [IF SPOOL OFF- NICELY DONE! 55KG SMO 0 5656 LDX 0 SPMASK1(1) 56JQ ORS 0 BNUMB(2) [ELSE SET APPROPRIATE BITS 574B # 57J2 SM1 MHUNTW 3,CPAR,JSCE 583L LDEX 4 JSCEB(3) [NOW FIND AMXOR/ADEVS 58H= FMOPG 2,4,IPB 592W HUNT2J 2,AMXOR,ADEVS,,XFREE 59GG LDX 5 A1+FOURTHWD(2) [CALC INTERNAL ADEVS PTR 5=26 LDX 4 JSCEA(3) 5=FQ ANDN 4 #7777 5=^B SBX 4 5 5?F2 SLL 4 2 5?YL SMO 4 [LOOK AT ADEVS ENTRY 5#D= LDX 3 A1+BPTR(2) 5#XW BZE 3 XFREE [NO DCB- NOTHING ELSE TO DO 5*3R ... LDCT 0 #20 5*5P ... SMO 4 5*7N ... ANDX 0 A1+FOURTHWD(2) 5*?K ... BNZ 0 XFREE 5*CG # 5*X6 SBN 3 A1 [X3 PTS TO START OF DCB 5BBQ LDX 1 FX1 5BWB LDX 0 SPOFFMASK2(1) 5CB2 ... ANDS 0 IBULK(3) [UNSET BITS IN DCB 5CTL SMO FX2 5D*= LDX 0 AWORK2 5DSW BNG 0 XFREE [IF OFF, DONE 5F#G SMO 0 5FS6 LDX 0 SPMASK2(1) 5G?Q ORS 0 IBULK(3) [SET BIT(S) 5GRB BRN XFREE 5H?2 # 5HQL # 5J== # CHARACTER BUFFERING: UNATTENDED IS NOT ALLOWED, 5JPW # NO OTHER COMPLICATIONS. 5K9G # 5KP6 SPMX LDX 0 JSCEA(3) 5L8Q STO 0 AWORK3(2) [SAVE INFO TO AVOID HUNTS 5LNB # 5M82 LDN 2 BUNIT 5MML LDEX 4 JSCEB(3) 5N7= LDX 5 JSCEB(3) 5NLW SRL 5 9 5P6G ANDN 5 #77 5PL6 CALL 7 SEARCH [FIND MX CELL 5Q5Q ADN 2 BLINE 5QKB LDX 4 5 5R52 CALL 7 SEARCH [FIND LINE CELL 5RJL ADX 2 1 [X2=ABS PTR TO CELL 5S4= LDX 6 BLINE(2) 5SHW BZE 6 NUTS [NO 7020 CHAIN 5T3G # 5TH6 SC1 CALL 0 XHUNT [FIND INTERFACE CELL 5W2Q LDX 1 FX1 5WGB LDCH 0 BTYPE(2) 5X22 SMO 0 [CONVERT DEVICE TYPE 5XFL LDX 0 PCTTAB-1(1) 5X^= LDX 4 BNO(2) 5YDW SRL 4 12 5YYG ORX 0 4 [X0=DEVICETYPE+TERIDENTIFIER.. 5^D6 SMO FX2 [..(RROM IDF) 5^XQ LDX 4 AWORK3 62CB SRL 4 6 [X4=SAME BUT FROM CPAR/JSCE 62X2 TXU 0 4 63BL BCC SC2 [J IF REQD CELL FOUND 63W= LDX 6 0(2) 64*W BZE 6 NUTS [J IF NOT FOUND AT ALL 64TG BRN SC1 [TRY NEXT CELL 65*6 # 65SQ SC2 LDX 0 BNUMB(2) 66#B SLL 0 4 66S2 BPZ 0 W3 [J IF NOT 7503 67?L SMO FX2 67R= LDX 0 AWORK2 [CHAR BUFF UNATTENDED 68=W BZE 0 W4 [IS NOT ALLOWED AP PRESENT 68QG # 69=6 LDX 1 FX1 69PQ LDX 0 SPOFFMASK3(1) 6=9B ANDS 0 BNUMB(2) [CLEAR BITS 6=P2 SMO FX2 6?8L LDX 0 AWORK2 6?N= BNG 0 SC3 [J IF SPOOL OFF 6#7W SMO 0 6#MG LDX 0 SPMASK3(1) 6*76 ... ORS 0 BNUMB(2) [SET BIT(S) 6*LQ # 6B6B SC3 MHUNTW 3,CPAR,JSCE 6BL2 LDEX 4 JSCEB(3) [NOW FIND AMXOR/ALINES 6C5L FMOPG 2,4,MXUX 6CK= HUNT2J 2,AMXOR,ALINES,,XFREE 6D4W LDX 4 JSCEB(3) [CALC INTERNAL ALINES PTR 6DJG SRL 4 9 6F46 ANDN 4 #77 6FHQ SLL 4 2 6G3B SMO 4 [LOOK AT ALINES ENTRY 6GH2 LDX 3 A1+BPTR(2) 6H2L BZE 3 XFREE [NO LCB- NOTHONG ELSE TO DO 6HG= # 6H^W SBN 3 A1 [X3 PTS TO START OF LCB 6JFG HUNT2B 3,A7020,INFORM 6J^6 LDX 1 FX1 6KDQ SMO FX2 6KYB LDX 4 AWORK3 6LD2 ANDN 4 #77 6LXL LDX 5 4 [EXTRA COPY 6MC= SBN 4 5 6MWW BPZ 4 SC4 [J IF INTERFACE 5 OR 6 6NBG LDX 0 SPOFFMASK4(1) 6NW6 SMO 5 6P*Q SLC 0 0 [LINE UP ACCORDING TO INTERFACE 6PTB BRN SC5 6Q*2 SC4 LDX 0 SPOFFMASK5(1) 6QSL SMO 4 6R#= SLC 0 0 6RRW SC5 ANDS 0 APCTSTAT(3) [UNSET BITS 6S?G # 6SR6 SMO FX2 6T=Q LDX 0 AWORK2 6TQB BNG 0 XFREE [J IF SPOOL OFF- JOB DONE 6W=2 BPZ 4 SC6 6WPL SMO 0 [ELSE SET BIT(S) 6X9= LDX 0 SPMASK4(1) 6XNW SMO 5 6Y8G SLC 0 0 6YN6 BRN SC7 6^7Q SC6 SMO 0 6^MB LDX 0 SPMASK5(1) 7272 SMO 4 72LL SLC 0 0 736= SC7 ORS 0 APCTSTAT(3) [JOB DONE ATLAST! 73KW # 745G # 74K6 # 754Q XFREE MFREEW CPAR,JSCE 75JB BRN NEXT 7642 # 76HL # 773= # 77GW # 782G OVER LDX 0 AWORK1(2) [J IF IDF NOT OPEN.(NOWT DONE) 78G6 BNZ 0 NOIDF 78^Q IDFWRITE 79FB CLOSE 79^2 NOIDF ENDCOM 7=DL # 7=Y= #END ^^^^ ...047673750006