{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: NEWDIR867)}}
====== NEWDIR867 ======
(George Source)
**Macros used:** [[george:macro:ALTLEND|ALTLEND]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:CHEKPRIV|CHEKPRIV]], [[george:macro:CLOSE|CLOSE]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:CREATEB|CREATEB]], [[george:macro:ERRORX|ERRORX]], [[george:macro:FJOCA|FJOCA]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:GETDIR|GETDIR]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNT2B|HUNT2B]], [[george:macro:HUNTW|HUNTW]], [[george:macro:INSERT|INSERT]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JFREZFCB|JFREZFCB]], [[george:macro:KEEPREP|KEEPREP]], [[george:macro:LONGSET|LONGSET]], [[george:macro:LONGSTOP|LONGSTOP]], [[george:macro:MBS|MBS]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:NEWUSER|NEWUSER]], [[george:macro:OPEN|OPEN]], [[george:macro:OPENREL|OPENREL]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:OWNERCHE|OWNERCHE]], [[george:macro:PUTREP|PUTREP]], [[george:macro:READDICT|READDICT]], [[george:macro:READLEX|READLEX]], [[george:macro:REPALLER|REPALLER]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SETREP2|SETREP2]], [[george:macro:SINM551|SINM551]], [[george:macro:SINMAC1|SINMAC1]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]], [[george:macro:VFREEW|VFREEW]]
22FL [
22^= [THIS VERSION INCLUDES:
23DW [1. OPENSYS
23YG [2. BREAKIN ON OPEN
24D6 [3. LESS DUMPER FREEZING
24QH ...[4. TWIN SYSTEMS
24W2 ... SEG NEWDIR,2,EDWARD MOON ,FILESTORE,G3UGSI
24^F ...[
254Y ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LIMITED 1982
258C ...[ THIS EXCLUDES CODE UNDER #SKI G3UGSI
25?W ...[
25CB SEGENTRY K1NEWDIR,Z1NEWDIR
25X2 SEGENTRY K2NEWDIR,Z2NEWDIR
26BL SEGENTRY K3NEWDIR,Z3NEWDIR
26W= SEGENTRY K4NEWDIR,Z4NEWDIR
27*W SEGENTRY K5NEWDIR,Z5NEWDIR
27TG [
282N ... FSHENTRY K7NEWDIR,Q7NEWDIR,,Q7NEWDIR
287W ...[
288L ...#OPT G3UGSI=0
289B ...#SKI G3UGSI
28=6 ...(
28=W ...# MACRO TO PREVENT M551 AND SECURITY INTERFACE CLASH
28?L ... SINM551
28#B ...)
28*6 # THIS ROUTINE HAS ENTRIES FOR THE MAKEDIR COMMAND AND THE TEMPDIR MACRO
28SQ # FOR MAKEDIR IT SETS UP AND APPENDS A SUITABLE DICTIONARY ENTRY AND
29#B # IF NECESSARY MAKES UP A PSEUDO USERNAME.
29S2 # FOR TEMPDTR THE TEMPORARY DIRECTORY IS SET UP WITH A PSEUDO USERNA
2=?L XERNOTO +ERNOTOWNER
2=R= XERNAME +ERNAME
2?=W XERMAKAL +ERMAKAL
2?QG XERMAKPR +ERMAKPR
2#=6 XERMAKPS +ERMAKPS
2#PQ XERMAK +ERMAK
2*9B SLAN 4HC1
2*P2 NOSA #41
2B8L NEWUSER 8HNEWUSER
2BN= [
2C7W Z1NEWDIR
2CMG # ENTRY FROM NEWDIR MACRO
2D76 LDN 4 4
2DLQ BRN NOTPSEUDO
2F6B [
2FL2 Z2NEWDIR
2G5L # ENTRY WITH ONE PARAMETER FROM MAKEDIR,PSEUDO
2GK= LDN 4 1
2H4W BRN PSEUD
2HJG [
2J46 Z3NEWDIR
2JHQ # ENTRY WITH TWO PARAMETERS FROM MAKEDIR,NOT PSEUDO
2K3B LDN 4 2
2KH2 NOTPSEUDO
2L2L ... LDN 5 FLOG-1
2LG= BRN NPSEU
2L^W [
2MFG Z4NEWDIR
2M^6 # ENTRY WITH THREE PARAMETERS FROM MAKEDIR,PSEUDO
2NDQ LDN 4 3
2NYB BRN PSNAM
2PD2 [
2PXL Z5NEWDIR
2QC= # ENTRY FROM TEMPDIRA MACRO
2QWW LDN 4 0
2RBG SETNCORE 10,1,FILE,FABSNB
2RW6 LDN 0 10
2S*Q STO 0 A1(1) [RECORD HEADER
2STB FJOCA 1,2 [GET USERNAME & JOBNAME
2T*2 ADN 1 JUSER [MOVE THEM INTO ABSNB
2TSL MHUNTW 2,FILE,FABSNB [JUST SET UP SO W IS OK
2W#= ADN 2 A1+1
2WRW MOVE 1 3
2X?G SBN 1 JUSER-JNAME
2XR6 ADN 2 3
2Y=Q MOVE 1 3
2YQB LDN 0 1 [SET UP REEL AND GENERATION NUMBERS
2^=2 STO 0 3(2)
2^PL STO 0 4(2)
329= SMO FX1 [SET UP LANG WORD
32NW LDX 0 SLAN
338G STO 0 5(2)
33N6 PSEUD CALL 5 NXUZA [GET A MADE UP USERNAME IN A CREATE B
347Q PSNAM LDN 5 FPSEU [LENGTH OF PSEUDO DICTIONARY ENTRY
34MB NPSEU
3572 SETNCORE 3,3,FILE,ADICT
35LL BZE 4 SETFL [NO DICT ENTRY FOR TEMPDIRA
366= SETUPCOR 5,3,FILE,FWB [INSERT BLOCK FOR DICTIONARY ENTRY
36KW STO 5 A1(3) [RECORD HEADER
375G STOZ A1+1(3)
37K6 LDN 1 A1+1(3)
384Q LDN 2 A1+2(3)
38JB SMO A1(3)
3942 MOVE 1 510 [ZEROISE BLOCK
39HL LDN 0 1
3=3= STO 0 CNEWZ(3) [SET UP NEW FORMAT WORD
3=GW ADN 3 CUSER
3?2G MHUNTW 2,FILE,CREATE
3?G6 ADN 2 CEUSE1 [LOCATE USERNAME IN THE CREATE BLOCK
3?^Q MOVE 2 3 [MOVE IT INTO CUSER
3#FB HUNT 2,FILE,FABSNB
3#^2 SMO A1(2)
3*DL ADN 2 A1-6 [LOCATE LOCALNAME IN THE FABSNB AND
3*Y= ADN 3 CLOCN-CUSER [MOVE IT INTO CLOCN
3BCW MOVE 2 3
3BXG LDX 0 GSIGN [NEGATIVE
3CC6 ORS 0 CPSEU-CLOCN(3) [MARKER FOR PSEUDO DIRECTORY
3CWQ LDEX 0 4
3DBB ANDN 0 1
3DW2 BNZ 0 SETFL [J IF PSEUDO
3F*L STOZ CPSEU-CLOCN(3) [ZEROISE PSEUDO MARKER
3FT= LDX 0 ACES
3G#W ADN 3 CPASS-CLOCN
3GSG STO 0 0(3) [PUT SPACES IN
3H#6 STO 0 1(3) [THE PASSWORD
3HRQ STO 0 2(3)
3J?B SETFL
3JR2 SETNCORE 6,3,FILE,FLOCNB
3K=L MHUNT 2,FILE,FABSNB
3KQ= ADN 3 A1
3L9W SMO A1(2)
3LPG ADN 2 A1-6 [LOCATE LAST NAME IN THE FABSNB AND
3M96 MOVE 2 6 [MOVE IT INTO THE FLOCNB
3MNQ MHUNT 2,FILE,FABSNB [RECOVER POINTER
3N8B LDN 0 6
3NN2 SBS 0 A1(2) [REDUCE LENGTH FOR OPENING THE DIRECT
3P7L WTLOOP
3PM= OPEN TBR,GENERAL,QUERY,LEAVE [OPEN NEW DIRECTORY'S DIRECTO
3Q6W TESTRPN2 OK,NAME [ERROR IN HIGHER DIRECTORY
3Q?# ... BZE 4 NOCHEKA [TEMPDIRA MACRO
3QCQ ...#UNS FTS1
3QJ8 ...(
3QNL ... TOPFCB 2
3QT4 ... JFREZFCB 2,RFROZEN
3Q^G ...)
3R66 LDX 0 4
3RKQ SBN 0 4
3S5B BZE 0 NOCHEK [DONT CHECK OWNERSHIP IF NEWDIR MACRO
3SK2 OWNERCHE
3SN6 ...#UNS FTS1
3SR= ...(
3SWB ... TESTREP2 NOINFACC,RFROZEN,NOALLACC,RFROZEN
3S^G ...)
3T4L TESTREP2 OK,NOCHEK
3TJ= CLOSE [DIR
3W3W LDX 3 XERNOTO(1)
3WHG BRN NOTBRK [CLEAR UP BLOCKS & REPORT ERROR
3X36 NOCHEKA
3XGQ GETDIR 3 [WE WANT TO WAIT FOR ERASING IF TEMPD
3Y2B BRN NOCHEKX
3YG2 NOCHEK
3Y^L GETDIR 1 [TEST TO SEE IF NAME ALREADY USED
3^F= NOCHEKX
3^YW MHUNTW 3,FILE,ENT
42DG TESTRPN2 NOFILE,USED1
42Y6 JBC NTMPD,3,BETEMP [J UNLESS SUPERIOR IS TEMPORARY
43CQ MHUNTW 1,FILE,CREATE
43XB BS 1,CETEMP [IF SO MAKE THIS ONE TEMPORARY TOO
44C2 MFREEW FILE,FWB
44WL ORX 4 GSIGN
45B= NTMPD
45TW LDN 2 EUSE1(3)
46*G MHUNTW 3,FILE,ADICT
46T6 ADN 3 A1
47#Q MOVE 2 3 [MOVE IN SUPUSER NAME
47SB BZE 4 TEMPS [J IF TEMPDIRA MACRO
48#2 BNG 4 TEMPS [J. IF TEMPDIR
48RL MHUNTW 3,FILE,FWB
49?= ADN 3 CSUPUSER
49QW MOVE 2 3 [MOVE IN CSUPUSER
4==G SBN 2 EUSE1
4=Q6 FREECORE 2
4?9Q OPENSYS TBREAK,DICTIONARY,GENERAL
4?PB LDX 0 4
4#92 SBN 0 2
4#NL BNZ 0 PSDUS [J IF PSEUDO OR MACRO
4*8= READDICT [GET THE DICT ENTRY OF THE SUPERIOR U
4*MW MHUNTW 3,FILE,ADICTENT
4B7G LDX 0 CPSEU(3)
4BM6 BNG 0 PSDIR [J IF SUPUSER IS PSEUDO FOR NONPSEUDO
4C6Q ... CHEKPRIV 0,NEWUSER,NOPRIV [J TO NOPRIV UNLESS USER HAS PRIVILEG
4CLB MHUNTW 2,FILE,ADICTENT
4D62 LDX 3 2
4DKL ADN 2 CUSER
4F5= ADN 3 A1
4FJW MOVE 2 3 [MOVE UP USER NAME
4G4G SBN 3 A1
4GJ6 ALTLEND 3,3
4H3Q MHUNTW 2,FILE,ADICTENT
4HHB NAME 2,FILE,ADICT
4J32 BRN PSDUS
4JGL TEMPS
4K2= SBN 2 EUSE1
4KFW FREECORE 2
4K^G PSDUS
4LF6 CALL 5 SETADICT [GET ADICT WITH NEW USERNAME
4LYQ OPENSYS ZBREAK,LEXICON,WRITE
4MDB [
4MY2 [ CODE TO PREVENT MAKING NON-TEMP DIR DURING DUMP WHEN ONE OF SAME
4NCL [NAME WAS ERASED
4NX= [
4PBW JBC NOTDUMPING,,BFERUS [J IF NOT DUMPING
4PWG BNG 4 NOTDUMPING [OR IF TEMPORARY
4QB6 BZE 4 NOTDUMPING [OR TEMPDIRA
4QTQ LDN 2 BMISC
4R*B HUNT2B 2,FI,FERUS [FIND PROHIBITED NAME BLOCK IN MISC C
4RT2 HUNTW 1,FILE,ADICT
4S#L LDX 0 FERUSNUM(2) [NO. OF NAMES IN LIST
4SS= BZE 0 NOTDUMPING
4T?W LDX 5 A1(1) [LOAD NAME
4TRG LDX 6 A1+1(1) [ BEING
4W?6 LDX 7 A1+2(1) [ CREATED
4WQQ NEXTUSER
4X=B TXU 5 FERUSER(2) [JUMP
4XQ2 TXU 6 FERUSER+1(2) [ IF NAME
4Y9L BXE 7 FERUSER+2(2),RASE [ PROHIBITED
4YP= ADN 2 FERUSLEN [GET PTR TO NEXT NAME
4^8W BCT 0 NEXTUSER [& TEST UNTIL NONE LEFT
4^NG BRN NOTDUMPING [NAME OK SO PROCEED
5286 RASE [NAME IS PROHIBITED
52MQ FREECORE 1 [ADICT
537B LDN 0 1
53M2 SBX 0 4
546L BZE 0 USEDX [GET ANEW NAME IF IT WAS A MADE-UP NA
54L= LONGSET ADUMPWT,(GEOERR) [PREPARE TO WAIT FOR END OF DUMP
555W LDN 7 3
55KG NEXTCLOSE
5656 CLOSETOP [LEXICON,DICTIONARY & DIR
56JQ BCT 7 NEXTCLOSE
574B LONGSTOP TBR,,INCFREZ [OUTPUT WAITING MESSAGE & WAIT
575Y ...WAITLAB
57J2 BRN WTLOOP [TRY AGAIN
583L [
58H= NOTDUMPING
592W READLEX [THE 1ST ADICT CONTAINS THE NEW USERN
59GG TESTRPN2 NOUSER,USED
5=26 READLEX [THE 1ST ADICT BLOCK IS NOW SUPUSER'S
5=FQ MHUNTW 2,FILE,ASELFLEX
5=^B LDX 0 4
5?F2 SBN 0 2
5?YL BZE 0 REAL [J IF NON PSEUDO
5#D= SBN 0 2
5#XW BZE 0 REAL [J IF NEWDIR MACRO
5*CG LDCT 1 #600
5*X6 BNG 4 PSONLY [J IF TD MACS
5BBQ BZE 4 PSONLY [J IF TEMPDIRA
5BWB LDCT 1 #400
5CB2 PSONLY
5CTL ORS 1 GSUPUSER(2) [SET PSEUDO &/OR LEMP BITS
5D*= REAL
5DSW NAME 2,FILE,ASUPLEX
5F#G MHUNTW 1,FILE,CREATE
5FS6 ADN 2 GLUSER
5G?Q ADN 1 CEUSE1 [MOVE IN NEW USERNAME
5GRB MOVE 1 3
5H?2 NEWUSER [INSERT NEW LEXICON ENTRY
5HQL CLOSETOP [LEXICON
5J== BZE 4 TDMAC [J IF TEMPDIRA
5JPW BNG 4 TDMAC [J IF TEMP BECAUSE SUPERIOR IS
5JQR ...[ THIS SECTION IS ONLY COMPILED IF THE G3 USER GROUP
5JRN ...[ SECURITY INTERFACE ENHANCEMENT IS SWITCHED ON
5JSK ...#SKI G3UGSI [G3UG SECURITY INTERFACE
5JTG ...(
5JWC ... MHUNTW 3,FILE,FWB
5JX# ... LDX 5 CPSEU(3)
5JY9 ... BNG 5 REAL2
5J^6 ... NAME 3,FILE,ADICTENT
5K23 ... SINMAC1 CPASS(3),5,2
5K2Y ... MHUNTW 3,FILE,ADICTENT
5K3T ... NAME 3,FILE,FWB
5K4Q ... LDN 1 5
5K5M ... LDN 2 CPASS(3)
5K6J ... MOVE 1 3
5K7F ...REAL2
5K8B ...)
5K9G CALL 5 SETADICT
5KP6 READDICT [GET DICTIONARY POSITIONED TO INSERT
5L8Q INSERT
5LNB CLOSETOP [CLOSE THE DICTIONARY
5M82 MFREEW FILE,FWB
5MML TDMAC
5N7= LDX 0 4
5NLW SBN 0 2
5P6G BZE 0 TRAP [SET TRAP FOR REAL USER
5PL6 SBN 0 2
5Q5Q BNZ 0 NOTRAP [J IF PSEUDO
5QKB TRAP
5R52 SETNCORE 5,2,FILE,FTRAP [FOR TRAPADD BY MAKEFILE
5RJL MHUNTW 1,FILE,CREATE
5S4= LDN 0 5
5SHW STO 0 ETRAPRH(2)
5T3G LDN 0 2 [READ TRAP
5TH6 STO 0 ETRAPMODES(2)
5TN# ...#UNS ILOGACC
5TTG ... BS 2,EDEFTRAP [INDICATE THIS IS DEFAULT TRAP
5W2Q ADN 1 CEUSE1
5WGB ADN 2 ETRUSER1
5X22 MOVE 1 3
5XFL NOTRAP
5X^= MHUNTW 1,FILE,CREATE
5Y4B ...#UNS FNSAD
5Y7G ... MBS 1,CEONLINE,CECOOR,CEINDEXF,CECARE
5Y=L ...#UNS FNSAD
5Y*Q ...#SKI
5YDW MBS 1,CEONLINE,CECOOR,CEALLINCS,CEINDEXF,CECARE
5YYG BNZ 4 NOTEMPBIT
5^D6 BS 1,CETEMP
5^XQ NOTEMPBIT
62CB LDEX 7 4
62X2 SBN 7 1
63BL BZE 7 PSEUDOBIT [J IF PSEUDO
63W= SBN 7 2
64*W BNZ 7 NOPSEUDOBIT [J UNLESS PSEUDO
64TG PSEUDOBIT
65*6 BS 1,CEPSEUDO [PSEUDO-DIRECTORY
65SQ NOPSEUDOBIT
66#B LDN 0 INDEXDIR
66S2 STO 0 CEINDEX(1)
66TP ...#UNS FNSAD
66XD ...(
66^7 ... BZE 4 NOSET [NO 'DIRBELOW' BIT IF TEMPDIR
672W ... TOPFCB 3
674K ... JBS NOSET,3,BFDIRBELOW
676# ... MBS 3,BFDIRBELOW,BFDIRUPDATE
6783 ...NOSET
679Q ...)
67CJ ... OPENREL TBR,GENERAL,CREATE,QUERY
67KB ... TESTREP ALREADY,NOTBRK
67R= MFREEW FILE,FLOCNB
68=W MFREE FILE,FABSNB
68?^ ...RETFROMA
68QG BNZ 4 MADE [J UNLESS TEMPDIRA
69=6 FJOCA 1,2 [GET X1->JOBBLOCK
69PQ BS 1,JBTEMP [MARK 'TEMPDIR EXISTS'
6=9B CLOSE [TEMP DIR
6=BJ ...NCLOSINB
6=P2 SETREP2 OK
6?8L UPPLUS 2
6?N= MADE
6#7W CLOSE
6#*4 ...NCLOSINB2
6#MG SETREP2 OK
6*76 UPPLUS 1
6*LQ NAME
6B6B BZE 4 (GEOERR) [J IF TEMPDIRA
6BL2 LDX 3 XERNAME(1)
6C5L NOTBRK
6CK= LDN 7 0 [REMEMBER NOT BREAKIN CASE
6D4W BRN REPALREADY
6DJG USED1
6F46 LDN 7 0
6FHQ JBC NOWAIT,3,BEERASE [J UNLESS 'TO BE ERASED'
6G3B LDX 7 ELOC1(3)
6GH2 LONGSET #12,(GEOERR),7 [PREPARE TO WAIT FOR ERASURE TO FINIS
6H2L NOWAIT
6HG= FREECORE 3
6H^W CLOSETOP [SUPERIOR DIR
6JFG BNZ 7 WAIT [J IF LONGWAIT REQD
6J^6 LDX 3 XERMAKAL(1)
6KDQ REPALREADY
6KYB KEEPREP 5,ALREADY
6LD2 WTBRK [FREE BLOCKS BEFORE UP IF BROKEN IN
6LXL MFREEW FILE,ADICT
6MC= NOPRIVY
6MWW MFREEW FILE,CREATE
6NBG MFREE FILE,FABSNB
6NW6 MFREEW FILE,FLOCNB
6NXN ...RETFORERR
6P*Q BNZ 7 TBR [J IF BREAKIN
6PTB BZE 4 SETREP [SET REPLY IF TEMPDIRA
6Q*2 VFREEW FILE,FWB
6QSL LDEX 4 4
6R#= SBN 4 4
6RRW BNZ 4 XERR [REPORT ERROR IF COMMAND
6S?G SETREP
6SR6 PUTREP 5
6T=Q UPPLUS 1
6TQB WAIT
6W=2 LONGSTOP WTBRK
6WPL BRN WTLOOP [TRY AGAIN
6X9= XERR
6XNW ERRORX 3
6Y8G UPPLUS 1
6YN6 NOPRIV
6^7Q LDX 3 XERMAKPR(1)
6^#Y ...#UNS FTS1
6^G6 ... CLOSETOP [ DICT.
6^MB CLOSE [CLOSE SUPERIOR DIR ONLY ONLY
7272 NOPRIVZ
72LL LDN 7 0
736= BRN NOPRIVY [CLEAR UP BLOCKS & REPORT ERROR
73KW PSDIR
745G LDX 3 XERMAKPS(1)
74K6 CLOSETOP
754Q CLOSETOP
75JB MFREEW FILE,ADICTENT
7642 BRN NOPRIVZ
76HL USED
773= MFREEW FILE,ASELFLEX
77GW USEDX
782G CLOSETOP
78G6 BZE 4 NONEG [J IF TEMPDIRA
78^Q BNG 4 NONEG [J IF TO BE TEMP. SINCE SUPERIOR IS
79FB CLOSE [DICT
79^2 MFREEW FILE,FWB
7=DL NONEG
7=Y= CLOSE [SUP CIR
7?CW LDEX 0 4
7?XG SBN 0 2
7#C6 BNG 0 PSTH [J IF TEMPDIR OR MAKEDIR WITH ONE PAR
7#WQ SBN 0 2
7*BB BZE 0 NOTBRK
7*W2 MFREE CPB,CUNI [FREE FIRST PARAMETER BLOCK
7B*L MHUNT 2,FILE,FNAME
7BT= NAMETOP 2,CPB,CUNI
7C#W LDX 3 XERMAK(1)
7CSG BRN NOTBRK
7D#6 PSTH
7DRQ MFREEW FILE,CREATE
7F?B MFREEW FILE,FLOCNB
7FR2 MFREEW FILE,ADICT
7G=L HUNT 1,FILE,FABSNB
7GQ= LDN 0 6
7H9W ADS 0 A1(1) [RESTORE LENGTH BEFORE GOING BACK
7HPG BRN PSEUD [MAKE UP ANOTHER PSEUDO USERNAME
7J96 NXUZA [THIS ROUTINE PUTS THE NEXT USERNAME
7JNQ SBX 5 FX1 [UP BY THE SYSTEM INTO A FILE/CREATE
7K8B CREATEB
7KN2 LDCT 1 #600 [IT UPDATES THIS NAME IN FIXED CORE
7L7L ADN 1 2 [SET UP MODIFIER
7LM= VAGAN LDCH 0 AUSE(1) [PICK UP A CHARACTER
7M6W SBN 0 1 [REDUCE IT BY 1
7MLG SMO FX1
7N66 TXL 0 NOSA [TEST NOT LESS THAN 'A'
7NKQ BCS VUPD [JUMP IF CHAR0LESS THAN 'A'
7P5B DCH 0 AUSE(1) [OTHERWISE REPLACE UPDATED CHARACTER
7PK2 MHUNTW 2,FILE,CREATE
7Q4L ADN 2 CEUSE1 [INTO THE FILE/CREATE BLOCK
7QJ= LDN 1 AUSE
7R3W MOVE 1 3
7RHG ADX 5 FX1
7S36 EXIT 5 0
7SGQ SETADICT
7T2B SBX 5 FX1
7TG2 SETNCORE 3,2,FILE,ADICT
7T^L MHUNTW 1,FILE,CREATE
7WF= ADN 1 CEUSE1
7WYW ADN 2 A1
7XDG MOVE 1 3
7XY6 ADX 5 FX1
7YCQ EXIT 5 0
7YXB VUPD LDN 0 #72 [REPLACE CHARACTER WITH A 'Z'
7^C2 DCH 0 AUSE(1) [AND UPDATE THE CHARACTER MODIFIER
7^WL LDX 0 1 [TEST WHETHER NECESSARY TO
82B= SRL 0 2 [CHANGE WORD MODIFIER
82TW BZE 0 VDOWN [JUMP IF NECESSARY
83*G LDCT 0 #200 [OTHERWISE DECREMENT CHARACTER
83T6 SBX 1 0 [MODIFIER AND LOOK AT NEXT MOST
84#Q BRN VAGAN [SIGNIFICANT CHARACTER
84SB VDOWN SBN 1 1 [DECREMENT WORD MODIFIER AND SET
85#2 LDCT 0 #600 [CHARACTER MODIFIER TO 3THEN LOOK
85RL ADX 1 0 [AT NEXT MOST SIGNIFICANT CHARACTER
86?= BRN VAGAN
86QW ZBREAK
87=G CLOSETOP [DICTIONARY
87Q6 TBREAK
889Q CLOSETOP [DIRECTORY
88PB TBR
8992 UP
89?9 ...#UNS FTS1
89*D ...(
89CM ...RFROZEN
89FW ... REPALLER
89J5 ... UPPLUS 1
89L# ...)
89NL [
8=8= MENDAREA 20,K99NEWDIR
8=MW #END
^^^^ ...04256470000200000000