{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: SPOOL83)}}
====== SPOOL83 ======
(George Source)
**Macros used:** [[george:macro:CLOSE|CLOSE]], [[george:macro:COMERRX|COMERRX]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERRORX|ERRORX]], [[george:macro:FMOPG|FMOPG]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT2B|HUNT2B]], [[george:macro:HUNT2J|HUNT2J]], [[george:macro:HUNTW|HUNTW]], [[george:macro:IDFWRITE|IDFWRITE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MSEARCH|MSEARCH]], [[george:macro:MXB|MXB]], [[george:macro:NEW|NEW]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:OVER|OVER]], [[george:macro:PARAMOVE|PARAMOVE]], [[george:macro:PARSORT|PARSORT]], [[george:macro:SAWCEJX|SAWCEJX]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SPARAPAS|SPARAPAS]]
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