IFNUMS867
(George Source)
Macros used: ACROSS, ALTLEN, CHNUMCON, FREECORE, GEOERR, GETWORD, HUNT, HUNTACTF, HUNTW, MENDAREA, SEG, SEGENTRY, SETNCORE, TESTREP, TESTRPN2, TRACE, WORDFIN
- IFNUMS867.txt
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