(George Source)
Macros used: ACROSS, ALTLEN, CHNUMCON, FREECORE, GEOERR, GETWORD, HUNT, HUNTACTF, HUNTW, MENDAREA, SEG, SEGENTRY, SETNCORE, TESTREP, TESTRPN2, TRACE, WORDFIN
228Y ... SEG IFNUMS,,CENT(COMMAND PROCESSOR),,G250
22CW ...[
22LS ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
22TQ ...[ THIS EXCLUDES CODE UNDER #SKI G250
234N ...[
23?L ...#OPT G250 = 0
23GJ ...#SKI G250&1
23PG ...# WITH UGUG EDIT M250 (ADDITIONAL NUMBER FORMATS)
23YG # THIS SEGMENT IS ENTERED FROM IFEXPAN TO DEAL WITH THE SIMPLE CONDI
24D6 # :- ON OFF ZERO MEMBER
24XQ # XCHARS CONTAINS COUNT OF CHARS REMAINING IN LINE BUFFER
25CB # ON EXIT :XCHPTR & XCHARS MAY HAVE BEEN UPDATED
25X2 # X7 CONTAINS RESULT- 0-TRUW,1-FALSE,B0=1-ERROR,B1=1-ERROR
26BL # ENTRY POINTS
26W= [ THE ENTRY POINTS
27*W [ THESE LOCATIONS MUST BE KEPT FIXED WITHIN THE SEGMENT
27TG SEGENTRY K1IFNUMS,XZERO [IF ZERO
28*6 SEGENTRY K2IFNUMS,XON [IF ON ETC.
28SQ SEGENTRY K3IFNUMS,XOFF
29#B SEGENTRY K4IFNUMS,XMEMBER
29S2 SEGENTRY K5IFNUMS,XPOS
2=?L SEGENTRY K7IFNUMS,XNEG
2=R= # WORKING SPACE IN COM PROC ACTIVITY BLOCK
2?=W #DEF XSTATE=EXT+3
2?QG #DEF XLBP=EXT
2#=6 #DEF XCHARS=EXT+1
2#PQ #DEF XCHPTR=EXT+2
2*9B # THIS SECTION SETS THE RESULT OF THE CONDITION IN X7 & RETURNS TO I
2*P2 XTRUE LDN 7 0
2B8L XRET ACROSS IFEXPAN,3
2BN= XFALSE
2C7W LDN 7 1
2CMG BRN XRET
2D76 XERROR
2DLQ LDCT 7 #400
2F6B BRN XRET
2FL2 XERROR1
2G5L LDCT 7 #600
2GK= BRN XRET
2H4W XBREAK
2HJG LDCT 7 #700
2J46 BRN XRET
2JHQ # THIS SECTION MOVES A NUMBER LIST INTO A CPB,CUNI BLOCK & APPLIES
2K3B # CHNUMCON TO IT.IT REMOVE SPACES & STRIPS BRACKETS OFF THE LIST.
2KH2 # [THIS IS FIDDLED BY INSERTING EXTRA ')'&'('ROUND COMMAS]
2L2L # IT CHECKS THE REPLY FROM CHNUMCON & SETS PTR TO GNUMCON BLOCK IN X
2LG= QMIN #40
2L^W QMAX #72
2MFG QSP #20
2M^6 QBRA #30
2NDQ QKET #31
2NYB QCOMMA #34
2P88 QK #53
2PD2 Q1 +1
2PXL QINSERT 4H),(
2QC= #DEF XUNI=ACOMMUNE1
2QWW #DEF XARITHL=ACOMMUNE2
2RBG XARITH
2RW6 SBX 7 FX1
2S*Q SETNCORE 17,2,CPB,CUNI
2STB SMO FX2
2T*2 STO 2 XUNI
2TSL LDN 0 1 [NO OF PARAM
2W#= STO 0 JPARNUM(2)
2WRW LDN 5 ANUM+1 [INITIALISE 'CHAR DUMPER'
2X?G LDN 6 0 [ BRACKET DEPTH COUNT
2XR6 BCT 4 ZX7A
2Y=Q BRN XERR
2YQB ZX3 BZE 6 ZXIT [FINISH IF DEPTH=0
2^=2 BCT 5 ZX3A [ROOM IN CPB/CUNI?
2^PL BRN ZX7
329= ZX4 BCT 5 ZX4A [ROOM IN CPB/CUNI?
32NW BRN ZX7
338G ZX3A SBN 6 2 [INCREASE DEPTH
33N6 ZX4A ADN 6 1 [DECREASE DEPTH
347Q BRN ZX6
34MB ZX5 BCT 5 ZX6 [JUMP IF SPACE IN CPB,CUNI
3572 ZX7 LDX 5 2
35LL LDX 2 FX2
366= LDX 7 XARITHL(2)
36KW LDX 1 XUNI(2)
375G SBX 5 1
37K6 LDX 0 ALOGLEN(1)
384Q ADN 0 8
38JB SBX 3 XLBP(2)
3942 STO 1 XCHPTR(2) [PTR TO BLOCK
39HL STO 0 XCHARS(2)
3=3= #SKIP K6IFEXPAN>999-999
3=GW TRACE 0,IFARITH2
3?2G ALTLEN XCHPTR(2),XCHARS(2),CPB,CUNI
3?G6 HUNT 2,CPB,CUNI
3?M# SMO FX2
3?SG STO 2 XUNI [RESET ADDR. OF CPB/CUNI
3?^Q ZX7A LDX 0 ALOGLEN(2)
3#FB SMO FX2
3#^2 STO 7 XARITHL
3*DL SLL 0 2
3*Y= ADX 2 5
3BCW SLC 5 2
3BXG SBN 5 4*A1+1
3CC6 SBX 0 5
3CWQ LDX 5 0
3DBB CALL 7 XFLB [RESET GETTER
3DW2 BRN ZX1B
3F*L ZX6 DCH 0 0(2) [DUMP CHAR IN CUNI
3FT= BCHX 2 £ [STEP PTRS
3G#W ZX2 BCHX 3 £
3GSG ZX1 BCT 4 ZX1B [CHECK FOR END OF LINE
3H#6 BRN XERR
3HRQ ZX1B LDCH 0 0(3)
3J?B TXU 0 QSP(1)
3JR2 BCC ZX2 [IGNORE SPACE
3K=L TXU 0 QBRA(1)
3KQ= BCC ZX4 [JUMP IF BRA
3L9W TXU 0 QKET(1)
3LPG BCC ZX3 [JUMP IF KET
3M96 TXL 0 QMIN(1) [JUMP IF NUMBER
3MNQ BCS ZX1A
3MTY TXU 0 QK(1)
3N36 BCC ZX1A [JUMP IF "K"
3N8B TXL 0 QMAX(1)
3ND8 BCS ZXITA [JUMP IF OTHER LETTER
3NN2
3P7L ZX1A
3PM= TXU 0 QCOMMA(1) [JUMP UNLESS COMMA
3Q6W BCS ZX5
3QLG #SKIP K6IFEXPAN>999-999
3R66 TRACE 6,IFARITH3
3RKQ BZE 6 ZXIT [FINISH IF DEPTH=0
3S5B TXU 6 Q1(1) [JUMP UNLESS DEPTH=1
3SK2 BCS ZX5
3T4L SBN 5 3 [TEST THAT THERE IS ROOM
3TJ= BZE 5 ZX7
3W3W BNG 5 ZX7
3WHG ADN 1 QINSERT [INSERT'),('
3X36 MVCH 1 3
3XGQ LDX 1 FX1
3Y2B BRN ZX2
3Y6? ...#SKI G250&1
3Y=8 ...ZXITA BNZ 6 ZX5
3YB5 ...#SKI G250&1$1
3YG2 ZXITA BNZ 6 XERR
3Y^L ZXIT SBN 2 ANUM+1 [STORE NUMBER OF CHARS
3^F= SMO FX2
3^YW SBX 2 XUNI
42DG SLC 2 2
42Y6 BZE 2 XERR [NULL STRING NOT ALLOWED
43CQ SMO FX2
43XB LDX 0 XUNI
44C2 SMO 0
44WL STO 2 ANUM
45B= LDX 2 FX2
45TW ADN 4 1 [ADJUST COUNT
46*G SBX 3 XLBP(2)
46T6 STO 3 XCHPTR(2)
47#Q STO 4 XCHARS(2)
47SB LDX 7 XARITHL(2)
48#2 CHNUMCON ,XBREAK
48RL HUNT 3,CPB,CUNI [FREE PARAM BLOCK
49?= FREECORE 3
49QW TESTRPN2 OK,XERROR1 [JUMP IF ERROR DISCOVERED BY CHNUMCON
4==G HUNTW 3,CPAR,GNUMCON [SET PTR
4=Q6 # THIS INSTRUCTION SHOULD BE UNECESSARY-BUT IS PUT IN FOR SAFETY
4?9Q BNG 3 XERROR
4?PB ADX 7 FX1
4#92 EXIT 7 0
4#NL XERR LDX 2 FX2
4*8= FREECORE XUNI(2) [FREE PARAM BLOCK
4*MW BRN XERROR [& REPORT ERROR
4B7G # THIS SUBR FINDS THE LINE BUFFER AND SETS X3 AS THE CHAR PTR
4BM6 XFLB HUNTACTF CLB,1,FX2
4C6Q SMO FX2
4CLB STO 1 XLBP
4D62 ADX 3 1
4DKL LDX 1 FX1
4F5= #SKIP K6IFEXPAN>999-999
4FJW TRACE 3,IFXFLB
4G4G EXIT 7 0
4GJ6 # THIS SUBR FINDS AN APED & SETS A PTR IN X3 TO THE EVENT INFORMATIO
4H3Q # IN APED,ANEVENT THIS IS AT APEDSP1;IN AN APED,ADELETE AT APEDSP2
4HHB XFAPED
4J32 LDX 2 FX2
4JGL LDX 6 FX2
4K2= ZH3 STO 2 FX2
4KFW HUNT 2,APED
4K^G STO 6 FX2
4LF6 BNG 2 ZH1
4LYQ LDX 0 ATYPE(2)
4MDB [EXTACT SUBTYPE
4MY2 #SKIP K6IFEXPAN>999-999
4NCL TRACE 0,IFXFAPED
4NX= SRL 0 12
4PBW ANDN 0 #77
4PWG TXU 0 QEVENT(1) [JUMP UNLESS'ANEVENT'SUBTYPE
4QB6 BCS ZH2
4QTQ ZH2A ADN 2 APEDSP1 [SET PTR TO INF
4R*B EXIT 7 1
4RT2 ZH2
4S#L TXU 0 QDELETE(1)
4SS= BCS ZH3
4T?W ADN 2 APEDSP2
4TRG EXIT 7 1
4W?6 ZH1 EXIT 7 0 [EXIT BLOCK NOT FOUND
4WQQ # TERMINAL SUBTYPES OF APED BLOCK
4X=B QEVENT +ANEVENT
4XQ2 QDELETE +ADELETE
4Y9L # THIS SECTION DEALS WITH IF ZERO
4YP= # THE NUMBER LIST IS READ & EVALUATED ONLY IF EACH NUMBER IS ZERO IS
4^8W # THE CONDITION SATISFIED
4^NG XZERO CALL 7 XARITH
5286 LDN 6 0 [SET INDICATOR TO'IF ZERO'
52MQ ZERO [ENTRY FROM IF POS & IF NEG
537B LDCT 7 #400
53M2 LDX 4 A1(3) [THIS TEST IS REDUNDANT
546L BZE 4 ZERO2
54L= LDN 7 1 [SET'FALSE'REPLY IN X7
555W LDN 2 A1(3)
55KG ZERO1 ADN 2 1 [LOOK FOR NON ZERO EXPR
5656 LDX 0 0(2)
56JQ #SKIP K6IFEXPAN>999-999
574B TRACE 0,IFZERO
57J2 BNZ 6 ZERO5
583L BNZ 0 ZERO2 ['IF ZERO'FALSE
58H= BRN ZERO4
592W ZERO5 BPZ 6 ZERO3
59GG BPZ 0 ZERO2 ['IF NEGATIVE'FALSE
5=26 BRN ZERO4
5=FQ ZERO3 BNG 0 ZERO2 [JUMP IF"IF POSITIVE"FALSE
5=^B BZE 0 ZERO2
5?F2 ZERO4 BCT 4 ZERO1
5?YL LDN 7 0 [SET'TRVE' REPLY
5#D= ZERO2 FREECORE 3
5#XW BRN XRET
5*CG # THESE SECTIONS DEAL WITH IF POSITIVE & IF NEGATIVE
5*X6 XPOS CALL 7 XARITH
5BBQ LDN 6 1 [SET INDICATOR TVE
5BWB BRN ZERO
5CB2 XNEG CALL 7 XARITH
5CTL NGN 6 1
5D*= BRN ZERO
5DSW # THESE SECTIONS DEAL WITH'IF ON'&'IF OFF'
5F#G # THE NUMBER LIST IS READ & CONVERTED & THEN CHECKED AGAINST THE SWI
5FS6 # WORD IN THE OBJECT PROGRAM.IT IS SATISFIED IF THE SPECIFIED SWITCH
5G?Q # ARE'ON'OR'OFF'.THE SWITCHES ARE NUMBERED FROM 0 TO 23 & SWITCHES
5GRB # OUTSIDE THIS RANGE GIVES THE VALUE'FALSE'TO BOTH ON & OFF & THIS
5H?2 # IS THE REPLY GIVEN IF THERE IS NO CORE IMAGE
5HQL # [SWITCH N IS HELD IN BIT N-1 OF THE OBJ PROG WORD 30]
5J== XOFF CALL 7 XARITH [READ EXPR
5JPW LDN 6 1 [SET'OFF'INDICATOR
5K9G BRN ZON1
5KP6 XON CALL 7 XARITH [READ EXPR
5L8Q LDN 6 0 [SET 'ON' INDICATOR
5LNB ZON1 LDX 4 A1(3) [NO.IN LIST
5M82 BZE 4 ZONERR
5MML LDN 2 A1(3) [INITIATE PTR
5N7= LDN 5 0 [ADN BIT WORD
5NLW ZON2 ADN 2 1 [SET BIT IN X5 ACCORDING
5P6G LDX 7 0(2) [TO EACH NO.IN THE LIST
5PL6 #SKIP K6IFEXPAN>999-999
5Q5Q TRACE 7,IFONOFF
5QKB TXL 7 Q24(1) [IF A SWITCH IS OUTSIDE THE
5R52 BCS ZON2B [RANGE 0-23 IS REFERRED TO
5RJL ZON2A LDN 7 1 [THE CONDITION IS FALSE
5S4= BRN ZERO2
5SHW ZON2B LDCT 0 #400
5T3G SMO 7
5TH6 SRC 0 0
5W2Q ORX 5 0
5WGB BCT 4 ZON2
5X22 FREECORE 3 [RELEASE CHNUMCON BLOCK
5XFL LDN 3 30
5X^= #SKI ADELO
5YDW GETWORD 3,7,READ,,,XBREAK
5YYG #SKI ADELO<1$1
5^D6 GETWORD 3,7,READ
5^XQ TESTREP NOCORE,XFALSE
62CB TESTREPN RESVIOL,XALLRIGHT
62X2 GEOERR 1,NOWORD30
63BL XALLRIGHT
63W= SMO 7
64*W LDX 4 0
64TG #SKIP K6IFEXPAN>999-999
65*6 TRACE 4,IFSWITCH
65SQ WORDFIN
66#B ANDX 4 5 [COMPARE BITS WITH SWITCH
66S2 BNZ 6 ZON3
67?L ERX 4 5
67R= ZON3 BZE 4 XTRUE [TRVE
68=W BRN XFALSE [FALSE
68QG ZONERR
69=6 LDCT 7 #400
69PQ BRN ZERO2
6=9B Q24 +24
6=P2 # THIS SECTION DEALS WITH'IF MEMBER'
6?8L # THE NUMBER IS READ & CONVERTED & THIS IS CHECKED AGAINST THE MEMBE
6?N= # NUMBER GIVEN IN THE APED BLOCK & THE CONDITION IS SATISFIED IF THE
6#7W # MATCH.IT IS NOT SATISFIED IF THERE IS NO APED BLOCK.
6#MG # [IN FACT A NUMBER LIST IS ALLOWED BUT ONLY THE FIRST NUMBER IS SIG
6*76 XMEMBER
6*LQ CALL 7 XARITH [READ EXPR
6B6B LDX 4 A1(3)
6BL2 BZE 4 ZONERR
6C5L LDX 4 A1+1(3) [PICK UP MEMBER NO.
6CK= FREECORE 3
6D4W CALL 7 XFAPED [FIND TERMINAL APED BLOCK
6DJG BRN XFALSE [FALSE IF NONE FOUND
6F46 #SKIP K6IFEXPAN>999-999
6FHQ TRACE 0(2),IFMEMBER
6G3B TXU 4 0(2) [COMPARE MEMBER NOS
6GH2 BCC XTRUE
6H2L BRN XFALSE
6HG= MENDAREA 30,GAPIFNUMS
6H^W #END
^^^^ ...35050303000200000000