$CONTROL MAP,CODE,USLINIT                                               00010000
<< ASOCTABL - MODULE AS >>                                              00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$TITLE "ASSOCIATE FILE BUILDER"                                         00028000
$CONTROL MAP,CODE,PRIVILEGED                                            00030000
$CONTROL SEGMENT=MAIN                                                   00032000
BEGIN                                                                   00034000
COMMENT                                                                 00036000
                                                                        00038000
   THE FORMAT OF THE ASSOCIATE FILE IS AS FOLLOWS:                      00040000
   IT IS A FIXED-LENGTH BINARY FILE CONSISTING OF NINE WORD RECORDS.    00042000
   RECORD NUMBER 0 CONTAINS THE NEXT AVAILABLE RECORD # IN THE 1ST WORD 00044000
   WITH THE REST OF THE RECORD UNUSED.                                  00046000
                                                                        00048000
   RECORD NUMBERS 1 THRU 255 CONTAIN THE FIRST USER WHO MAY ASSOCIATE   00050000
   DEVICES 1 THRU 255.  IF NO USER MAY ASSOCIATE A DEVICE THE FIRST     00052000
   WORD OF THE RECORD IS ZERO, OTHERWISE, THE RECORD IS FORMATTED AS    00054000
   FOLLOWS:                                                             00056000
      THE FIRST FOUR WORDS CONTAIN THE USERNAME IN ASCII OR "@       "  00058000
      IF IT IS WILDCARDED.                                              00060000
      THE NEXT FOUR WORDS CONTAIN THE ACCOUNT NAME IN ASCII OR          00062000
      "@       " IF WILDCARDED.                                         00064000
      THE NEXT FOUR WORDS CONTAIN THE CLASS NAME IN ASCII.              00066000
      THE LAST WORD CONTAINS THE RECORD # OF THE NEXT RECORD FOR THIS   00068000
      DEVICE OR ZERO IF NO MORE RECORDS.                                00070000
;                                                                       00072000
$PAGE "DATA STORAGE"                                                    00074000
                                                               <<01041>>00076000
ENTRY LIST;  <<ENTRY POINT TO LIST ASOCIATE.PUB.SYS>>          <<01041>>00078000
                                                               <<01041>>00080000
EQUATE ENT'LEN=13; <<LENGTH OF ENTRIES IN ASOCIATE.PUB.SYS>>            00082000
                                                               <<02327>>00084000
                                                               <<02327>>00086000
define                                                         <<02327>>00088000
PTITLE = ("ASOCTABL          (C) HEWLETT PACKARD CO., 1979")#; <<04633>>00090000
EQUATE VUUFF'COL = 9; << Index into PTITLE >>                  <<04633>>00092000
DEFINE TURNOFFTRAPS =                                          <<04634>>00094000
       BEGIN                                                   <<04634>>00096000
       PUSH(STATUS);                                           <<04634>>00098000
       TOS.(2:1):=0;                                           <<04634>>00100000
       SET(STATUS);                                            <<04634>>00102000
       END #;                                                  <<04634>>00104000
                                                               <<02327>>00106000
INTEGER NUMCHAR;                                               <<02327>>00108000
$INCLUDE INCLVUF                                               <<04633>>00110000
INTEGER ARRAY DUPFILENAME(0:13);                                        00112000
INTEGER S0=S-0;                                                         00114000
EQUATE CARRIAGE'RETURN=13;                                              00116000
DEFINE SPECIALBIT=(10:1)#, DELIMITER=(11:5)#;                           00118000
DOUBLE DL:=[8/"=",8/".",8/",",8/CARRIAGE'RETURN]D;                      00120000
BYTE ARRAY DL'(*)=DL;                                                   00122000
DOUBLE ARRAY PARMS(0:35);                                               00124000
BYTE POINTER CURRENT'PARM; <<POINTER TO CURRENT PARAMETER>>             00126000
INTEGER CURRENT'LENGTH; <<LENGTH OF CURRENT PARAMETER>>                 00128000
INTEGER CURRENT'DELIMITER; <<DELIMITER OF CURRENT PARAMETER>>           00130000
LOGICAL SPECIAL'CHAR; <<TRUE IF CURRENT PARAMETER HAD SPECIAL CHARS>>   00132000
INTEGER I,LENGTH,PARMNO; <<CURRENT PARAMETER NUMBER>>                   00134000
INTEGER NUMPARMS,INPUTFILE:=0,OUTPUTFILE:=0;                            00136000
EQUATE EQUALS=0, PERIOD=1, COMMA=2, CR=3; <<DELIMITER #'S>>             00138000
INTEGER ARRAY L'INPUT(0:39); <<INPUT BUFFER>>                           00140000
BYTE ARRAY INPUT(*)=L'INPUT;                                            00142000
INTEGER ARRAY ASSOC'ENTRY(0:ENT'LEN-1)=DB; <<ASSOCIATE ENTRY>>          00144000
BYTE ARRAY ASSOC'USERNAME(*)=ASSOC'ENTRY(0);                            00146000
BYTE ARRAY ASSOC'ACCTNAME(*)=ASSOC'ENTRY(4);                            00148000
BYTE ARRAY ASSOC'CLASS(*)=ASSOC'ENTRY(8);                               00150000
INTEGER ASSOC'NEXTP=ASSOC'ENTRY+12;                                     00152000
BYTE ARRAY INFILENAME(0:6),OUTFILENAME(0:15);                           00154000
EQUATE ASSMSGSET=21; <<GENMSG MESSAGE SET FOR SASSTBL>>                 00156000
EQUATE DUPLICATEFILE=100; <<ERROR # FOR DUPLICATE FILE>>                00158000
LOGICAL STDIN; <<TRUE IF INPUT FILE IS $STDIN>>                         00160000
LOGICAL ERROR:=FALSE; <<TRUE IS ANY SYNTAX ERRORS IN INPUT>>            00162000
INTEGER ARRAY CLASSINFO(0:130); <<BUFFER FOR GETCLASS>>                 00164000
BYTE ARRAY LDEV(*)=CLASSINFO(3); <<BUFFER FOR DEVICES IN DEVICECLASS>>  00166000
INTEGER ARRAY CLASSNAME(0:3); <<CLASSNAME BUFFER>>                      00168000
BYTE ARRAY CLASSNAME'(*)=CLASSNAME;                                     00170000
INTEGER ARRAY PROMPT(0:1);                                              00172000
byte array output'buf(0:79);                                   <<02327>>00174000
logical array output'buf'(*) = output'buf;                     <<02327>>00176000
                                                                        00178000
LOGICAL PROCEDURE GETCLASS(A,B,C,D,E);                                  00180000
VALUE B,C,D;                                                            00182000
INTEGER ARRAY A,E;                                                      00184000
LOGICAL B;                                                              00186000
INTEGER C,D;                                                            00188000
OPTION EXTERNAL,VARIABLE;                                               00190000
                                                                        00192000
INTEGER PROCEDURE GENMSG(A,B,C,D,E,F,G,H,I,J,K,L,M);                    00194000
VALUE A,B,C,D,E,F,G,H,I,J,K,L,M;                                        00196000
INTEGER A,B,I,L;                                                        00198000
LOGICAL C,D,E,F,G,H,J,K,M;                                              00200000
OPTION PRIVILEGED,VARIABLE,EXTERNAL;                                    00202000
                                                                        00204000
INTRINSIC FGETINFO,PRINTFILEINFO,FRELATE,PRINT,FOPEN,FCLOSE,MYCOMMAND;  00206000
INTRINSIC FWRITEDIR,FREADDIR,FCHECK,FERRMSG,BINARY,FREAD,TERMINATE;     00208000
INTRINSIC FUPDATE;                                             <<01041>>00210000
$PAGE "FILEERR -- REPORT FILE ERRORS & TERMINATE"                       00212000
PROCEDURE FILEERR(FILENUMBER);                                          00214000
VALUE FILENUMBER;                                                       00216000
INTEGER FILENUMBER;                                                     00218000
BEGIN                                                                   00220000
   INTEGER FILELENGTH:=0,ERRNUM,MSGLGTH;                                00222000
   ARRAY MSGBUF(0:49);                                                  00224000
   BYTE ARRAY MSGBUF'(*)=MSGBUF;                                        00226000
                                                                        00228000
   FCHECK(FILENUMBER,ERRNUM); <<GET ERROR #>>                           00230000
   IF FILENUMBER<> 0 THEN                                               00232000
   BEGIN                                                                00234000
      FGETINFO(FILENUMBER,MSGBUF');<<GET FILE NAME>>                    00236000
      SCAN MSGBUF' UNTIL "  ",1;<<CALCULATE FILE NAME LENGTH>>          00238000
      FILELENGTH:=TOS-@MSGBUF'+1;                                       00240000
      MSGBUF'(FILELENGTH-1):="-";                                       00242000
      PRINTFILEINFO(FILENUMBER);<<PRINT TOMBSTONE>>                     00244000
   END;                                                                 00246000
   FERRMSG(ERRNUM,MSGBUF((FILELENGTH+1)&ASR(1)),MSGLGTH);               00248000
   PRINT(MSGBUF,-MSGLGTH-FILELENGTH,0);                                 00250000
   IF OUTPUTFILE<>0 THEN FCLOSE(OUTPUTFILE,4,0); <<DELETE OUTPUT FILE>> 00252000
   IF INPUTFILE<>0 THEN FCLOSE(INPUTFILE,0,0);                          00254000
   TERMINATE;                                                           00256000
END;                                                                    00258000
$PAGE "LISTASS -- LIST ASOCIATE.PUB.SYS"                       <<01041>>00260000
PROCEDURE LISTASS;                                             <<01041>>00262000
BEGIN                                                          <<01041>>00264000
   INTEGER NO'OF'CLASSES:=0, NO'OF'USERS:=1, I;                <<01041>>00266000
   BYTE POINTER BPS0=S-0;                                      <<01041>>00268000
   LOGICAL EOL,EOF,FOUND;                                      <<01041>>00270000
   DOUBLE RECNO;                                               <<01041>>00272000
   EQUATE MAX'NO'OF'CLASSES=50, CLASSES'USERS=4, CLASSES'NAME=0,        00274000
          CLASSES'LENGTH=5, CLASSES'NAME'L=4;                  <<01041>>00276000
   ARRAY CLASSES(0:MAX'NO'OF'CLASSES*CLASSES'LENGTH-1);        <<01041>>00278000
   BYTE ARRAY CLASSES'(*)=CLASSES;                             <<01041>>00280000
   EQUATE USERS'USERNAME=0, USERS'ACCTNAME=4, USERS'NEXT=8,    <<01041>>00282000
          USERS'LENGTH=9;                                      <<01041>>00284000
   ARRAY USERS(0:USERS'LENGTH-1);                              <<01041>>00286000
   BYTE ARRAY USERS'(*)=USERS, USER'(0:8), ACCT'(0:8);         <<01041>>00288000
                                                               <<01041>>00290000
                                                               <<01041>>00292000
   MOVE INFILENAME:="ASOCIATE.PUB.SYS ";                       <<01041>>00294000
   INPUTFILE:=FOPEN(INFILENAME,%2001,0);                       <<01041>>00296000
   IF <> THEN <<UNABLE TO LIST ASOCIATE.PUB.SYS>>              <<01041>>00298000
   BEGIN                                                       <<01041>>00300000
      GENMSG(ASSMSGSET,20); <<NO ASSOCIATION TABLE>>           <<01041>>00302000
      FCLOSE(INPUTFILE,0,0);                                   <<01041>>00304000
      TERMINATE;                                               <<01041>>00306000
   END;                                                        <<01041>>00308000
                                                               <<01041>>00310000
   FREADDIR(INPUTFILE,ASSOC'ENTRY,ENT'LEN,0D);                 <<01041>>00312000
   IF <> THEN FILEERR(INPUTFILE);                              <<01041>>00314000
   OUTPUTFILE:=FOPEN(,%2000,5,USERS'LENGTH,,,,,,DOUBLE(ASSOC'ENTRY));   00316000
   IF <> THEN FILEERR(OUTPUTFILE);                             <<01041>>00318000
$PAGE                                                          <<01041>>00320000
<< NOW READY TO BUILD DEVICE CLASS NAME TABLE BY DOING A SCAN OF>>      00322000
<< ASOCIATE.PUB.SYS                                             >>      00324000
                                                               <<01041>>00326000
   EOF:=FALSE;                                                 <<01041>>00328000
   RECNO:=0D;                                                  <<01041>>00330000
   DO                                                          <<01041>>00332000
   BEGIN                                                       <<01041>>00334000
      RECNO:=RECNO+1D;                                         <<01041>>00336000
      FREADDIR(INPUTFILE,ASSOC'ENTRY,ENT'LEN,RECNO);           <<01041>>00338000
      IF <> THEN EOF:=TRUE                                     <<01041>>00340000
      ELSE                                                     <<01041>>00342000
      IF ASSOC'ENTRY<>0 THEN <<HAVE A VALID ENTRY>>            <<01041>>00344000
      BEGIN                                                    <<01041>>00346000
         FOUND:=FALSE;                                         <<01041>>00348000
         I:=NO'OF'CLASSES;                                     <<01041>>00350000
         WHILE NOT FOUND AND (I:=I-1)>=0 DO                    <<01041>>00352000
            IF ASSOC'CLASS=CLASSES'(I*CLASSES'LENGTH*2),       <<01041>>00354000
               (CLASSES'NAME'L*2) THEN FOUND:=TRUE;            <<01041>>00356000
         IF NOT FOUND THEN <<ADD CLASS TO CLASS TABLE>>        <<01041>>00358000
         BEGIN                                                 <<01041>>00360000
            MOVE CLASSES'(NO'OF'CLASSES*CLASSES'LENGTH*2):=    <<01041>>00362000
               ASSOC'CLASS,(CLASSES'NAME'L*2);                 <<01041>>00364000
            CLASSES(NO'OF'CLASSES*CLASSES'LENGTH+CLASSES'USERS):=       00366000
               NO'OF'USERS;                                    <<01041>>00368000
            I:=NO'OF'CLASSES-1;                                <<01041>>00370000
            NO'OF'CLASSES:=NO'OF'CLASSES+1;                    <<01041>>00372000
            GO TO ADDUSER;                                     <<01041>>00374000
         END                                                   <<01041>>00376000
         ELSE <<ENTRY IS FOUND FOR CLASS>>                     <<01041>>00378000
         BEGIN <<SCAN TO SEE IF USER EXISTS FOR THIS CLASS>>   <<01041>>00380000
            FREADDIR(OUTPUTFILE,USERS,USERS'LENGTH,            <<01041>>00382000
                     DOUBLE(CLASSES(I*CLASSES'LENGTH+CLASSES'USERS)));  00384000
            EOL:=FOUND:=FALSE;                                 <<01041>>00386000
            DO                                                 <<01041>>00388000
            IF USERS'(USERS'USERNAME*2)=ASSOC'USERNAME,(8) AND <<01041>>00390000
               USERS'(USERS'ACCTNAME*2)=ASSOC'ACCTNAME,(8) THEN<<01041>>00392000
               FOUND:=TRUE                                     <<01041>>00394000
            ELSE                                               <<01041>>00396000
            IF USERS(USERS'NEXT)<>0 THEN                       <<01041>>00398000
               FREADDIR(OUTPUTFILE,USERS,USERS'LENGTH,         <<01041>>00400000
                  DOUBLE(USERS(USERS'NEXT)))                   <<01041>>00402000
            ELSE EOL:=TRUE                                     <<01041>>00404000
            UNTIL EOL OR FOUND;                                <<01041>>00406000
            IF EOL THEN                                        <<01041>>00408000
            BEGIN                                              <<01041>>00410000
               USERS(USERS'NEXT):=NO'OF'USERS;                 <<01041>>00412000
               FUPDATE(OUTPUTFILE,USERS,USERS'LENGTH);         <<01041>>00414000
ADDUSER:                                                       <<01041>>00416000
               MOVE USERS'(USERS'USERNAME*2):=ASSOC'USERNAME,(8);       00418000
               MOVE USERS'(USERS'ACCTNAME*2):=ASSOC'ACCTNAME,(8);       00420000
               USERS(USERS'NEXT):=0;                           <<01041>>00422000
               FWRITEDIR(OUTPUTFILE,USERS,USERS'LENGTH,        <<01041>>00424000
                  DOUBLE(NO'OF'USERS));                        <<01041>>00426000
               NO'OF'USERS:=NO'OF'USERS+1;                     <<01041>>00428000
            END;                                               <<01041>>00430000
         END;                                                  <<01041>>00432000
      END;                                                     <<01041>>00434000
   END                                                         <<01041>>00436000
   UNTIL EOF;                                                  <<01041>>00438000
$PAGE                                                          <<01041>>00440000
                                                               <<01041>>00442000
<< HAVE BUILT TEMP FILE... NOW LIST ON $STDLIST>>              <<01041>>00444000
                                                               <<01041>>00446000
   I:=-1;                                                      <<01041>>00448000
   WHILE (I:=I+1)<NO'OF'CLASSES DO                             <<01041>>00450000
   BEGIN                                                       <<01041>>00452000
      RECNO:=DOUBLE(CLASSES(I*CLASSES'LENGTH+CLASSES'USERS));  <<01041>>00454000
      SCAN CLASSES'(I*CLASSES'LENGTH*2+CLASSES'NAME*2)         <<01041>>00456000
         UNTIL [8/0,8/" "],1;                                  <<01041>>00458000
      BPS0:=0;                                                 <<01041>>00460000
      DO                                                       <<01041>>00462000
      BEGIN                                                    <<01041>>00464000
         FREADDIR(OUTPUTFILE,USERS,USERS'LENGTH,RECNO);        <<01041>>00466000
         IF USERS'(USERS'USERNAME*2)<>"@" THEN                 <<01041>>00468000
         BEGIN                                                 <<01041>>00470000
            MOVE USER':=USERS'(USERS'USERNAME*2) WHILE AN,1;   <<01041>>00472000
            BPS0:=0;                                           <<01041>>00474000
            DEL;                                               <<01041>>00476000
         END                                                   <<01041>>00478000
         ELSE MOVE USER':=("@",0);                             <<01041>>00480000
         IF USERS'(USERS'ACCTNAME*2)<>"@" THEN                 <<01041>>00482000
         BEGIN                                                 <<01041>>00484000
            MOVE ACCT':=USERS'(USERS'ACCTNAME*2) WHILE AN,1;   <<01041>>00486000
            BPS0:=0;                                           <<01041>>00488000
            DEL;                                               <<01041>>00490000
         END                                                   <<01041>>00492000
         ELSE MOVE ACCT':=("@",0);                             <<01041>>00494000
         GENMSG(ASSMSGSET,22,0,                                <<01041>>00496000
                @CLASSES'(I*CLASSES'LENGTH*2),@USER',@ACCT');  <<01041>>00498000
         RECNO:=DOUBLE(USERS(USERS'NEXT));                     <<01041>>00500000
      END                                                      <<01041>>00502000
      UNTIL RECNO=0D;                                          <<01041>>00504000
   END;                                                        <<01041>>00506000
   RETURN;                                                     <<01041>>00508000
END;                                                           <<01041>>00510000
$PAGE "INSERT -- INSERT ASSOCIATE RECORDS INTO ASSOCIATE FILE"          00512000
PROCEDURE INSERT(DEVICES,ASSOCIATE);                                    00514000
BYTE ARRAY DEVICES;                                                     00516000
INTEGER ARRAY ASSOCIATE;                                                00518000
BEGIN                                                                   00520000
   INTEGER ARRAY OLDASS(0:ENT'LEN-1),ZEROENT(0:ENT'LEN-1);              00522000
   INTEGER I:=0;                                                        00524000
                                                                        00526000
   WHILE (I:=I+1)<=INTEGER(DEVICES) DO <<ADD ENTRY FOR EACH DEV. GIVEN>>00528000
   BEGIN                                                                00530000
      FREADDIR(OUTPUTFILE,OLDASS,ENT'LEN,DOUBLE(DEVICES(I)));           00532000
      IF <> THEN FILEERR(OUTPUTFILE);                                   00534000
      IF OLDASS=0 THEN <<NO RECORDS FOR THIS DEVICE YET>>               00536000
      BEGIN                                                             00538000
         ASSOCIATE(12):=0; <<SET END OF RECORD CHAIN>>                  00540000
         FWRITEDIR(OUTPUTFILE,ASSOCIATE,ENT'LEN,DOUBLE(DEVICES(I)));    00542000
         IF <> THEN FILEERR(OUTPUTFILE);                                00544000
      END                                                               00546000
      ELSE <<RECORDS EXIST, CHAIN NEW IN FRONT OF OLD RECORDS>>         00548000
      BEGIN                                                             00550000
         FREADDIR(OUTPUTFILE,ZEROENT,ENT'LEN,0D);<<ALLOCATE NEW RECORD>>00552000
         IF <> THEN FILEERR(OUTPUTFILE);                                00554000
         FWRITEDIR(OUTPUTFILE,OLDASS,ENT'LEN,DOUBLE(ZEROENT));          00556000
         IF <> THEN FILEERR(OUTPUTFILE);                                00558000
         ASSOCIATE(12):=ZEROENT; <<POINT TO OLD HEAD OF CHAIN>>         00560000
         FWRITEDIR(OUTPUTFILE,ASSOCIATE,ENT'LEN,DOUBLE(DEVICES(I)));    00562000
         IF <> THEN FILEERR(OUTPUTFILE);                                00564000
         ZEROENT:=ZEROENT+1;                                            00566000
         FWRITEDIR(OUTPUTFILE,ZEROENT,ENT'LEN,0D); <<UPD NEXT AV. REC.>>00568000
         IF <> THEN FILEERR(OUTPUTFILE);                                00570000
      END;                                                              00572000
   END;                                                                 00574000
END;                                                                    00576000
$PAGE "PRINTCARET -- PRINT '>' UNDER ERROR"                             00578000
PROCEDURE PRINTCARET(BP);                                               00580000
VALUE BP;                                                               00582000
BYTE POINTER BP;                                                        00584000
BEGIN                                                                   00586000
   INTEGER I;                                                           00588000
   ARRAY BUFFER'(0:35);                                                 00590000
   BYTE ARRAY BUFFER(*)=BUFFER';                                        00592000
                                                                        00594000
   BUFFER':="  ";  <<BLANK FILL>>                                       00596000
   MOVE BUFFER'(1):=BUFFER',(35);                                       00598000
   I:=@BP-@INPUT+(IF STDIN THEN 1 ELSE 0);                              00600000
   BUFFER(I):="^";                                                      00602000
   PRINT (BUFFER',-I-1,0);                                              00604000
END;                                                                    00606000
$PAGE "*** OUTER BLOCK ***"                                             00608000
LOGICAL SUBROUTINE VERIFYNAME;                                          00610000
BEGIN                                                                   00612000
   COMMENT                                                              00614000
      VERIFIES THAT THE NAME POINTER TO BY CURRENT'PARM IS VALID        00616000
      ACCOUNT OR USER NAME.                                             00618000
   ;                                                                    00620000
   IF NOT (1<=CURRENT'LENGTH<=8) OR                                     00622000
      SPECIAL'CHAR AND (CURRENT'LENGTH>1 OR CURRENT'PARM<>"@") OR       00624000
      NOT SPECIAL'CHAR AND CURRENT'PARM<>ALPHA THEN                     00626000
   BEGIN                                                                00628000
      ERROR:=TRUE;                                                      00630000
      PRINTCARET(CURRENT'PARM);                                         00632000
      GENMSG(ASSMSGSET,10);                                             00634000
   VERIFYNAME:=FALSE;                                                   00636000
   END ELSE VERIFYNAME:=TRUE;                                           00638000
END;                                                                    00640000
                                                                        00642000
SUBROUTINE GETNEXTPARM;                                                 00644000
BEGIN                                                                   00646000
   COMMENT                                                              00648000
      SETS UP THE DESCRIPTION OF THE NEXT PARAMETER IN                  00650000
      CURRENT'PARM, CURRENT'LENGTH, CURRENT'DELIMITER & SPECIAL'CHAR.   00652000
   ;                                                                    00654000
   IF PARMNO>=NUMPARMS THEN RETURN;                                     00656000
   TOS:=PARMS(PARMNO);                                                  00658000
   PARMNO:=PARMNO+1;                                                    00660000
   CURRENT'DELIMITER:=S0.DELIMITER;                                     00662000
   SPECIAL'CHAR:=S0.SPECIALBIT=1;                                       00664000
   CURRENT'LENGTH:=TOS&LSR(8);                                          00666000
   @CURRENT'PARM:=TOS;                                                  00668000
END;                                                                    00670000
$PAGE                                                                   00672000
SUBROUTINE HEADING;                                            <<04633>>00674000
<< Prints the heading >>                                       <<04633>>00676000
BEGIN                                                          <<04633>>00678000
move output'buf := ptitle,2;                                   <<02327>>00680000
<< get # chars. by subtracting the address of output'buf(0)>>  <<02327>>00682000
<<from the offset  determined by move, found on TOS         >> <<02327>>00684000
numchar := tos-@output'buf;                                    <<02327>>00686000
MOVE OUTPUT'BUF(VUUFF'COL ):=OFFICIAL'VUUFF;                   <<04633>>00688000
print(output'buf',-numchar,%60); <<print header, doube space >><<02327>>00690000
END; << HEADING >>                                             <<04633>>00692000
HEADING;                                                       <<04633>>00694000
TURNOFFTRAPS;                                                  <<04634>>00696000
PROMPT:="> ";                                                           00698000
MOVE INFILENAME:="INPUT ";                                              00700000
INPUTFILE:=FOPEN(INFILENAME,%47,,-80); <<OPEN INPUT FILE>>     <<01008>>00702000
IF <> THEN                                                              00704000
BEGIN                                                                   00706000
   GENMSG(ASSMSGSET,4);                                                 00708000
   FILEERR(0);                                                          00710000
END;                                                                    00712000
I:=FRELATE(INPUTFILE,2); <<IS INPUT FILE DUPLICATIVE WITH $STDLIST>>    00714000
STDIN:=IF I<0 THEN TRUE ELSE FALSE;                                     00716000
                                                                        00718000
MOVE OUTFILENAME:="ASOCIATE.PUB.SYS ";                                  00720000
OUTPUTFILE:=FOPEN(OUTFILENAME,0,%104,ENT'LEN); <<OPEN OUTPUT FILE>>     00722000
IF <> THEN                                                              00724000
BEGIN                                                                   00726000
   GENMSG(ASSMSGSET,8);                                                 00728000
   FILEERR(0);                                                          00730000
END;                                                                    00732000
                                                                        00734000
FOR I:=1 UNTIL ENT'LEN-1  DO ASSOC'ENTRY(I):=0; <<INIT. ASSOCIATE FILE>>00736000
ASSOC'ENTRY:=256;                                                       00738000
FWRITEDIR(OUTPUTFILE,ASSOC'ENTRY,ENT'LEN,0D);                           00740000
IF <> THEN FILEERR(OUTPUTFILE);                                         00742000
ASSOC'ENTRY:=0;                                                         00744000
FOR I:=1 UNTIL 255 DO                                                   00746000
BEGIN                                                                   00748000
   FWRITEDIR(OUTPUTFILE,ASSOC'ENTRY,ENT'LEN,DOUBLE(I));                 00750000
   IF <> THEN FILEERR(OUTPUTFILE);                                      00752000
END;                                                                    00754000
                                                                        00756000
ERROR:=FALSE;                                                           00758000
                                                                        00760000
READLOOP:                                                               00762000
                                                                        00764000
IF STDIN THEN PRINT(PROMPT,-1,%320);                                    00766000
LENGTH:=FREAD(INPUTFILE,L'INPUT,-72);                                   00768000
IF < THEN FILEERR(INPUTFILE)                                            00770000
ELSE IF > THEN <<END OF FILE>>                                          00772000
BEGIN                                                                   00774000
EOF:                                                                    00776000
   FCLOSE(INPUTFILE,0,0); <<FINISHED PROCESSING INPUT>>                 00778000
   FCLOSE(OUTPUTFILE,IF ERROR THEN 4 ELSE 1, 0); <<SAVE NEW FILE, IF O>>00780000
   IF <> THEN <<MIGHT BE DUPLICATE FILE>>                               00782000
   BEGIN                                                                00784000
      FCHECK(OUTPUTFILE,I); <<GET ERROR REASON>>                        00786000
      IF I=DUPLICATEFILE THEN <<DELETE OLD FILE, THEN SAVE NEW FILE>>   00788000
      BEGIN                                                             00790000
         FGETINFO(OUTPUTFILE,DUPFILENAME); <<GET NAME OF OUTPUT FILE>>  00792000
         IF <> THEN FILEERR(OUTPUTFILE);                                00794000
         I:=FOPEN(DUPFILENAME,%2001,%300);<<SHARE,NO FILE EQUATION>>    00796000
         IF <> THEN                                                     00798000
         BEGIN <<COULDN'T DELETE OLD ASSOCIATE FILE>>                   00800000
            GENMSG(ASSMSGSET,1);                                        00802000
            FILEERR(0);                                                 00804000
         END;                                                           00806000
         FCLOSE(I,4,0); <<DELETE OLD ASSOCIATE FILE>>                   00808000
         IF <> THEN                                                     00810000
         BEGIN <<COULDN'T DO CLOSE TO DELETE ASSOCIATE FILE>>           00812000
            GENMSG(ASSMSGSET,1);                                        00814000
            FILEERR(I);                                                 00816000
         END;                                                           00818000
         FCLOSE(OUTPUTFILE,1,0); <<SAVE NEW ASSOCIATE FILE>>            00820000
         IF <> THEN FILEERR(OUTPUTFILE);                                00822000
      END ELSE FILEERR(OUTPUTFILE);                                     00824000
   END;                                                                 00826000
   TERMINATE;                                                           00828000
END                                                                     00830000
ELSE <<GOT A RECORD IN>>                                                00832000
BEGIN                                                                   00834000
   IF NOT STDIN THEN PRINT(L'INPUT,-LENGTH,0);                          00836000
   IF LENGTH=0 OR INPUT="$" THEN GO TO READLOOP; <<COMMENT FOUND>>      00838000
   IF LENGTH=4 AND (INPUT="EXIT" OR INPUT="exit") THEN GO TO EOF;       00840000
   INPUT(LENGTH):=CARRIAGE'RETURN;                                      00842000
   MYCOMMAND(INPUT,DL',35,NUMPARMS,PARMS); <<PARSE INPUT LINE>>         00844000
                                                                        00846000
   IF NUMPARMS<3 THEN <<MUST HAVE AT LEAST LDEV=USER.ACCT>>             00848000
   BEGIN                                                                00850000
      ERROR:=TRUE;                                                      00852000
      GENMSG(ASSMSGSET,2);                                              00854000
      GO TO READLOOP;                                                   00856000
   END;                                                                 00858000
   PARMNO:=0;                                                           00860000
   GETNEXTPARM; <<GET DEVICE # OR DEVICE CLASS NAME>>                   00862000
   IF CURRENT'DELIMITER<>EQUALS THEN <<MUST HAVE = FOLLOWING DEVICE>>   00864000
   BEGIN                                                                00866000
      ERROR:=TRUE;                                                      00868000
      GENMSG(ASSMSGSET,3);                                              00870000
      GO TO READLOOP;                                                   00872000
   END;                                                                 00874000
   IF CURRENT'LENGTH>8 THEN <<BAD CLASSNAME>>                           00876000
   BEGIN                                                                00878000
      ERROR:=TRUE;                                                      00880000
      GENMSG(ASSMSGSET,5);                                              00882000
      GO TO READLOOP;                                                   00884000
   END;                                                                 00886000
   MOVE CLASSNAME:="        ";                                          00888000
   MOVE CLASSNAME':=CURRENT'PARM,(CURRENT'LENGTH);                      00890000
   IF NOT GETCLASS(CLASSINFO,TRUE,,,CLASSNAME) THEN <<NO SUCH CLASS>>   00892000
   BEGIN                                                                00894000
      ERROR:=TRUE;                                                      00896000
      GENMSG(ASSMSGSET,6);                                              00898000
      GO TO READLOOP;                                                   00900000
   END;                                                                 00902000
                                                                        00904000
<< HAVE GOT DEVICES, NOW PARSE USER.ACCT,....>>                         00906000
                                                                        00908000
   MOVE ASSOC'CLASS:=CLASSNAME',(8);                                    00910000
   WHILE PARMNO<NUMPARMS DO                                             00912000
   BEGIN                                                                00914000
      GETNEXTPARM;                                                      00916000
      IF NOT VERIFYNAME THEN GO TO READLOOP; <<BAD USERNAME>>           00918000
      IF CURRENT'DELIMITER<>PERIOD THEN <<EXPECTED "." AFTER USERNAME>> 00920000
      BEGIN                                                             00922000
         ERROR:=TRUE;                                                   00924000
         PRINTCARET(CURRENT'PARM(CURRENT'LENGTH));                      00926000
         GENMSG(ASSMSGSET,7);                                           00928000
         GO TO READLOOP;                                                00930000
      END;                                                              00932000
      MOVE ASSOC'USERNAME:="        ";                                  00934000
      MOVE ASSOC'USERNAME:=CURRENT'PARM,(CURRENT'LENGTH);               00936000
                                                                        00938000
      GETNEXTPARM;                                                      00940000
      IF NOT VERIFYNAME THEN GO TO READLOOP; <<INVALID ACCT NAME>>      00942000
      IF CURRENT'DELIMITER<>COMMA AND CURRENT'DELIMITER<>CR THEN        00944000
      BEGIN                                                             00946000
         ERROR:=TRUE;                                                   00948000
         PRINTCARET(CURRENT'PARM(CURRENT'LENGTH));                      00950000
         GENMSG(ASSMSGSET,9);                                           00952000
         GO TO READLOOP;                                                00954000
      END;                                                              00956000
      MOVE ASSOC'ACCTNAME:="        ";                                  00958000
      MOVE ASSOC'ACCTNAME:=CURRENT'PARM,(CURRENT'LENGTH);               00960000
                                                                        00962000
      INSERT(LDEV,ASSOC'ENTRY);                                         00964000
   END;                                                                 00966000
END;                                                                    00968000
GO TO READLOOP;                                                         00970000
                                                               <<01041>>00972000
<< LIST ASOCIATE.PUB.SYS ENTRY POINT>>                         <<01041>>00974000
LIST:                                                          <<01041>>00976000
   HEADING;                                                    <<04633>>00978000
   TURNOFFTRAPS;                                               <<04634>>00980000
   LISTASS;                                                    <<01041>>00982000
   TERMINATE;                                                  <<01041>>00984000
                                                               <<01041>>00986000
END.                                                                    00988000
