PERTYPNO840
(George Source)
Macros used: BXL, BXU, GEOERR, MENDAREA, SEGENTRY, UP
- PERTYPNO840.txt
22FL #LIS K0PERTYPNO 22^= #SEG PERTYPNO6 [R H TERRY 23DW 8HPERTYPNO 23YG # THIS SEGMENT CONVERTS A PERIPHERAL TYPE & UNIT NUMBER TO A FOUR CH 24D6 # PERIPHERAL NAME [E.G.MT14 OR LP2 ].IT IS USED BY THE'PERTYPNO'MACR 24XQ # ON ENTRY EXEC3 OF THE CURRENT ACTIVITY BLOCK CONTAINS:- 25CB # UP TO MK6 : B0-5 TYPE NO ,B6-14 UNIT NO ,B15-23 UNDEFINED 25X2 # MK6.5 ON : B0-8 TYPE NO ,B9-23 UNIT NO 26BL # ON EXIT EXEC3 HOLDS THE PERIPHERAL NAME 26W= # IF THE TYPE DOES NOT CORRESPOND TO A REAL PERIPHERAL THE NAME 27*W # WILL START WITH'XX'. 27TG # 28*6 [ ENTRY POINTS 28SQ [ 29#B SEGENTRY K1PERTYPNO,ZEP1 [ENTRY FOR FULL PERIPHERAL NAME CONVN 29S2 SEGENTRY K11PERTYPNO,ZEP11 [ENTRY FOR PERIPHERAL TYPE ONLY 2=3S ... SEGENTRY K2PERTYPNO,ZEP2 [ENTRYFROM MFPERTYPNO INMONOLITH 2=?L [ 2=R= # THIS IS A TABLE CONTAINING THE TYPES IN CHARACTERS OF THE VARIOUS 2?34 ... SEGENTRY K80PERTYPNO 2?=W MNEM 28HTRTPLPCRCPMT****DDDRITMXCT** 2?QG ... 28HID1516171819GPGD22UDCC25**27 2#=6 28HPB29303132333435363738394041 2#FY #SKI JSKI19<1$1 2#PQ 28H4243444546474849FRFWGECOEMOI 2#WY #SKI JSKI19 2*46 28H4243444546474849FRFWFHCOEMOI 2*9B 16HOOCSRRETCI616263 2*P2 MAX +64 2B8L TEN +10 2BN= SPAC1 #77770000 2C7W UDAS 4H**00 2C?R ...ZEP2 STOZ AWORK1(2) 2CCN ... STO 1 AWORK2(2) 2CHK ... BRN XJOIN 2CMG ZEP11 [ENTRY FOR PERIPHERAL TYPE ONLY 2D76 NGNC 0 1 2DLQ ZEP1 [ENTRY FOR FULL PERIPHERAL NAME CONVN 2F6B NGN 0 0 2FL2 STO 0 AWORK1(2) [B0 SET FOR K11 ENTRY 2FR8 ... STOZ AWORK2(2) 2FYB ...XJOIN 2G5L LDX 5 EXEC3(2) 2GK= LDX 0 5 [ REMOVE 2H4W ANDX 0 ZFORMAT(1) [ THIS 2HJG BZE 0 ZFOK [ CHECK 2J46 GEOERR 1,PRLFRMAT [ IN 2JHQ ...ZFORMAT #70077400 [ MARK 2K3B ZFOK [ SEVEN 2KH2 LDN 4 0 2L2L SLL 45 9 [TYPE NO IN X4 2L=D ... LDX 6 4 [SAVE TTYPE 2LG= SRL 5 9 [UNIT NO IN X5 2L^W TXL 4 MAX(1) [TEST WHETHER TYPE NO. VALID 2MFG BCC ZER 2M^6 SRC 4 1 2NDQ SMO 4 2NYB LDX 0 MNEM(1) [LOADS CHARACTERS FROM TABLE 2PD2 BPZ 4 ZA 2PXL SLL 0 12 2QC= ZA ANDX 0 SPAC1(1) 2QWW STO 0 7 2RBG BXU 7 UDAS(1),NUDAS [J IF NOT UDAS TYPE 2RW6 LDX 7 FRED [ ELSE GET INSTALATION- CHOSEN 2S*Q ANDX 7 HALFTOP [ MNEMONIC 2STB NUDAS 2T*2 LDXC 0 AWORK1(2) 2TSL BCC ZD [J IF K1 ENTRY 2W#= ORN 7 #2020 [ ELSE SET SPACES IN UNIT NO FIELD 2WRW BRN ZE 2WT7 ...ZD SEGENTRY K90PERTYPNO [MANYDA MEND POINT 2WWD ... BRN XK91 2WXP ... LDX 0 AWORK2(2) 2W^2 ... BZE 0 XK91 [J UNLESS MONOLITH ENTRY 2X2? ... LDX 0 6 2X3J ... LDN 6 0 [MARKER 2X4T ... SBN 0 6 2X66 ... BNZ 0 XK91 [J UNLESS DA 2X7C ... LDN 0 100 2X8N ... BXL 5 0,XK91 [J IF UNIT NO <100 2X9^ ... DVS 4 0 2X?= ...[X4HAS REM,X5 RESULT 2X#H ... SRL 56 12 2X*S ... LDX 5 4 2XC5 ... DVS 4 TEN(1) 2XDB ... SLL 5 6 [X4 HAS UNITS,X5 TENS 2XFM ... ORX 6 5 2XGY ... ORX 6 4 2XJ9 ... BRN ZE 2XKG ...XK91 2XLR ... SEGENTRY K91PERTYPNO 2XN4 ...[IF X6 ZERO 4 CHARS OTYERWISE UNIT NO 2XP* ... DVS 4 TEN(1) [CONVERTS UNIT NO. TO CHARACTERS 2XR6 BZE 5 ZB 2Y=Q SLL 5 6 2YQB BRN ZC 2^=2 ZB SLL 4 6 2^PL LDN 5 #20 [INSERTS SPACE IF SINGLE CHARACTER 329= ZC ADX 5 4 32NW ADS 5 7 338G ZE STO 7 ACOMMUNE9(2) 33?R ... LDX 0 AWORK2(2) 33#W ...N BZE 0 XK93 [[J UNLESS K2 ENTRRY=MONOLITH 33*^ ... STO 7 ACOMMUNE8(2) 33C4 ... STOZ ACOMMUNE9(2) [SET FOR SHORT ANSWER 33CC ... SEGENTRY K92PERTYPNO 33CQ ... BRN XK93 33D7 ... BZE 6 XK93 [J IF SHORT 33F= ... LDX 7 ACES 33G* ... SRL 67 6 33HD ... ORS 6 ACOMMUNE8(2) 33JH ... STO 7 ACOMMUNE9(2) 33KL ...XK93 33LP ... SEGENTRY K93PERTYPNO 33N6 UP 347Q ZER LDN 7 #7070 [PLACE XX 34MB ZERA SLL 7 12 3572 BRN ZD 35LL MENDAREA 10 366= #END ^^^^ ...32630444000800000000