IMD 1.12: 17/09/2006 14:50:12 ISIS-II SOFTWARE TOOLBOX TOOL SOURCE, DISK 4 OF 4 P/N 124100-001 VERSION 4 OF 4 SINGLE DENSITY (C)INTEL CORPORATION, 1981 FL1328  12410000141 1<666666666666666666666666666666666666666666666666666666666666666666666666666y{0!0 N #0 NON-SYSTEM DISK, TRY ANOTHER       RESCANSRC*RETURNSRCGSEQSRCSORTSRCR9 SORT2SRCd9STOPIFSRC";TAILSRC6TOKENSSRCP      UNPACKSRCfY (UNPAKRSRC(+UPPERSRCT-WAITSRC8.WHICHSRCd_ /XLATE2SRCg>3ISISDIRISISMAPISIST0ISISLABPACKERSRC.,PAUSESRCCTRELABSRCSjREPORTSRCk      e blanks into a single byte which has the high bit on. This necessarily dictates that the system in use does not racter; dcl (actual,status) int2; dcl compress boolean; dcl compression$byte int1; dcl i int2; dcl input$name pointer EXTERrwise, without the prior */ /* written permission of Intel Corporation, 3065 Bowers */ /* Avenue, Santa Clara, CaURE (aft,buffer,count,status) EXTERNAL; DECLARE (aft,buffer,count,status) address; END write; file$error: PROCEDPacker: DO; /************************************************************************/ /* */ /* 'HEN DO;'; dcl elseif as 'END; ELSE IF'; dcl elsee as 'END; ELSE DO;'; dcl endif as 'END;'; dcl whilee as 'DO WHILE'; dcl enuse the parity bit. Strings of blanks greater than 128 are manipulated as multiple compression bytes. Thlifornia, 95051, Attn: Software */ /* License Administration. */ /* */ /*******************URE (status, filename$ptr, callexit) EXTERNAL; DECLARE (status, filename$ptr) address; DECLARE callexit boolean; EN(C) Intel Corporation 1981'. All rights reserved. No */ /* part of this program or publication may be reproduced, */dwhile as 'END;'; dcl enddo as 'END;'; dcl for as 'DO'; dcl endfor as 'END;'; dcl compress$1 as '0FFH'; dcl buffer$size ae logical value returned is true if an error occured */ DECLARE dcl LITERALLY 'DECLARE'; DECLARE as LITERALLY 'LITERALLY'*****************************************************/ /* These routines are designed to accept ascii files and coD file$error; dcl output$buffer(buffer$size) character; dcl input$buffer(buffer$size) character; dcl output$pointer pointer /* transmitted, transcribed, stored in a retrievel system, or */ /* translated into any language or computer langus '20480'; dcl limit as 'buffer$size-1'; dcl cr as '0DH'; dcl lf as '0AH'; /* system EXTERNALs */ read: PROCEDURE (aft; dcl boolean as 'BYTE'; dcl end$of$file as 'actual=0'; dcl depart as '0FFH'; dcl true as '0FFH'; dcl false as '0'; dcl mpress the blanks to reduce the storage costs on disks Blanks are compressed by converting strings of consecutiv; dcl output$character based output$pointer character; dcl input$pointer pointer; dcl input$character based input$pointer chaage, in any */ /* form or by any means, electronic, mechanical, magnetic, */ /* optical, chemical, manual or othe,buffer,count,actual,status) EXTERNAL; DECLARE (aft,buffer,count,actual,status) address; END read; write: PROCED          character as 'BYTE'; dcl pointer as 'ADDRESS'; dcl int1 as 'BYTE'; dcl int2 as 'ADDRESS'; dcl nil as '0'; dcl thenn as 'T      for i = 0 TO actual-1; if input$character=' ' thenn if not compress thenn compress=tray be reproduced, */ /* transmitted, transcribed, stored in a retrievel system, or */ /* translated into any langdif END flush; packer: PROCEDURE boolean PUBLIC; /* This procedure is responsible for compressing the blanks and  RETURN false; end packer; end Packer;  CALL file$error(status,output$name,false); if status <> 0 thenn RETURN false; endif output$po RETURN true; endif compress=false; endif if not output(input$chaNAL; dcl output$name pointer EXTERNAL; dcl out$aftn int2 EXTERNAL; dcl in$aftn int2 EXTERNAL; output: PROCEDURE(put$char) ue; compression$byte=compress$1; elsee compression$byte=compression$byte-1; transfering the contents of the input file */ output$pointer = .output$buffer; input$pointer = .input$buffer; com          inter = .output$buffer; endif RETURN true; END output; flush: PROCEDURE; /* This routine flushes the outpuracter) thenn RETURN true; endif endif input$pointer=input$pointer+1; enboolean; /* This procedure accepts a character and fills a buffer. When the buffer is full, it is then written  if compression$byte=80h thenn /* 128 blanks */ if not output(080h) thenn press = false; /* begin processing */ CALL read(inaftn,.input$buffer,buffer$size,.actual,.status); CALL f$ TITLE('PAUSE') PAUSE$MOD: DO; /************************************************************************/ /* t buffer at the end of the file */ if output$pointer = .output$buffer thenn RETURN; elsee CALL write(oudfor CALL read(inaftn,.input$buffer,buffer$size,.actual,.status); CALL file$error(status,input$name,false); to the output file. */ dcl put$char character; output$character = put$char; output$pointer = output$poin RETURN true; endif compression$byte=compress$1; endif ile$error(status,input$name,false); if status <> 0 thenn RETURN true; endif whilee not end$of$file;  */ /* '(C) Intel Corporation 1981'. All rights reserved. No */ /* part of this program or publication mtaftn,.output$buffer,output$pointer-.output$buffer, .status); CALL file$error(status,output$name,false); en if status <> 0 thenn RETURN true; endif input$pointer=.input$buffer; endwhile CALL flush; ter + 1; if output$pointer > .output$buffer + limit thenn CALL write(outaftn,.output$buffer,buffer$size,.status);  endif elsee if compress thenn if not output(compression$byte) thenn      (WHICH$DEVICE,ENTRY$POINT) EXTERNAL; DECLARE WHICH$DEVICE BYTE, ENTRY$POINT ADDRESS; END IO$DEF; IO$SET: PROCEDURE '07H', /* plm */ BLANK AS '020H', /* plm */ BOOLEAN YTE; END CO; CONSOL: PROCEDURE (CONSOLE$INPUT$FILE,CONSOL$OUTPUT$FILE,STATUS$CON) EXTERNAL; DECLARE (CONSOLE$INPUT$FILS) ADDRESS; END SPATH; WHOCON: PROCEDURE (AFTN,BUFFER) EXTERNAL; DECLARE (AFTN,BUFFER) ADDRESS; END WHOCON; WRITTEL CORP 1981'); DECLARE PROGRAM$VERSION$NUMBER$STRING (*) BYTE DATA ('program_version_number=V1.0',0); /* ISUS) EXTERNAL; DECLARE (AFTN,BUFFER,COUNT,ACTUAL,STATUS) ADDRESS; END READ; RENAME: PROCEDURE (OLD$NAME,NEW$NAME,STATUSuage or computer language, in any */ /* form or by any means, electronic, mechanical, magnetic, */ /* optical, ch (CONFIGURATION$BYTE) EXTERNAL; DECLARE CONFIGURATION$BYTE BYTE; END IO$SET; LOAD: PROCEDURE (FILE,BIAS,CONTROL$OF$TRAE,CONSOL$OUTPUT$FILE,STATUS$CON) ADDRESS; END CONSOL; DELETE: PROCEDURE (FILE$NAME$PTR,STATUS) EXTERNAL; DECLARE (FILEE: PROCEDURE (AFTN,BUFFER,COUNT,STATUS) EXTERNAL; DECLARE (AFTN,BUFFER,COUNT,STATUS) ADDRESS; END WRITE; /* END ISISIS.INC */ ATTRIB: PROCEDURE(FILE$NAME$PTR,WHICH$ATTRIBUTE,SET$OR$RESET,STATUS$PTR) EXTERNAL; DECLARE (FILE$NAME$PTR,WHICH$R) EXTERNAL; DECLARE (OLD$NAME,NEW$NAME,STATUS$R) ADDRESS; END RENAME; RESCAN: PROCEDURE (AFTN,STATUS) EXTERNAL; DEemical, manual or otherwise, without the prior */ /* written permission of Intel Corporation, 3065 Bowers */ /* ANSFER,ENTRY$POINT,STATUS) EXTERNAL; DECLARE (FILE,BIAS,CONTROL$OF$TRANSFER,ENTRY$POINT,STATUS) ADDRESS; END LOAD; MEMCK:$NAME$PTR,STATUS) ADDRESS; END DELETE; ERROR: PROCEDURE (ERROR$NUMBER) EXTERNAL; DECLARE ERROR$NUMBER ADDRESS; END .INC */ $ NOLIST /* LIT.INC */ DECLARE AS LITERALLY 'LITERALLY', /* plm */ $ATTRIBUTE,SET$OR$RESET,STATUS$PTR) ADDRESS; END ATTRIB; CLOSE: PROCEDURE (AFTN,STATUS) EXTERNAL; DECLARE (AFTN,STATUSCLARE (AFTN,STATUS) ADDRESS; END RESCAN; SEEK: PROCEDURE (AFTN,MODE,BLOCKNO,BYTENO,STATUS) EXTERNAL; DECLARE (AFTN,MODvenue, Santa Clara, California, 95051, Attn: Software */ /* License Administration. */ /* */ PROCEDURE ADDRESS EXTERNAL; END MEMCK; OPEN: PROCEDURE(AFTN,FILENAME,ACCESS$MODE,LINE$EDIT$AFTN,ERROR) EXTERNAL; DE ERROR; EXIT: PROCEDURE EXTERNAL; END EXIT; IO$CHK: PROCEDURE BYTE EXTERNAL; END IO$CHK; IO$DEF: PROCEDURE AMPERSAND AS '''&''', /* ??? */ BACK$GROUND$FOLLOWS AS '019H', /* 1510 */ BELL$CHAR AS) ADDRESS; END CLOSE; CI: PROCEDURE BYTE EXTERNAL; END CI; CO: PROCEDURE (CHAR$CO) EXTERNAL; DECLARE CHAR$CO BE,BLOCKNO,BYTENO,STATUS) ADDRESS; END SEEK; SPATH: PROCEDURE (FILE,BUFFER,STATUS) EXTERNAL; DECLARE (FILE,BUFFER,STATU /************************************************************************/ DECLARE COPYRIGHT (*) BYTE DATA ('(C) INCLARE (AFTN,FILENAME,ACCESS$MODE,LINE$EDIT$AFTN,ERROR) ADDRESS; END OPEN; READ: PROCEDURE (AFTN,BUFFER,COUNT,ACTUAL,STAT     OLLOWS AS '01FH', /* 1510 */ FORMAT$ATTRIBUTE AS '3', /* attrib */ LEAD$IN$CHAR AS '07EH', /*1510 / ; /* ENDLIT.INC */ $ LIST DECLARE ACTUAL ADDRESS, AFTN ADDRESS, BLOCK$NO ADDRESS INIT AS ' ', /* plm */ END$ITERATED$DO AS 'END', /* plm */ END$LOOP AS AS '(*) BYTE DATA', /* plm */ TAB AS '09H', /* plm */  /* open */ CONTROL$Z AS '01AH', /* plm */ CR AS '0DH',  AS '0', /* attrib */ RETURN$MARKER$POS AS '0', /* seek */ RUB$OUT AS '07FH',  AS 'BYTE', /* plm */ CHK AS 'CALL CHECK$STATUS', /* plm */*/ LF AS '0AH', /* plm */ NO$LINE$EDIT AS '0',  ' ', /* plm */ EOF$CHAR AS 'CONTROL$Z', /* plm */ ESCAPE  TRANSFER$CONTROL AS '1', /* load */ TRUE AS '0FFH',  /* plm */ DOT AS '''.''', /* char */ END$DO  /* plm */ SEEK$2$EOF AS '4', /* seek */ SEEK$BACKWARD$BY$N AS '1',  CLEAR$CHAR AS '01CH', /* 1510 */ CO$ECHO$FILE AS '0F00H', /* open */ COLO /* open */ NULL AS '0FFH', /* ??? */ OPEN$FOR$READ AS '1', /* open  AS '01BH', /* plm */ FALSE AS '0H', /* plm */ /* plm */ UNDERBAR AS '''_''', /* ??? */ USER$CI AS '0', /* ??? * AS 'END', /* plm */ END$DO$CASE AS 'END', /* plm */ END /* seek */ SEEK$FORWARD$BY$N AS '3', /* seek */ SEEK$2$N AS '2', N AS ''':''', /* char */ COMMA AS '02CH', /* plm*/ OPEN$FOR$WRITE AS '2', /* open */ OPEN$FOR$UPDATE AS '3', /* open */  FF AS '0CH', /* ??? */ FOREVER AS 'WHILE 1', /* plm */ FORE$GROUND$F/ WRITE$PROTECT$ATTRIBUTE AS '2', /* attrib */ ZERO$BIAS AS '0' /* load *$DO$FOREVER AS 'END', /* plm */ END$DO$WHILE AS 'END', /* plm */ END$IF  /* seek */ SEMICOLON AS ''';''', /* plm */ SET AS '1', /* attrib */ STRING  */ CONSOLE$INPUT AS '1', /* open */ CONSOLE$OUTPUT AS '0', PARITY$BIT$MASK AS '0111$1111$B', /* plm */ PUB$STRING AS '(*) BYTE PUBLIC DATA', /* plm */ RESET       CHAR BYTE AT (.COLD$BOOT$CI(1)); IF IO$CHK THEN CHAR = 'V'; ELSE CHAR = 'T'; ENDIF CALL CONSOL(.COLD$BOOT$CI,./********************************************/ IF CO$IS$VO THEN CALL EXIT; ENDIF CALL PRINT$NEXT$LINE; CALL PRINT$MESSESSAGE STRING ('hit to continue, ^Z to stop --',CR,LF); DECLARE I BYTE; DECLARE INPUT$BYTE BYTE; DECLARE EXECUsole output. */ CALL CONSOL(.(':CI: '),.(':VO: '),.STATUS); CHK; CALL WRITE(CONSOLE$OUTPUT,.EXECUTE$MSG,SIZE(EXECUTEERNAL; END CHECK$STATUS; ISIS$TERMINATOR: PROCEDURE (A$CHAR) BOOLEAN EXTERNAL; DECLARE A$CHAR BYTE; END ISIS$TERMIN = 'O' AND WHO$CON$BUF(3) = ':' THEN RETURN TRUE; ELSE RETURN FALSE; ENDIF END CO$IS$VO; PRINT$NEXT$LINE: IAL (0), BYTE$NO ADDRESS INITIAL (0), CI$BUF (130) BYTE, CHAR$PTR ADDRESS INITIAL (.CI$BUF), CHAR BASED C(':CO: '),.STATUS); END RETURN$TO$COLD$BOOT$CI; STRIP$PARITY$BIT: PROCEDURE (INPUT$BYTE) BYTE; DECLARE INPUT$BYTE BYTETE$MSG STRING ('Execute command ==>"'); DECLARE QUESTION$MARK STRING ('"<== ??',CR,LF); CLEAR$SCREEN: PROCEDURE; $MSG),.STATUS); CHK; /* Leave of the trailing CRLF on this write. */ CALL WRITE(CONSOLE$OUTPUT,.CI$BUF,(ACTUAL-2),.SATOR; ERROR$EXIT: PROCEDURE (MSG$PTR) EXTERNAL; DECLARE MSG$PTR ADDRESS; END ERROR$EXIT; FORCUP: PROCEDURE (TEXT$ PROCEDURE; /* Re-assign the console output to prevent unwanted echoing. */ CALL CONSOL(.(':CI: '),.(':BB: '),.STATUS); CHAR$PTR BYTE, STATUS ADDRESS PUBLIC INITIAL (0), WHO$CON$BUF (20) BYTE, ZERO$VAL ADDRESS INITIAL (0) ; ; RETURN (0111$1111$B AND INPUT$BYTE); END STRIP$PARITY$BIT; PRINT$MESSAGE: PROCEDURE; DO I=0 TO LAST(MESSAGE) DECLARE HAZELTINE$LEAD$IN AS '07EH', CLEAR$SCREEN$CHAR AS '01CH'; CALL CO(HAZELTINE$LEAD$IN); CALL CO(CLEARTATUS); CHK; CALL WRITE(CONSOLE$OUTPUT,.QUESTION$MARK,SIZE(QUESTION$MARK),.STATUS); CHK; END PRINT$NEXT$LINE; PTR,COUNT) EXTERNAL; DECLARE (TEXT$PTR,COUNT) ADDRESS; END FORCUP; $ LIST DECLARE CARRIAGE$RETURN AS 'CR'; DECLARE MHK; /* clear the command tail buffer. */ CALL READ(CONSOLE$INPUT,.CI$BUF,SIZE(CI$BUF),.ACTUAL,.STATUS); CHK; / DECLARE FILE$INFORMATION STRUCTURE (DEVICE$NUMBER BYTE, FILE$NAME (6) BYTE, ; CALL CO(MESSAGE(I)); ENDDO; END PRINT$MESSAGE; CO$IS$VO: PROCEDURE BOOLEAN; DECLARE WHO$CON$BUF (15) B$SCREEN$CHAR); END CLEAR$SCREEN; RETURN$TO$COLD$BOOT$CI: PROCEDURE; DECLARE COLD$BOOT$CI (*) BYTE DATA (':?I: '),  $ EJECT /********************************************/ /* */ /* FIRST EXECUTABLE */ /* */      * Now, read the next line. */ CALL READ(CONSOLE$INPUT,.CI$BUF,SIZE(CI$BUF),.ACTUAL,.STATUS); CHK; /* Restore the conEXTENSION (3) BYTE, DEVICE$TYPE BYTE, DRIVE$TYPE (11) BYTE); CHECK$STATUS: PROCEDURE EXTYTE; CALL WHO$CON(CONSOLE$OUTPUT,.WHO$CON$BUF); IF WHO$CON$BUF(0) = ':' AND WHO$CON$BUF(1) = 'V' AND WHO$CON$BUF(2)     GHT (*) BYTE DATA ('(C) INTEL CORP 1981'); DECLARE PROGRAM$VERSION$NUMBER$STRING (*) BYTE DATA ('program_version_number=N,BUFFER,COUNT,ACTUAL,STATUS) EXTERNAL; DECLARE (AFTN,BUFFER,COUNT,ACTUAL,STATUS) ADDRESS; END READ; RENAME: PROCEDURE translated into any language or computer language, in any */ /* form or by any means, electronic, mechanical, magnetic,EF; IO$SET: PROCEDURE (CONFIGURATION$BYTE) EXTERNAL; DECLARE CONFIGURATION$BYTE BYTE; END IO$SET; LOAD: PROCEDURE                     DECLARE (CONSOLE$INPUT$FILE,CONSOL$OUTPUT$FILE,STATUS$CON) ADDRESS; END CONSOL; DELETE: PROCEDURE (FILE$NAME$PTR,STATUS)AGE; CALL CO(BELL$CHAR); loop$begin: INPUT$BYTE = STRIP$PARITY$BIT(CI); IF INPUT$BYTE = CONTROL$Z THEN DO; CALL RV1.0',0); /* ISIS.INC */ ATTRIB: PROCEDURE(FILE$NAME$PTR,WHICH$ATTRIBUTE,SET$OR$RESET,STATUS$PTR) EXTERNAL; DE */ /* optical, chemical, manual or otherwise, without the prior */ /* written permission of Intel Corporation, 3 (FILE,BIAS,CONTROL$OF$TRANSFER,ENTRY$POINT,STATUS) EXTERNAL; DECLARE (FILE,BIAS,CONTROL$OF$TRANSFER,ENTRY$POINT,STATUS) ADDRE$ TITLE ('RELAB -- DISK RELABELLING TOOL') RELAB$MOD: DO; /************************************************************ EXTERNAL; DECLARE (FILE$NAME$PTR,STATUS) ADDRESS; END DELETE; ERROR: PROCEDURE (ERROR$NUMBER) EXTERNAL; DECLARE ERETURN$TO$COLD$BOOT$CI; CALL EXIT; ENDDO; ELSE IF INPUT$BYTE <> BLANK THEN GO TO loop$begin; ELSE DO; CLARE (FILE$NAME$PTR,WHICH$ATTRIBUTE,SET$OR$RESET,STATUS$PTR) ADDRESS; END ATTRIB; CLOSE: PROCEDURE (AFTN,STATUS) EXTERN065 Bowers */ /* Avenue, Santa Clara, California, 95051, Attn: Software */ /* License Administration. SS; END LOAD; MEMCK: PROCEDURE ADDRESS EXTERNAL; END MEMCK; OPEN: PROCEDURE(AFTN,FILENAME,ACCESS$MODE,LINE$EDIT$************/ /* */ /* '(C) Intel Corporation 1981'. All rights reserved. No */ /* part of thiROR$NUMBER ADDRESS; END ERROR; EXIT: PROCEDURE EXTERNAL; END EXIT; IO$CHK: PROCEDURE BYTE EXTERNAL; END IO$CH CALL SEEK(CONSOLE$INPUT,SEEK$BACKWARD$BY$N,.ZERO$VAL, .ACTUAL,.STATUS); CHK; AL; DECLARE (AFTN,STATUS) ADDRESS; END CLOSE; CI: PROCEDURE BYTE EXTERNAL; END CI; CO: PROCEDURE (CHAR$CO) EXT*/ /* */ /************************************************************************/ DECLARE COPYRIAFTN,ERROR) EXTERNAL; DECLARE (AFTN,FILENAME,ACCESS$MODE,LINE$EDIT$AFTN,ERROR) ADDRESS; END OPEN; READ: PROCEDURE (AFTs program or publication may be reproduced, */ /* transmitted, transcribed, stored in a retrievel system, or */ /* K; IO$DEF: PROCEDURE (WHICH$DEVICE,ENTRY$POINT) EXTERNAL; DECLARE WHICH$DEVICE BYTE, ENTRY$POINT ADDRESS; END IO$D CALL EXIT; ENDDO; ENDIF end$loop END PAUSE$MOD; EOF ERNAL; DECLARE CHAR$CO BYTE; END CO; CONSOL: PROCEDURE (CONSOLE$INPUT$FILE,CONSOL$OUTPUT$FILE,STATUS$CON) EXTERNAL;      S '0', /* open */ CONTROL$Z AS '01AH', /* plm */ CR  /* plm */ RESET AS '0', /* attrib */ RETURN$MARKER$POS AS '0', /* seek */  /* plm */ BOOLEAN AS 'BYTE', /* plm */ CHK AS 'CALL CHECK$STAT AS '07EH', /*1510 */ LF AS '0AH', /* plm */ NO$LINE$EDIT AS SS; END WHOCON; WRITE: PROCEDURE (AFTN,BUFFER,COUNT,STATUS) EXTERNAL; DECLARE (AFTN,BUFFER,COUNT,STATUS) ADDRESS; EN END$LOOP AS ' ', /* plm */ EOF$CHAR AS 'CONTROL$Z',  (OLD$NAME,NEW$NAME,STATUS$R) EXTERNAL; DECLARE (OLD$NAME,NEW$NAME,STATUS$R) ADDRESS; END RENAME; RESCAN: PROCEDURE (A AS '0DH', /* plm */ DOT AS '''.''', /* charUS', /* plm */ CLEAR$CHAR AS '01CH', /* 1510 */ CO$ECHO$FILE AS '0F00H', '0', /* open */ NULL AS '0FFH', /* ??? */ OPEN$FOR$READ AS '1', D WRITE; /* END ISIS.INC */ $ NOLIST /* LIT.INC */ DECLARE AS LITERALLY 'LITERALLY', /* plm */ ESCAPE AS '01BH', /* plm */ FALSE AS '0H', FTN,STATUS) EXTERNAL; DECLARE (AFTN,STATUS) ADDRESS; END RESCAN; SEEK: PROCEDURE (AFTN,MODE,BLOCKNO,BYTENO,STATUS) EXT */ END$DO AS 'END', /* plm */ END$DO$CASE AS 'END',  /* open */ COLON AS ''':''', /* char */ COMMA AS '02CH',  /* open */ OPEN$FOR$WRITE AS '2', /* open */ OPEN$FOR$UPDATE AS '3 /* plm */ AMPERSAND AS '''&''', /* ??? */ BACK$GROUND$FOLLOWS AS '019H', /* 1510 */  /* plm */ FF AS '0CH', /* ??? */ FOREVER AS 'WHILE 1', /*ERNAL; DECLARE (AFTN,MODE,BLOCKNO,BYTENO,STATUS) ADDRESS; END SEEK; SPATH: PROCEDURE (FILE,BUFFER,STATUS) EXTERNAL;  /* plm */ END$DO$FOREVER AS 'END', /* plm */ END$DO$WHILE AS 'END', /* /* plm */ CONSOLE$INPUT AS '1', /* open */ CONSOLE$OUTPUT A', /* open */ PARITY$BIT$MASK AS '0111$1111$B', /* plm */ PUB$STRING AS '(*) BYTE PUBLIC DATA',  BELL$CHAR AS '07H', /* plm */ BLANK AS '020H',  plm */ FORE$GROUND$FOLLOWS AS '01FH', /* 1510 */ FORMAT$ATTRIBUTE AS '3', /* attrib */ LEAD$IN$CHARDECLARE (FILE,BUFFER,STATUS) ADDRESS; END SPATH; WHOCON: PROCEDURE (AFTN,BUFFER) EXTERNAL; DECLARE (AFTN,BUFFER) ADDRE plm */ END$IF AS ' ', /* plm */ END$ITERATED$DO AS 'END', /* plm */      LEAN EXTERNAL; DECLARE A$CHAR BYTE; END ISIS$TERMINATOR; $ LIST DECLARE ISIS$LAB STRING (':F0:ISIS.LAB '); /* 0LD$NAME$INDEX,NEW$NAME$INDEX) BYTE; DECLARE OLD$NAME BASED NAME$PART$PTR (100) BYTE; move$and$bump: procedure;  BLOCK$NO ADDRESS INITIAL (0), BYTE$NO ADDRESS INITIAL (0), STATUS ADDRESS PUBLIC INITIAL (0), WHO$CON$BUFIT>='0') AND (A$DIGIT<='9'); END DECIMAL$DIGIT; PRINT$DOC: PROCEDURE; DECLARE DOC STRING ('sy /* plm */ TRANSFER$CONTROL AS '1', /* load */ TRUE AS '0 ('ISIS-II DISK RELABELLING UTILITY, V1.0',cr,lf); CALL WRITE(CONSOLE$OUTPUT,.BANNER,SIZE(BANNER),.STATUS); CHK; END SIG RUB$OUT AS '07FH', /* plm */ SEEK$2$EOF AS '4', /* seek */ SEEK$BAC123456789012 */ DECLARE DRIVE$NUM BYTE AT (.ISIS$LAB(2)); DECLARE CHAR$PTR ADDRESS INITIAL (.CI$BUF), CHAR BASED CHAR$ (20) BYTE, ZERO$VAL ADDRESS INITIAL (0) ; DECLARE FILE$INFORMATION STRUCTURE (DEVICE$NUMBER ntax is RELAB | ? | ',CR,LF); CALL WRITE(CONSOLE$OUTPUT,.DOC,SIZE(DOC),.STATUS); CHK; END PRINFFH', /* plm */ UNDERBAR AS '''_''', /* ??? */ USER$CI AS '0', N$ON; FORCUP: PROCEDURE (TEXT$PTR,COUNT); DECLARE TEXT$PTR ADDRESS, TEXT BASED TEXT$PTR (100) BYTE; DECLARE COUNT AKWARD$BY$N AS '1', /* seek */ SEEK$FORWARD$BY$N AS '3', /* seek */ SEEK$2$N PTR BYTE, CHAR$ARRAY BASED CHAR$PTR (100) BYTE; DECLARE CI$BUF (140) BYTE; DECLARE NAME$PART$PTR ADDRESS; DECLARE NEW$DIBYTE, FILE$NAME (6) BYTE, EXTENSION (3) BYTE, DEVICE$TYPE BYTE, DT$DOC; ERROR$EXIT: PROCEDURE; DECLARE ERR$MSG STRING ('syntax error',CR,LF); CALL WRITE(CONSOLE$OUTPUT,.ERR$MSG,SIZE /* ??? */ WRITE$PROTECT$ATTRIBUTE AS '2', /* attrib */ ZERO$BIAS AS '0' DDRESS; DECLARE J ADDRESS; DO J=1 TO COUNT; IF (TEXT(J)>='a') AND (TEXT(J)<='z') THEN TEXT(J) = TEXT(J) - 20H;  AS '2', /* seek */ SEMICOLON AS ''';''', /* plm */ SET AS '1', /*                                       RIVE$TYPE (11) BYTE); CHECK$STATUS: PROCEDURE EXTERNAL; END CHECK$STATUS; ISIS$TERMINATOR: PROCEDURE (A$CHAR) BOO(ERR$MSG),.STATUS); CHK; CALL PRINT$DOC; CALL EXIT; END ERROR$EXIT; CONSTRUCT$NEW$NAME: PROCEDURE; DECLARE (O /* load */ ; /* ENDLIT.INC */ $ LIST DECLARE ACTUAL ADDRESS, AFTN ADDRESS,  ENDIF ENDDO; END FORCUP; DECIMAL$DIGIT: PROCEDURE (A$DIGIT) BOOLEAN; DECLARE A$DIGIT BYTE; RETURN (A$DIG attrib */ STRING AS '(*) BYTE DATA', /* plm */ TAB AS '09H', SK$NAME (9) BYTE INITIAL (0,0,0,0,0,0,0,0,0); /* 1 2 3 4 5 6 7 8 9 */ SIGN$ON: PROCEDURE; DECLARE BANNER STRING      DDO; ENDIF /* Scan name part. */ L=0; DO WHILE LETTER$OR$DIGIT(FILNAM(L)); L = L + 1; ENDDO; /* Check y specified...*/ IF CHAR=COLON THEN DO; DRIVE$NUM = CHAR$ARRAY(2); NAME$PART$PTR = CHAR$PTR + 4; end good$explicit$device$spec; letter$or$digit: procedure (a$char) boolean; declare a$char byte; return (a); /* Point to command tail. */ DO WHILE CHAR=TAB OR CHAR=BLANK; CHAR$PTR = CHAR$PTR + 1; ENDDO; /* If q; DO WHILE NOT ISIS$TERMINATOR(OLD$NAME(OLD$NAME$INDEX)); CALL MOVE$AND$BUMP; ENDDOWHILEot terminator illegal */ FILNAM(L) = COLON OR /* colon terminator illegal */ L-EXT$BEGIN = 0 OR new$disk$name(new$name$index) = old$name(old$name$index); old$name$index = old$name$index + 1; for illegal conditions. */ IF L>6 OR /* name part too long */ L=0 OR /* null name part */ F$char>='0' and a$char<='9') or (a$char>='A' and a$char<='Z') ; end letter$or$digiuestion mark... */ IF CHAR='?' THEN DO; CALL PRINT$DOC; CALL EXIT; ENDDO; ENDIF /* If null com; ENDDO; ENDIF END CONSTRUCT$NEW$NAME; LEGIT$FILE$NAME: PROCEDURE (FILNAM$PTR) BOOLEAN; DECLARE FILNAM$PTR A /* null extension */ L-EXT$BEGIN > 3 ) /* extension too long */ TH new$name$index = new$name$index + 1; end move$and$bump; NEW$NAME$INDEX,OLD$NAME$INDEX = 0; DO WHILNAM(L)=COLON /* illegal colon terminator*/ THEN RETURN FALSE; ENDIF /* Scan extension, if any. */ It; /* check validity of explicit device designation, if any. */ IF FILNAM(0)=COLON THEN DO; IF NOT GOOD$EXPLImand tail...*/ IF CHAR=CR OR CHAR=ESCAPE OR (CHAR$PTR-.CI$BUF>=121) THEN CALL EXIT; ENDIF DDRESS; DECLARE FILNAM BASED FILNAM$PTR (100) BYTE; DECLARE L ADDRESS; good$explicit$device$spec: procedure boolean; EN RETURN FALSE; ENDIF ENDDO; ENDIF RETURN TRUE; END LEGIT$FILE$NAME; PARSE$COMMAILE (OLD$NAME(OLD$NAME$INDEX)<>DOT) AND NOT (ISIS$TERMINATOR(OLD$NAME(OLD$NAME$INDEX))); CALL MOVE$AND$BUMP; F FILNAM(L) = DOT THEN DO; DECLARE EXT$BEGIN ADDRESS; L = L + 1; EXT$BEGIN = L; CIT$DEVICE$SPEC THEN RETURN FALSE; ELSE FILNAM$PTR = FILNAM$PTR + 4; ENDIF EN /* If bad filename...*/ IF NOT LEGIT$FILENAME(CHAR$PTR) THEN CALL ERROR$EXIT; ENDIF /* If device explicitl return filnam(1)='F' and decimal$digit(filnam(2)) and filnam(3)=COLON ; ND$TAIL: PROCEDURE; CALL READ(CONSOLE$INPUT,.CI$BUF,SIZE(CI$BUF),.ACTUAL,.STATUS); CHK; CALL FORCUP(.CI$BUF,SIZE(CI$BUF) ENDDOWHILE; IF OLD$NAME(OLD$NAME$INDEX)=DOT THEN DO; OLD$NAME$INDEX = OLD$NAME$INDEX + 1; NEW$NAME$INDEX = 6DO WHILE LETTER$OR$DIGIT(FILNAM(L)); L = L + 1; ENDDOWHILE; IF (FILNAM(L) = DOT OR /* d      el system, or */ /* translated into any language or computer language, in any */ /* form or by any means, electron /* plm */ END$DO$CASE AS 'END', /* plm */ END$DO$WH                                                  /* char */ COMMA AS '02CH', /* plm */ CONSOLE$INPUT CHK; /* restore "format" attribute. */ CALL ATTRIB(.ISIS$LAB, FORMAT$ATTRIBUTE, SET,.STATUS); CHK; END RELMPERSAND AS '''&''', /* ??? */ BELL AS '07H', /* plm */  ENDDO; ELSE NAME$PART$PTR = CHAR$PTR; ENDIF END PARSE$COMMAND$TAIL; RELABEL$DISK: PROCEDURE; ic, mechanical, magnetic, */ /* optical, chemical, manual or otherwise, without the prior */ /* written permissio$ TITLE ('==> PASSIF -- REPORTMOD -- REPORT SUCCESS OR FAILURE <==') REPORT$MOD: DO; /*********************************** AS '1', /* open */ CONSOLE$OUTPUT AS '0', /* open */ ABEL$DISK; $ EJECT /********************************************************/ /* */ /* MAIN LINE CODE  BLANK AS '020H', /* plm */ BOOLEAN AS 'BYTE',  /* remove software write-protection. */ CALL ATTRIB(.ISIS$LAB,WRITE$PROTECT$ATTRIBUTE,RESET,.STATUS); CHK; CALL ATTRIB(.n of Intel Corporation, 3065 Bowers */ /* Avenue, Santa Clara, California, 95051, Attn: Software */ /* License A*************************************/ /* */ /* '(C) Intel Corporation 1981'. All rights reserved. No  CONTROL$Z AS '01AH', /* plm */ CR AS '0DH',  */ /* */ /********************************************************/ CALL SIGN$ON; CALL PARSE$COMMAND$TAIL;  /* plm */ CHK AS 'CALL CHECK$STATUS', /* plm */ CLEAR$CHAR AS '01CH', ISIS$LAB, FORMAT$ATTRIBUTE, RESET,.STATUS); CHK; /* alter isis.lab */ CALL OPEN(.AFTN,.ISIS$LAB,OPEN$FOR$UPDATE,NOdministration. */ /* */ /************************************************************************/  */ /* part of this program or publication may be reproduced, */ /* transmitted, transcribed, stored in a retriev /* plm */ DOT AS '''.''', /* char */ END$DO AS 'END', CALL CONSTRUCT$NEW$NAME; CALL RELABEL$DISK; CALL EXIT; END RELAB$MOD; EOF /* 1510 */ CO$ECHO$FILE AS '0F00H', /* open */ COLON AS ''':''', $LINE$EDIT,.STATUS); CHK; CALL WRITE(AFTN,.NEW$DISK$NAME,SIZE(NEW$DISK$NAME),.STATUS); CHK; CALL CLOSE(AFTN,.STATUS);  $ NOLIST /* LIT.INC */ DECLARE AS LITERALLY 'LITERALLY', /* plm */ A       SEEK$FORWARD$BY$N AS '3', /* seek */ SEEK$2$N AS '2', /* seek */ IO$CHK: PROCEDURE BYTE EXTERNAL; END IO$CHK; IO$DEF: PROCEDURE (WHICH$DEVICE,ENTRY$POINT) EXTERNAL; DECLARE WHICH$DE1', /* open */ OPEN$FOR$WRITE AS '2', /* open */ OPAL; END CI; CO: PROCEDURE (CHAR$CO) EXTERNAL; DECLARE CHAR$CO BYTE; END CO; CONSOL: PROCEDURE (CONSOLE$INPUT$F/* ??? */ FOREVER AS 'WHILE 1', /* plm */ FORMAT$ATTRIBUTE AS '3', /* a WRITE$PROTECT$ATTRIBUTE AS '2', /* attrib */ ZERO$BIAS AS '0' /* load ILE AS 'END', /* plm */ END$IF AS ' ', /* p SEMICOLON AS ''';''', /* plm */ SET AS '1', /* attrib */ STRING AS '(*) BYTE EN$FOR$UPDATE AS '3', /* open */ PUB$STRING AS '(*) BYTE PUBLIC DATA', /* plm */ RESET ASILE,CONSOL$OUTPUT$FILE,STATUS$CON) EXTERNAL; DECLARE (CONSOLE$INPUT$FILE,CONSOL$OUTPUT$FILE,STATUS$CON) ADDRESS; END CONSOLttrib */ HASH$MARK AS '''#''', /* plm */ INIT$STG AS '(*) BYTE INITIAL', /* plm */ LEAD$IN$CHA*/ ; /* ENDLIT.INC */ $ LIST $ NOLIST /* ISIS.INC */ ATTRIB: PROCEDURE(FILE$NAME$PTR,WHICH$ATlm */ END$ITERATED$DO AS 'END', /* plm */ END$LOOP AS ' ', /* plm DATA', /* plm */ TAB AS '09H', /* plm */ TRANSFER$CON '0', /* attrib */ RETURN$MARKER$POS AS '0', /* seek */ SEEK$2$EOF ; DELETE: PROCEDURE (FILE$NAME$PTR,STATUS) EXTERNAL; DECLARE (FILE$NAME$PTR,STATUS) ADDRESS; END DELETE; ERROR: PR AS '07EH', /*1510 */ LF AS '0AH', /* plm */ NO$LINE$EDIT TRIBUTE,SET$OR$RESET,STATUS$PTR) EXTERNAL; DECLARE (FILE$NAME$PTR,WHICH$ATTRIBUTE,SET$OR$RESET,STATUS$PTR) ADDRESS; END ATT*/ EOF$CHAR AS 'CONTROL$Z', /* plm */ ESC AS '01BH', TROL AS '1', /* load */ TRUE AS '0FFH', /* plm AS '4', /* seek */ SEEK$BACKWARD$BY$N AS '1', /* seek */ ROCEDURE (ERROR$NUMBER) EXTERNAL; DECLARE ERROR$NUMBER ADDRESS; END ERROR; EXIT: PROCEDURE EXTERNAL; END EXIT;  AS '0', /* open */ NULL AS '0FFFFH', /* ??? */ OPEN$FOR$READ AS 'RIB; CLOSE: PROCEDURE (AFTN,STATUS) EXTERNAL; DECLARE (AFTN,STATUS) ADDRESS; END CLOSE; CI: PROCEDURE BYTE EXTERN /* plm */ FALSE AS '0H', /* plm */ FF AS '0CH',  */ UNDERBAR AS '''_''', /* ??? */ USER$CI AS '0', /* ??? */       */ /************************************************************/ DECLARE MINIMUM$ACCEPTABLE$BANNER$LENGTH AS '7ON$CURSOR; MOVE: PROCEDURE (COUNT,SOURCE$PTR,DEST$PTR) EXTERNAL; DECLARE (COUNT,SOURCE$PTR,DEST$PTR) ADDRESS; END MOVE: PROCEDURE (FILE,BUFFER,STATUS) EXTERNAL; DECLARE (FILE,BUFFER,STATUS) ADDRESS; END SPATH; WHOCON: PROCEDURE (AFTN,RESS EXTERNAL, SECOND$OUTPUT$MSG$PTR ADDRESS EXTERNAL, STATUS ADDRESS EXTERNAL, TMP$FILE$AFTN ADDRESS EXTERNAL, ADDRESS; END OPEN; READ: PROCEDURE (AFTN,BUFFER,COUNT,ACTUAL,STATUS) EXTERNAL; DECLARE (AFTN,BUFFER,COUNT,ACTUAL,STATUUF (250) BYTE EXTERNAL, DELIMITER BYTE EXTERNAL, FIRST$BLOCK$BUF (128) BYTE EXTERNAL, FIRST$OUTPUT$MSG$PTR ADDRESVICE BYTE, ENTRY$POINT ADDRESS; END IO$DEF; IO$SET: PROCEDURE (CONFIGURATION$BYTE) EXTERNAL; DECLARE CONFIGURATION3', MAXIMUM$TOKEN$LENGTH AS '70', BI AS 'CALL BOMB$IF(STATUS)', FIRST$FIELD AS '0', SECONBUFFER) EXTERNAL; DECLARE (AFTN,BUFFER) ADDRESS; END WHOCON; WRITE: PROCEDURE (AFTN,BUFFER,COUNT,STATUS) EXTERNAL; D TMP$FILE$NAME (15) BYTE EXTERNAL, TOK$BUF (80) BYTE EXTERNAL; DECLARE KEY$WORDS (10) STRUCTURE (LENGTH S) ADDRESS; END READ; RENAME: PROCEDURE (OLD$NAME,NEW$NAME,STATUS$R) EXTERNAL; DECLARE (OLD$NAME,NEW$NAME,STATUS$R) ADS EXTERNAL, FIRST$TIME$THROUGH BOOLEAN EXTERNAL, INITIALIZED$BANNER (74) BYTE EXTERNAL, PRINT$HASH$MARK BOOLEAN E$BYTE BYTE; END IO$SET; LOAD: PROCEDURE (FILE,BIAS,CONTROL$OF$TRANSFER,ENTRY$POINT,STATUS) EXTERNAL; DECLARE (FILE,BIAD$FIELD AS '28', THIRD$FIELD AS '54', RIGHT$PARENTHESIS AS ''')''', LEFT$PARENTHESIS ASECLARE (AFTN,BUFFER,COUNT,STATUS) ADDRESS; END WRITE; /* END ISIS.INC */ $ NOLIST /********************************* BYTE, KEY$WORD (13) BYTE, PROC$PTR ADDRESS) EXTERNAL; CO$IS$VO: PROCEDURE BOOLEAN EXTERNAL; END CO$DRESS; END RENAME; RESCAN: PROCEDURE (AFTN,STATUS) EXTERNAL; DECLARE (AFTN,STATUS) ADDRESS; END RESCAN; SEEK:                  S,CONTROL$OF$TRANSFER,ENTRY$POINT,STATUS) ADDRESS; END LOAD; MEMCK: PROCEDURE ADDRESS EXTERNAL; END MEMCK; OPEN:  '''(''', RI AS 'CALL REPORT$IF', UNRECOGNIZED$SWITCH$ERR AS '201', QUESTION$MARK AS '''?''';***************************/ /* */ /* LITERALLY'S UNIQUE TO PASSIF */ /* IS$VO; EXIT$ROUTINE: PROCEDURE EXTERNAL; END EXIT$ROUTINE; RE$POSITION$CURSOR: PROCEDURE EXTERNAL; END RE$POSITIPROCEDURE (AFTN,MODE,BLOCKNO,BYTENO,STATUS) EXTERNAL; DECLARE (AFTN,MODE,BLOCKNO,BYTENO,STATUS) ADDRESS; END SEEK; SPATHXTERNAL, REPORT$FILE$ACTUAL ADDRESS EXTERNAL, REPORT$FILE$AFTN ADDRESS EXTERNAL, REPORT$FILE$STRING$BEGINNING ADD PROCEDURE(AFTN,FILENAME,ACCESS$MODE,LINE$EDIT$AFTN,ERROR) EXTERNAL; DECLARE (AFTN,FILENAME,ACCESS$MODE,LINE$EDIT$AFTN,ERROR)  $ LIST $ NOLIST /* MAIN.INC */ DECLARE ACTUAL ADDRESS EXTERNAL, AFTN ADDRESS EXTERNAL, COMMAND$TAIL$B      */ /* NOTES */ /* */ /**************************/ /* INITIALIZED "MODULE GLOBAL" VARIABLES */ /* */ /**************************************EXTERNAL; END INTERPRET$COMMAND$LINE; /* END CLI.INC */ $ LIST $ NOLIST /* FUNC.INC */ FILE$EXISTS: PROCEDURE  */ /************************************************************/ DECLARE HYPENS$STG STRING ('---- BYTE EXTERNAL, ZERO$LENGTH$FILE$MSG (40) BYTE EXTERNAL; /* END ERRMSG.INC */ $ LIST $ NOLIST /* CL entry" if they're not null. */ $ EJECT /************************************************************/ /* ; /* END MAIN.INC */ $ LIST $ NOLIST /* TOKENS.INC */ GET$ARGUMENT: PROCEDURE (BUF$PTR,STATUS$PTR) BYTE EXTERNAL;***********************************/ /* 1. Two types of string passing conventions are used: a. the UDI convention, anEXTERNAL; END FILE$EXISTS; FILE$ABSENT: PROCEDURE EXTERNAL; END FILE$ABSENT; FILES$MATCH: PROCEDURE EXTERNAL; ----------------------------------', '--------------------------------------', I.INC */ DECLARE BUF$COUNT BYTE EXTERNAL; UDI$STRING$MATCH: PROCEDURE (STG$1$PTR,STG$2$PTR) BOOLEAN EXTERNAL; DECL */ /* LITERALLY'S FOR THIS MODULE */ /* */ /******************************* DECLARE (BUF$PTR,STATUS$PTR) ADDRESS; END GET$ARGUMENT; /* END TOKENS.INC */ $ LIST $ NOLIST /* ERRMSG.INC */d b. the "terminated by a binary 0" kind 2. The procedures which report assertion failures with additional information wo END FILES$MATCH; STRING$FOUND: PROCEDURE EXTERNAL; END STRING$FOUND; STRING$ABSENT: PROCEDURE EXTERNAL; END  CR,LF,CR,LF); DECLARE TEST$STG STRING ('test '), FAILED$STG STRING (' failed'), CIARE (STG$1$PTR,STG$2$PTR) ADDRESS; END UDI$STRING$MATCH; ENFORCE$DELIMITER: PROCEDURE(ENFORCEE) EXTERNAL; DECLARE ENFO*****************************/ DECLARE MAX$ENTRY$LINE$LENGTH AS '71'; $ EJECT /******************************* DECLARE BAD$SYNTAX$MSG (29) BYTE EXTERNAL, BOMB$IF$MSG$1 (12) BYTE EXTERNAL, BOMB$IF$MSG$2 (40)rk by preparing UDI-style message strings, setting pointers to them, then calling the vanilla "report$assertion$failure". STRING$ABSENT; /* END FUNC.INC */ $ LIST $ EJECT /************************************************************/ /* $STG STRING (' :CI:='); /************************************************************/ /* RCEE BYTE; END ENFORCE$DELIMITER; NEXT$ARG: PROCEDURE EXTERNAL; END NEXT$ARG; INTERPRET$COMMAND$LINE: PROCEDURE *****************************/ /* */ /* MODULE GLOBALS */ /*  BYTE EXTERNAL, DURING$ASSERTION$CHECK$MSG (50) BYTE EXTERNAL, PASSIF$INVOKED$BY$MSG (19)  In the course of its operation, report$assertion$failure will insert these prepared messages into the "failed assertion      /*source*/ .TMP$BUF(5-BUF(0)), /*destination*/ .BUF(1)); END NUM$OUT; HEXADECIMAL$DIGIT: PROCEDURE (A$CHAR) B CALL CO(NUM$OUT$BUF(T)); END$ITERATED$DO; /* Print out part two of the message. */ a six-byte buffer as a parameter. Numout places the "width" of the number in the first byte of the buffer, and the ascii NUM$LEN BYTE; IF STATUS<>0 THEN DO; /* First print the message to the cold boot console. */ CAL is, one terminated by a binary zero. */ DECLARE OLD$STYLE$MSG$PTR ADDRESS, OLD$STYLE$MSG BASED OLD$STYLE$MSG$Purse of processing the error reporting file. Such an error can not rationally be reported in the error repor**********************/ DECLARE ZERO$VAL ADDRESS DATA (0); DECLARE FOUR$SPACES STRING (' '); DECLARE CRLF STRING ('CR,LFOOLEAN; DECLARE A$CHAR BYTE; RETURN (A$CHAR>='0' AND A$CHAR<='9') OR (A$CHAR>='A' AND A$CHAR<='F'); END HEXADexpansion of the number in the next 1 to 5 bytes. */ BUF(0) = 1; U = 4; loop$begin: TMP$BUF(U) = (ERR$NUM MOD 10L RE$POSITION$CURSOR; CALL NUM$OUT(STATUS,.NUM$OUT$BUF); /* Print out part one of the message. */ TR (1000) BYTE; DECLARE V BYTE; V = 0; DO WHILE (OLD$STYLE$MSG(V)<>0) AND V<255; V = V + 1; END$DO$WHILE; t file, since it was the process of updating said file which caused the problem; therefore, under such circums'); /************************************************************/ /* */ /* THE "REPORTING" PROECIMAL$DIGIT; $ EJECT /************************************************************/ /* */ /* ) + '0'; ERR$NUM = ERR$NUM / 10; IF ERR$NUM<>0 THEN DO; U = U - 1;  DO T=1 TO MSG$LENGTH(.BOMB$IF$MSG$1); CALL CO(BOMB$IF$MSG$1(T)); END$ITERATED$DO;  RETURN V; END MSG$LENGTH; NUM$OUT: PROCEDURE (ERR$NUM,BUF$PTR); DECLARE (ERR$NUM,BUF$PTR) ADDRESS; DECLARE BUF tances, Passif prints the "bomb$if" error message to the console output, and to the cold boot console, and exits. CEDURES */ /* */ /************************************************************/ MSG$LENGTH:  BOMB$IF */ /* */ /********************************************************* BUF(0) = BUF(0) + 1; GOTO loop$begin; ENDDO; ENDIF end$loop CALL MOVE(/*count*/ BUF(0),  /* Print out the error number. */ NUM$LEN = NUM$OUT$BUF(0); DO T=1 TO NUM$LEN; BASED BUF$PTR (6) BYTE; DECLARE TMP$BUF (5) BYTE; DECLARE U BYTE; /* This version of numout requires a pointer to  */ DECLARE STATUS ADDRESS; DECLARE T BYTE; DECLARE TMP$STATUS ADDRESS; DECLARE NUM$OUT$BUF (6) BYTE; DECLARE  PROCEDURE (OLD$STYLE$MSG$PTR) BYTE PUBLIC; /* This procedure is for assessing the length of an "old" style string; that***/ BOMB$IF: PROCEDURE (STATUS) PUBLIC; /* This procedure is called if an Isis error is encountered in the co     F; loop$begin: IF UN$WRITTEN$BYTES > MAX$ENTRY$LINE$LENGTH THEN COUNT$FOR$THIS$LINE = MAX$ENTRY$LINE$LENG 13517 TESTS EXECUTED 13499 TESTS PASSED 00018 TESTS FAILED */ $ EJECT /******************************S); BI; END INDENT; $ EJECT /************************************************************/ /* */ /*  RETURN FIVE$ASCII$HEXADECIMAL$DIGITS(.FIRST$BLOCK$BUF(FIRST$FIELD)) AND FIVE$ASCII$HEXADECIMAL$D                FTN,.(HASH$MARK),1,.STATUS); BI; ENDIF END WRITE$OUT$COMMAND$TAIL; FIVE$ASCII$HEXADECIMAL$DIGITS: PROCEDURE (DDO T=1 TO MSG$LENGTH(.BOMB$IF$MSG$2); CALL CO(BOMB$IF$MSG$2(T)); END$ITERATED$DO; /TH; ELSE COUNT$FOR$THIS$LINE = UN$WRITTEN$BYTES; ENDIF UN$WRITTEN$BYTES = UN$WRITTEN$BYTES - CO WRITE$OUT$COMMAND$TAIL */ /* */ /*********************************************IGITS(.FIRST$BLOCK$BUF(SECOND$FIELD)) AND FIVE$ASCII$HEXADECIMAL$DIGITS(.FIRST$BLOCK$BUF(THIRD$FIELD)); ENMSG$2),.TMP$STATUS); CALL WRITE(CONSOLE$OUTPUT,.CRLF,SIZE(CRLF),.TMP$STATUS); CALL EXIT; ENDDO; IG$PTR) BOOLEAN; DECLARE DIG$PTR ADDRESS, DIG BASED DIG$PTR (5) BYTE; DECLARE M BYTE; DO M = 0 TO 4; IF NOT* Now print the message to the console output. */ CALL WRITE(CONSOLE$OUTPUT,.BOMB$IF$MSG$1, MUNT$FOR$THIS$LINE; CALL INDENT; CALL WRITE(REPORT$FILE$AFTN,BUF$PTR,COUNT$FOR$THIS$LINE,.STATUS); BI; ***************/ WRITE$OUT$COMMAND$TAIL: PROCEDURE; DECLARE UN$WRITTEN$BYTES BYTE; DECLARE COUNT$FOR$THIS$LINE BYTE; DDO; ELSE RETURN FALSE; ENDIF END BANNER$IS$LEGIT; /* The following is a typical banner. 0 1 2 ENDIF END BOMB$IF; EOL: PROCEDURE; CALL WRITE(REPORT$FILE$AFTN,.(CR,LF),2,.STATUS); BI; END EO HEXADECIMAL$DIGIT(DIG(M)) THEN RETURN FALSE; ENDIF END$ITERATED$DO; RETURN TRUE; END FIVE$ASCII$HEXADSG$LENGTH(.BOMB$IF$MSG$1),.TMP$STATUS); CALL WRITE(CONSOLE$OUTPUT,.NUM$OUT$BUF(1),NUM$OUT$BUF(0),  IF UN$WRITTEN$BYTES > 0 THEN DO; BUF$PTR = BUF$PTR + COUNT$FOR$THIS$LINE; CALL EOL;  DECLARE BUF$PTR ADDRESS, BUF BASED BUF$PTR (100) BYTE; UNWRITTEN$BYTES = BUF$COUNT; BUF$PTR = .COMMAND$TAIL$BU 3 4 5 6 7 0123456789012345678901234567890123456789012345678901234567890123456789012345L; INDENT: PROCEDURE; /* Indent 4 spaces. */ CALL WRITE(REPORT$FILE$AFTN,.FOUR$SPACES,SIZE(FOUR$SPACES),.STATUECIMAL$DIGITS; BANNER$IS$LEGIT: PROCEDURE BOOLEAN; IF REPORT$FILE$ACTUAL >= SIZE(INITIALIZED$BANNER) THEN DO;  .TMP$STATUS); CALL WRITE(CONSOLE$OUTPUT,.BOMB$IF$MSG$2, MSG$LENGTH(.BOMB$IF$ GOTO loop$begin; ENDDO; ENDIF end$loop IF PRINT$HASH$MARK THEN CALL WRITE(REPORT$FILE$A     ying$loop: CALL READ(REPORT$FILE$AFTN,.STATIC$BUF,SIZE(STATIC$BUF), .ACTUAL,.STATUS); , .REPORT$FILE$ACTUAL,.STATUS); BI; IF NOT BANNER$IS$LEGIT THEN DO;  CALL OPEN(.TMP$FILE$AFTN,.TMP$FILE$NAME,OPEN$FOR$UPDATE,NO$LINE$EDIT, .STATUS); BI; PORT$FILE; $ EJECT /************************************************************/ /* */ /* ICE$TYPE BYTE, DRIVE$TYPE BYTE); /* First, ascertain correct device for temporary file, rage locations, what was the temporary file will be the report file, but both the ascii filename and t******************************/ /* */ /* READ$IN$AND$QA$REPORT$FILE */ /* BI; CALL WRITE(TMP$FILE$AFTN,.STATIC$BUF,ACTUAL,.STATUS); BI; IF ACTUAL = SIZE(STATIC$BUF) THEN  /* Write out an initialized banner. */ CALL WRITE(TMP$FILE$AFTN,.INITIALIZED$BANNER, S FIRST EXECUTABLE IN READ$IN$AND$QA$REPORT$FILE */ /* */ /**************************************** and open it. */ CALL SPATH(REPORT$FILE$STRING$BEGINNING,.FILE$INFORMATION,.STATUS); BI; TMP$FILE$NAMEhe report$file$aftn will be correct. */ CALL CLOSE(REPORT$FILE$AFTN,.STATUS); BI; CALL DELETE(REPORT */ /************************************************************/ READ$IN$AND$QA$REPORT$FILE: PROCEDURE; RE$ GOTO begin$copying$loop; ENDIF end$loop /* Close report file, rename the temporary file, reasIZE(INITIALIZED$BANNER),.STATUS); /* Now, write out the rest of the file, first seeking back to the begi********************/ CALL OPEN(.REPORT$FILE$AFTN, REPORT$FILE$STRING$BEGINNING, OPEN$FOR$UP(2) = FILE$INFORMATION.DEVICE$NUMBER + '0'; /* The temporary file must be opened in update mode, since it may $FILE$STRING$BEGINNING,.STATUS); BI; CALL RENAME(.TMP$FILE$NAME,REPORT$FILE$STRING$BEGINNING,.STATUS); BI; REPORT$FIINITIALIZE$REPORT$FILE: PROCEDURE; DECLARE STATIC$BUF (128) BYTE; DECLARE FILE$INFORMATION STRUCTURE sign the report$file$aftn, and seek back to the beginning. We have to seek back to the beginning, becnning of the report file. */ CALL SEEK(REPORT$FILE$AFTN,SEEK$2$N,.ZERO$VAL,.ZERO$VAL,.STATUS); BI; begin$copDATE,NO$LINE$EDIT,.STATUS); BI; loop$begin: CALL READ(REPORT$FILE$AFTN,.FIRST$BLOCK$BUF(0),SIZE(FIRST$BLOCK$BUF) become the report file; and it is crucial for the report file to be readable from, and writeable to. */ LE$AFTN = TMP$FILE$AFTN; CALL SEEK(REPORT$FILE$AFTN,SEEK$2$N,.ZERO$VAL,.ZERO$VAL,.STATUS); END RE$INITIALIZE$RE (DEVICE$NUMBER BYTE, FILE$NAME (6) BYTE, EXTENSION (3) BYTE, DEVause that's what the calling procedure expects. The result of all this is that, in terms of disk sto     $MATTER ADDRESS; DECLARE CI$BUF (20) BYTE; DECLARE Q BYTE; DECLARE W BYTE; /************************************ESS; /* Write out the "test" string. */ CALL WRITE(AN$AFTN,.TEST$STG,SIZE(TEST$STG),.STATUS); BI; ENT$ASCII(.FIRST$BLOCK$BUF(FIRST$FIELD)); CALL INCREMENT$ASCII(.FIRST$BLOCK$BUF(SECOND$FIELD)); CALL WRITE$OUT$FIRST$BRE; /* Write out :ci: file designation. */ /* Calculate how many bytes to write by finding the blank which  DO N = 0 TO 4; FIELD(N) = '9'; END$ITERATED$DO; ENDIF ENDDO; ELSE FIELDhat the first byte of the string is part of the string, and the string is terminated by a binary 0. This pr CALL RE$INITIALIZE$REPORT$FILE; GOTO loop$begin; ENDDO; ENDIF end$loop ************************/ /* */ /* PROCEDURES LOCAL TO REPORT$ASSERTION$FAILURE */ /* LOCK$BUF; CALL EXIT$ROUTINE; END REPORT$ASSERTION$SUCCESS; $ EJECT /********************************************** terminates the filename string. */ CALL WHO$CON(CONSOLE$INPUT,.CI$BUF); Q = 0; DO WHILE CI(N) = FIELD(N) + 1; ENDIF END INCREMENT$ASCII; WRITE$OUT$FIRST$BLOCK$BUF: PROCEDURE; CALL SEEK(REPORT$FILE$AFTN,Socedure assumes that the strings passed to it will fit on a single line. */ IF MSG$PTR <> NULL THEN END READ$IN$AND$QA$REPORT$FILE; INCREMENT$ASCII: PROCEDURE (FIELD$PTR); DECLARE FIELD$PTR ADDRESS, FIELD BASED FIEL */ /************************************************************/ INSERT$MSG: PROCEDURE (MSG$PTR)**************/ /* */ /* REPORT$ASSERTION$FAILURE */ /* */ /****$BUF(Q) <> BLANK; Q = Q + 1; ENDDOWHILE; CALL WRITE(REPORT$FILE$AFTN,.CI$BUF,Q,.STATUS); BI; EEK$2$N,.ZERO$VAL,.ZERO$VAL,.STATUS); BI; CALL WRITE(REPORT$FILE$AFTN,.FIRST$BLOCK$BUF,REPORT$FILE$ACTUAL,.STATUS); BI; END  DO; CALL EOL; CALL INDENT; CALL WRITE(REPORT$FILE$AFTN, D$PTR (5) BYTE, N BYTE; N = 4; loop$begin: IF FIELD(N)='9' THEN DO; IF N<>0 THEN DO; F          ********************************************************/ REPORT$ASSERTION$FAILURE: PROCEDURE PUBLIC; DECLARE DOESNT END WRITE$CI$FILE; WRITE$OUT$TEST$FAILURE$NUMBER: PROCEDURE (AN$AFTN); DECLARE AN$AFTN ADDR WRITE$OUT$FIRST$BLOCK$BUF; REPORT$ASSERTION$SUCCESS: PROCEDURE PUBLIC; CALL READ$IN$AND$QA$REPORT$FILE; CALL INCREM MSG$PTR,MSG$LENGTH(MSG$PTR),.STATUS); BI; ENDDO; ENDIF END INSERT$MSG; WRITE$CI$FILE: PROCEDUIELD(N) = '0'; N = N - 1; GOTO loop$begin; ENDDO; ELSE ; DECLARE MSG$PTR ADDRESS; /* The strings passed to this procedure are of the "other" type, meaning t      CALL WRITE(REPORT$FILE$AFTN,.HYPENS$STG,SIZE(HYPENS$STG),.STATUS); BI; CALL WRITE$OUT$TEST$FAILURE$NUMBER (REPORT$FILE$AFTNlled, but some global strings which are concatenated to produce a larger string which becomes an error message. */  /************************************************************/ CALL READ$IN$AND$QA$REPORT$FILE; CALL INCREMENT$ASN$FAILURE$W$MSG; $ EJECT /************************************************************/ /* */ /* R,LF); CALL WRITE (CONSOLE$OUTPUT,.FIRST$MESSAGE,SIZE(FIRST$MESSAGE),.STATUS); BI; CALL WRITE$OUT$TCALL EOL; END$ITERATED$DO; CALL EXIT$ROUTINE; END REPORT$ASSERTION$FAILURE; $ EJECT REPORT$SYNTAX$ERRO /* Write out the ordinal number of the test which failed. */ CALL WRITE(AN$AFTN,.FIRST$BLOCK$BUF(0),5,.STATUS); BI; ); CALL WRITE(REPORT$FILE$AFTN,.CI$STG,SIZE(CI$STG),.STATUS); BI; IF NOT CO$IS$VO THEN CALL WRITE$FAILURE$NUMBER$ICII(.FIRST$BLOCK$BUF(FIRST$FIELD)); CALL INCREMENT$ASCII(.FIRST$BLOCK$BUF(THIRD$FIELD)); CALL WRITE$OUT$FIRST$BLOCK$BU REPORT$ASSERTION$FAILURE$W$ISIS$ERR */ /* */ /******************************************************EST$FAILURE$NUMBER (CONSOLE$OUTPUT); CALL WRITE (CONSOLE$OUTPUT,.SECOND$MESSAGE,SIZE(SECOND$MESSAGE),.STATUS);R: PROCEDURE PUBLIC; FIRST$OUTPUT$MSG$PTR = .BAD$SYNTAX$MSG; PRINT$HASH$MARK = TRUE; CALL REPORT$ASSERTION$FAILURE /* Write out the "failed" string. */ CALL WRITE(AN$AFTN,.FAILED$STG,SIZE(FAILED$STG),.STATUS); BI; N$CO$FILE; ENDIF CALL WRITE$CI$FILE; CALL EOL; /* Write out the first message, if any. */ CALL INSERT$MSGF; /* Now, seek to the end of the file. */ CALL SEEK (REPORT$FILE$AFTN,SEEK$2$EOF,.DOESNT$MATTER,.DOESNT$MATT******/ REPORT$ASSERTION$FAILURE$W$ISIS$ERR: PROCEDURE (STATUS) PUBLIC; /* This procedure accepts as input, and deliver BI; END WRITE$FAILURE$NUMBER$IN$CO$FILE; $ EJECT /******************************************************; END REPORT$SYNTAX$ERROR; REPORT$ASSERTION$FAILURE$W$MSG: PROCEDURE (OLD$STYLE$MSG$PTR) PUBLIC; DECLARE OLD$STY END WRITE$OUT$TEST$FAILURE$NUMBER; WRITE$FAILURE$NUMBER$IN$CO$FILE: PROCEDURE; DECLARE FIRST$MESSAG(FIRST$OUTPUT$MSG$PTR); CALL EOL; CALL WRITE$OUT$COMMAND$TAIL; /* Write out the second message, if any. */ CALL IER,.STATUS); BI; /* Write out the long row of hyphens which separates the "failed assertion entry reports. */ s as output, "delimited" strings. Input, as specified above, does not mean the parameter with which this procedure was ca******/ /* */ /* FIRST EXECUTABLE IN PROCEDURE REPORT$ASSERTION$FAILURE */ /* */ LE$MSG$PTR ADDRESS; SECOND$OUTPUT$MSG$PTR = OLD$STYLE$MSG$PTR; CALL REPORT$ASSERTION$FAILURE; END REPORT$ASSERTIOE STRING (CR,LF,CR,LF,' ====> '), SECOND$MESSAGE STRING (' <====',CR,LF,CNSERT$MSG(SECOND$OUTPUT$MSG$PTR); /* Add blank lines at bottom of "assertion failure report entry". */ DO W=1 TO 2;      ASSERTION$FAILURE$W$ISIS$ERR; REPORT$ISIS$ERROR: PROCEDURE (STATUS) PUBLIC; DECLARE STATUS ADDRESS; IF STATUS<>0 THEN  query the keyboard CI ( not :CI: ) for a * response. If the response is an escape ( ESC ) then the submit file * is restar1,MSG$LENGTH(.BOMB$IF$MSG$1)); CALL NUM$OUT(STATUS,.ASCII$NUM$BUF); CALL LOAD$MSG$BUF(.ASCII$NUM$BUF(1),ASCII$NUM$BUF(**************************************************/ DECLARE COPYRIGHT (*) BYTE DATA ('(C) INTEL CORP 1981'); DECLARE PROGRount*/ COUNT, /*source*/ SOURCE$PTR, /*dest*/ .MSG$BUF(FIRST$FREE$BYTE)); FIRST$FR* transmitted, transcribed, stored in a retrievel system, or */ /* translated into any language or computer language DECLARE STATUS ADDRESS; DECLARE MSG$BUF (256) BYTE; DECLARE FIRST$FREE$BYTE ADDRESS; DECLARE ASCII$NUM$BUF (6) CALL REPORT$ASSERTION$FAILURE$W$ISIS$ERR(STATUS); ENDIF END REPORT$ISIS$ERROR; END REPORT$MOD; 0)); CALL LOAD$MSG$BUF(.DURING$ASSERTION$CHECK$MSG, MSG$LENGTH(.DURING$ASSERTION$CHECK$MSG)); /*AM$VERSION$NUMBER$STRING (*) BYTE DATA ('program_version_number=V1.0',0); /*********************************************EE$BYTE = FIRST$FREE$BYTE + COUNT; END LOAD$MSG$BUF; /********************************************************, in any */ /* form or by any means, electronic, mechanical, magnetic, */ /* optical, chemical, manual or otherwi BYTE; /************************************************************/ /* */ /* PROCEDURES LOCAL T      Delimit the output string. */ CALL LOAD$MSG$BUF(.ZERO$VAL,SIZE(ZERO$VAL)); FIRST$OUTPUT$MSG$PTR = .PASSIF$INVOKED$********************************** * * This program is designed to allow the restarting of a submit file * at any line wit****/ /* */ /* FIRST EXECUTABLE IN REPORT$ASSERTION$FAILURE$W$ISIS$ERR */ /* */ se, without the prior */ /* written permission of Intel Corporation, 3065 Bowers */ /* Avenue, Santa Clara, CalifO REPORT$ASSERTION$FAILURE$W$ISIS$ERR */ /* */ /*******************************************************RESCAN: DO; /************************************************************************/ /* */ /* '(C)BY$MSG; SECOND$OUTPUT$MSG$PTR = .MSG$BUF; PRINT$HASH$MARK = TRUE; CALL REPORT$ASSERTION$FAILURE; END REPORT$hin the .CS file. * * the action performed by this program is to copy the .CS file, line-by-line, * to CO ( not :CO: ) and /************************************************************/ FIRST$FREE$BYTE = 0; CALL LOAD$MSG$BUF(.BOMB$IF$MSG$ornia, 95051, Attn: Software */ /* License Administration. */ /* */ /***************************/ LOAD$MSG$BUF: PROCEDURE (SOURCE$PTR,COUNT); DECLARE (SOURCE$PTR,COUNT) ADDRESS; CALL MOVE(/*c Intel Corporation 1981'. All rights reserved. No */ /* part of this program or publication may be reproduced, */ /     ecl (INFILE,OUTFILE,STATUS) address; end; ERROR: procedure(ERRNUM) external; decl ERRNUM address; end; EXIT: procedu backward mode */ , .zero$blocks , .actual , .STATUS  BUFFER, LEN, ACTUAL, STATUS ) external; decl (AFTN,BUFFER,LEN,ACTUAL,STATUS) address; end; WRITE: procedure( AFTN, BUFFfile and writes to screen */ call WRITE(0, .('#'), 1 , .STATUS ); call FERR(STATUS); call READ( 1, .LINE, 128, .ACTUnly used literallys */ declare decl literally 'declare'; declare as literally 'literally'; decl pointer as 'addr decl ZERO$BLOCKS address data (0); /* main line code */ /* read command line for input file name */ call READ( 1, .LINEted at the currently displayed line. If the response is * a control C character (control$C) command is given to the cold starre external; end; SEEK: PROCEDURE (AFT,MODE,BLOCKNUM,BYTENUM,STATUS) EXTERNAL; DECLARE (AFT,MODE,BLOCKNUM,BYTENUM,ER , COUNT , STATUS ) external; decl (AFTN,BUFFER,COUNT,STATUS) address; end; CI: procedure character external; end;AL, .STATUS ); call FERR(STATUS); /* query the keyboard */ IGNORE: CHAR = CI and 7FH; if CHAR = TILDA then goess'; decl boolean as 'byte'; decl character as 'byte'; decl int1 as 'byte'; decl int2 as 'address'; decl , 128, .ACTUAL, .STATUS ); call FERR(STATUS); /* tests for non-zero status; /* scan for first non-blank character in line */t * console and the program exited. If the response is any other character, * the next line of the file will be printed ( eSTATUS) ADDRESS; END SEEK; FERR: procedure(STATUS); decl STATUS int2; /* exit if error (status <> 0) */ if  CO: procedure( CHAR ) external; decl CHAR character; end; IOCHK: procedure byte external; end; RESCAN: procedure to IGNORE; /* ignore tilda characters */ /* test for action */ if CHAR = ESC then do; /* start file from thitrue as '0FFH'; decl false as '0'; decl nil as '0'; decl FOREVER as 'while true'; decl ESC as '1BH'; decl  I = 0; do while LINE(I) = ' ' and I < 127; I = I + 1; end; /* use the input file as the current console device */ caxcept for tilda ). * Due to the way ISIS handles the console device, reaching the end of the * file will cause an ISIS errorSTATUS <> 0 then do; call ERROR(STATUS); call EXIT; end; end FERR; /* global declarations */ decl LI( AFTN, STATUS ) external; decl (AFTN,STATUS) address; end; CONSOL: procedure( INFILE, OUTFILE, STATUS ) external; ds point */ /* position to beginning of line */ call SEEK(1 /* seek on console input */ , 1 /* seekcontrol$C as '03H'; decl TILDA as '7FH'; decl CONSOLE$MASK as '03H'; /* system externals */ READ: procedure( AFTN,ll CONSOL( .LINE(I), .(':CO: '), .STATUS); call FERR(STATUS); /* main control loop */ do FOREVER; /* reads console  29 with a subsequent reboot. * *******************************************************************************/ /* commoNE(128) character; /* input and display line */ decl I int1; decl CHAR character; decl (STATUS,ACTUAL) address;      *****************************************************/ DECLARE COPYRIGHT (*) BYTE DATA ('(C) INTEL CORP 1981'); DECLARE PRAND (BYTENO = EOF$BYTENO - 1) THENDO CALL SEEK (1, 2, .LAST$BLOCKNO, .LAST$BYTENO, .STATUS); CALL EXIT; IFEND; LAST$BL /* transmitted, transcribed, stored in a retrievel system, or */ /* translated into any language or computer languIT; IFEND; CALL SEEK (1, 4, .EOF$BLOCKNO, .EOF$BYTENO, .STATUS); /* Seek to EOF. */ CALL SEEK (1, 0, .EOF$BLOCKNO, .EOF$BYTEN end; end; end RESCAN; TE: PROC (A,B,C,D) EXTERNAL; DCL (A,B,C,D) ADDRESS; PROCEND; SEEK: PROC (A,B,C,D,E) EXTERNAL; DCL (A,B,C,D,E) ADDRESS; PROCEND ); call EXIT; end; else if CHAR = control$C then do; /* return to cold start console */ I = IOCOGRAM$VERSION$NUMBER$STRING (*) BYTE DATA ('program_version_number=V1.0',0); DECLARE LIT LITERALLY 'LITERALLY', DCL age, in any */ /* form or by any means, electronic, mechanical, magnetic, */ /* optical, chemical, manual or otheO, .STATUS); CALL SEEK (1, 2, .CUR$BLOCKNO, .CUR$BYTENO, .STATUS); /* Back up. */ LAST$BLOCKNO = CUR$BLOCKNO; LAST$BYTENO = C     ; DCL (STATUS, ACTUAL) ADDRESS; DCL (CUR$BLOCKNO, CUR$BYTENO, EOF$BLOCKNO, EOF$BYTENO) ADDRESS; DCL (LAST$BLOCKNO, LAST$BYTHK; /* get current device flags */ if ( I and CONSOLE$MASK ) <> 0 then do; /* console is :VI: */ call CONSOL( . LIT 'DECLARE', TRUE LIT '0FFH', FALSE LIT '000H', PROC LIT 'PROCEDURE', PROCEND LIT 'END', THENDO LIT 'THEN DO;'rwise, without the prior */ /* written permission of Intel Corporation, 3065 Bowers */ /* Avenue, Santa Clara, CaUR$BYTENO; DO WHILE TRUE; CALL WRITE (0, .('#'), 1, .STATUS); CALL READ (1, .MEMORY, 128, .ACTUAL, .STATUS); IF (STATUS <RETURN$MOD: DO; /************************************************************************/ /* */ /* 'ENO, BLOCKNO, BYTENO) ADDRESS; CALL READ (1, .MEMORY, 128, .ACTUAL, .STATUS); /* Skip command tail. */ CALL SEEK (1, 0, .CUR(':VI: '), .(':CO: '), .STATUS ); call FERR(STATUS); call EXIT; end; else do; /* console is :T, ELSEIF LIT 'END; ELSE IF', ELSEDO LIT 'END; ELSE DO;', IFEND LIT 'END', WHILEND LIT 'END', CR LIT '0DH', LFlifornia, 95051, Attn: Software */ /* License Administration. */ /* */ /*******************> 0) OR (ACTUAL = 0) THENDO CALL EXIT; IFEND; CALL SEEK (1, 0, .BLOCKNO, .BYTENO, .STATUS); IF (BLOCKNO = EOF$BLOCKNO) (C) Intel Corporation 1981'. All rights reserved. No */ /* part of this program or publication may be reproduced, */$BLOCKNO, .CUR$BYTENO, .STATUS); /* Current point. */ IF STATUS <> 0 THENDO /* Can't seek, probably not in submit. */ CALL EXI: */ call CONSOL( .(':TI: '), .(':CO: '), .STATUS ); call FERR(STATUS); call EXIT; end;  LIT '0AH'; EXIT: PROC EXTERNAL; PROCEND; READ: PROC (A,B,C,D,E) EXTERNAL; DCL (A,B,C,D,E) ADDRESS; PROCEND; WRI     C) Intel Corporation 1981'. All rights reserved. No */ /* part of this program or publication may be reproduced, */  READ$FIELD: PROCEDURE; J=0; DO WHILE BUF(BPTR)NINE; IF (BUF(BPTR)=CR) THEN RETURN; BSEQ1: LDAX B CMP M JZ SEQ3 ; chars equal SEQ2: XRA A RET SEQ3: INX B INX H INR E JNZ SEQ1 INR D JNZ SEQ1 MVTE, CONT BYTE, (I,J) ADDRESS, BPTR BYTE, BUF(30) BYTE; DECLARE TRUE LITERALLY '0FFH', FALSE Lny ; form or by any means, electronic, mechanical, magnetic, ; optical, chemical, manual or otherwise, without the p****************************************************/ DECLARE COPYRIGHT (*) BYTE DATA ('(C) INTEL CORP 1981'); DECOCKNO = BLOCKNO; LAST$BYTENO = BYTENO; WHILEND; END RETURN$MOD;  /* transmitted, transcribed, stored in a retrievel system, or */ /* translated into any language or computer languaI A,0FFH RET END ITERALLY '0', CR LITERALLY '0DH', LF LITERALLY '0AH', ZERO LITERALLY '30H', TOP$OF$MEMORY LITERALLY '60000',rior ; written permission of Intel Corporation, 3065 Bowers ; Avenue, Santa Clara, California, 95051, Attn: SoftwareLARE PROGRAM$VERSION$NUMBER$STRING (*) BYTE DATA ('program_version_number=V1.0',0); DECLARE (CHAR$SIZE,ITEM  ge, in any */ /* form or by any means, electronic, mechanical, magnetic, */ /* optical, chemical, manual or other             NINE LITERALLY '39H', ALL LITERALLY '30', CI LITERALLY '1', CO LITERALLY '0'; $INCLUDE(:F1:ERROR.PEX) $ ; License Administration. NAME SEQ CSEG PUBLIC SEQ SEQ: ; SEQ (STR1, STR2, COUNT) BYTE; POP H XTHL ; HL := s$SIZE) ADDRESS, CHARS(1) BYTE AT (.MEMORY), ITEM$PTR ADDRESS, ITEM BASED ITEM$PTR (1) ADDRESS, NF BYTE, ; '(C) Intel Corporation 1981'. All rights reserved. No ; part of this program or publication may be reproduced, ;wise, without the prior */ /* written permission of Intel Corporation, 3065 Bowers */ /* Avenue, Santa Clara, CalSORT: DO; /************************************************************************/ /* */ /* '(INCLUDE(:F1:EXIT.PEX) $INCLUDE(:F1:READ.PEX) $INCLUDE(:F1:WRITE.PEX) $INCLUDE(:F1:CLOSE.PEX) $INCLUDE(:F1:OPEN.PEX) tr1 XRA A SUB E MOV E,A MVI A,0 SBB D MOV D,A ORA E ; set Z flag if zero MVI A,0FFH ; true if count = 0 RZ  FIELD(10) STRUCTURE( FIRST ADDRESS, LAST ADDRESS), (CC,NR,NI,AFTN,AFTN2,STATUS) ADDRESS, WORKING BY transmitted, transcribed, stored in a retrievel system, or ; translated into any language or computer language, in aifornia, 95051, Attn: Software */ /* License Administration. */ /* */ /********************     LCULATE T */ T=0; S=1; DO WHILE T=0; IF HA(S+2)>NI THEN T=S; S=S+1; END; /* LOOP ON S */ WO NUMBERS SEPARATED BY BLANKS AND/OR A COMMA. LET THE CHARACTER @ BE CARRIAGE RETURN, 'END' MEAN THAT NO MORE PROMDDRESS, T1 BYTE; COMPARE: PROCEDURE(S1P,S2P) BYTE; DECLARE (S1P,S2P) ADDRESS, S1 BASED S1P(1) BYTEPTR)/2; CALL WRITE(CO,.('CONTINUATION CHARACTER (CR IF NONE):'),36,.STATUS); CALL READ(CI,.BUF,ALL,.I,.STATUS); IF BUF(ND$EOL; J=CC-ITEM(I); CALL WRITE(AFTN2,.CHARS(ITEM(I)),J,.STATUS); END WRYTE; STAT: PROCEDURE(STATUS); Y-.MEMORY; CALL READ(CI,.BUF,ALL,.NR,.STATUS); CALL STAT(STATUS); CALL OPEN(.AFTN,.BUF,1,0,.STATUS); CALL STAT(STATUPTR=BPTR+1; IF BPTR>=30 THEN RETURN; END; DO WHILE BUF(BPTR)>=ZERO AND BUF(BPTR)<=NINE; J=J*10+(BUF(BP S=T; D1: DO WHILE S>0; H=HA(S); J=H; D2: DO WHILE J<=NI; I=J; K=ITEM(J); D3: DO W, S2 BASED S2P(1) BYTE, (I,J) ADDRESS, (T1,T2) BYTE; D1: DO J=0 TO NF; D2: DO I=FIELD0)=CR THEN CONT=0; ELSE CONT=BUF(0); NI,CC,ITEM(0)=0; CALL FIND$EOL; DO WHILE CCITEM$S DECLARE STATUS ADDRESS; IF STATUS<>0 THEN DO; CALL ERROR(STATUS); CALL EXIT; END; END STS); CALL WRITE(CO,.('OUTPUT FILE: '),13,.STATUS); CALL STAT(STATUS); CALL READ(CI,.BUF,ALL,.NR,.STATUS); CALL STAT(STR)-ZERO); BPTR=BPTR+1; END; RETURN; END READ$FIELD; FIND$EOL: PROCEDURE; CC=CC+1; DO WHILE I>=H; I=I-H; T1=COMPARE(.CHARS(K),.CHARS(ITEM(I))); IF T1 > LT THEN DO; ITEM((J).FIRST TO FIELD(J).LAST; IF (T1:=S1(I))<(T2:=S2(I)) THEN RETURN LT; IF T1>T2 THEN RETURN GT; IZE THEN CALL STAT(103); ITEM(NI)=CC; CALL FIND$EOL; END; /* THIS SECTION OF CODE READS THE FIELDS BY WHICH THAT; SHELL$SORT: PROCEDURE; /* FROM KNUTH VOL 3, TRANSFORMED FOR ZERO-BASED ARRAYS */ DECLARE (LT,EQ,GT) BYTTATUS); CALL OPEN(.AFTN2,.BUF,2,0,.STATUS); IF STATUS<>13 THEN CALL STAT(STATUS); CALL READ(AFTN,.CHARS,CHAR$SIZE,.NR,.HILE (CHARS(CC-1)<>LF OR CHARS(CC)=LF OR (CHARS(CC)=CONT AND CONT<>0)) AND CC=FIELD(NF).FIRST THEN DO; FIELD(NF).LAST=J-1; TO THE ARRAY ; OF POINTERS. IT RETURNS TRUE IFF THE RECORD ASSOCIATED ; WITH PTR1 IS GREATER THAN THE RECORD ASSOCIATED WHE SORT FIELDS IS THE SAME AS THEIR ORDER OF ENTRY. */ NF=0; WORKING=TRUE; DO WHILE NF<10 AND WORKING; CALL WR5051, Attn: Software ; License Administration. ; SORT: PROCEDURE (PTR,COUNT,PROC$ADDR) EXTERNAL; ; DECLARE (PTR,COUN AND GOING TO THE END OF LINE. FIELD- N,M@ CONT, WITH THE SORT FIELD STARTING AT $MACROFILE NOGEN ; '(C) Intel Corporation 1981'. All rights reserved. No ; part of this program or publication mPTS ARE MADE FOR FIELDS, AND 'CONT' MEAN THAT PROMPTING WILL OCCUR FOR ANOTHER FIELD UNLESS THERE ARE ALREADY TEN FIELDS.  NF=NF+1; END; ELSE CALL ERROR(108); END; END; IF NF=10 THEN NF=9; CALL SHELL$SORTITE(CO,.('FIELD- '),7,.STATUS); CALL READ(CI,.BUF,ALL,.I,.STATUS); BPTR=0; CALL READ$FIELD; IF J=0 THEN DO; T,PROC$ADDR) ADDRESS; ; END; ; ; SORT ACCEPTS AN ARRAY OF POINTERS AND SORTS THE POINTERS. ; "COUNT" IS THE NUMBER OF POIN COLUMN N AND GOING TO COLUMN M. EOL'S ARE IGNORED. FIELD- 0@ SAMay be reproduced, ; transmitted, transcribed, stored in a retrievel system, or ; translated into any language or com THEN THE FOLLOWING RESPONSES ARE POSSIBLE AND WILL PRODUCE THE RESULTS SHOWN: FIELD- @ END. ; D1:DO I=0 TO NI; CALL WRYTE(I); CALL STAT(STATUS); END D1; CALL CLOSE(AFTN,.STATUS); CALL STAT(STATUS) IF NF<>0 THEN NF=NF-1; ELSE DO; FIELD(NF).FIRST=0; FIELD(NF).LAST=NR; END; WORKITERS. ; "PTR" IS THE LOCATION OF THE POINTERS ; "PROC$ADDR" IS THE ADDRESS OF THE FOLLOWING PROCEDURE: ; ; GREATER$THAN:E AS (1). FIELD- N,0@ SAME AS (2). NOTE THAT TO USE A SINGLE COLUMN AS THE SORT FIELD, THE COLUMN NUMputer language, in any ; form or by any means, electronic, mechanical, magnetic, ; optical, chemical, manual or othe IF NO FIELDS HAVE BEEN DEFINED, THEN DEFINE ONE FIELD WITH THE DEFAULT VALUES ; CALL CLOSE(AFTN2,.STATUS); CALL STAT(STATUS); CALL EXIT; END SORT; NG=FALSE; END; ELSE DO; FIELD(NF).FIRST=J-1; CALL READ$FIELD; IF J=0 THEN DO; FIELD(NF PROCEDURE (PTR1,PTR2); ; DECLARE (PTR1,PTR2) ADDRESS; ; ... ; END; ; ; "GREATER$THAN" ACCEPTS AS INPUT TWO POINTERS INBER MUST BE ENTERED TWICE. E.G. FIELD- 3,3@ WILL USE ONLY COLUMN THREE FOR THIS SORT FIELD. THE PRECEDENCE OF Trwise, without the prior ; written permission of Intel Corporation, 3065 Bowers ; Avenue, Santa Clara, California, 9 1 AND EOL. FIELD- N@ CONT, WITH THE SORT FIELD STARTING AT COLUMN N                COUNT DE=??? HL=PTR MOV D,H MOV E,L ; BC=COUNT DE=START$PTR HL=START$PTR DAD B  POP D ; BC . . . . . . DE CALL SWITCH ; NOW BOTTOM > TOP > MID SO TOP IS GOOD. ALLSET:  DB (MVI A,0) ENDM SKIP2 MACRO ;; SKIP NEXT 2 INSTRUCTION BYTES -- WIPES OUT HL DB (LXI  CC SWITCH ; GUARANTEES MID < TOP POP H ; HL . . . BC . . . DE PUSH B ; HL . . . S ;; HAS THE SAME PARITY AS ALL THE OTHER POINTERS XRA L ANI 0FEH XRA L MOV C,A HED INTO ITS FINAL POSITION ON ; THE NEXT PAGE. ON THIS PAGE, WE INCREASE THE PROBABILITY THAT THAT ; FINAL POSITION IS NEAR ITH PTR2. ; ; SORT SORTS THE POINTERS SO THAT THE ASSOCIATED RECORDS ARE IN ; INCREASING ORDER. $EJECT NAME SORT  DAD B DCX H DCX H XCHG ; BC=COUNT DE=END$PTR HL=START$PTR HDSORT: ; IH,0) ENDM IFCROSS MACRO ADR ;; JUMP TO ADR IF BC AND DE HAVE CROSSED. MOV A,E SUB C 1 . . . DE MOV B,H MOV C,L ; BC . . . S1 . . . DE CALL BCGTDE ; BOTTOM > TOP? POP H ;; BC IS THE ANSWER. ENDM CENTER MACRO ;;SET HA TO (HL+BC)/2 DAD B MOV A,H RARTHE MIDDLE. THIS SPEEDS THINGS UP. WE DO SO ; BY LOOKING AT THE BOTTOM, MID, AND TOP POINTERS, AND SWITCHING THE ; SECOND HI CSEG PUBLIC SORT MIDPOINT MACRO ;; LOCATE POINTER IN THE MIDDLE OF THE ARRAY MOV A,L NTERIOR SORT ROUTINE WHICH IS CALLED RECURSIVELY. ; SORTS POINTERS AT HL THRU DE. A,B,C IGNORED.  MOV A,D SBB B JC ADR ENDM $EJECT SORT: ; BC=COUNT DE=PROC$ADDR HL=??? S1= ; BC . . . HL . . . DE JC ALLSET ; IF SO THEN TOP IS ALREADY GOOD XCHG ; BC . . . DE . .  MOV H,A MOV A,L RAR ENDM JFALSE MACRO PARAM ;; JUMP IF BCGTDE WAS FALSE I.E. GHEST OF THE THREE TO THE TOP POSITION. ; POINTER ARRAY LOOKS LIKE THIS: ; HL .  ADD E MOV C,A MOV A,H ADC D ;; AC NOW EQUALS (HL+DE) -- NOW DIVIDE BY 2 RAR  MOV A,E SUB L MOV C,A MOV A,D SBB H RC ; RETURN IF END$PTR < STARRET S2=PTR XCHG SHLD PADDR ; BC=COUNT DE=??? HL=PROC$ADDR POP H XTHL ; BC=. HL PUSH H ; BC . . . DE . . . S1 CALL BCGTDE CNC SWITCH ; GUARANTEES TOP > BOTTOM > MID IF BC <= DE JNC PARAM ENDM SKIP1 MACRO ;; SKIP NEXT 1 INSTRUCTION BYTE -- WIPES OUT A . . . . . DE PUSH H ; S1 . . . . . . DE MIDPOINT ; S1 . . . BC . . . DE CALL BCGTDE MOV B,A MOV A,C RAR ;; BA NOW EQUALS (HL+DE)/2 -- NOW INSURE THAT IT T$PTR ORA C RZ ; ...OR IF END$PTR = START$PTR $EJECT ; THE TOPMOST POINTER IS GOING TO BE SWITC      S1 . . . . . . DE HL . . . BC PUSH D ; S2 . . . . . . S1 HL . . . BC MOV D,B MOV E,C or publication may be reproduced, */ /* transmitted, transcribed, stored in a retrievel system, or */ /* translatH HALF IS SMALLER AND DO IT FIRST. RCURS: ; S2 . . . . . DE GOOD BC . . . . . S1 MOV H,B  RAR POP D POP B RET STKLN 100 $EJECT END CURS1 JMP CMPF $EJECT ; NOW WE CAN SPLIT THE SORT INTO TWO HALF SORTS AND DO THE HALF SORTS ; BY RECURSION. ; AN  XCHG MOV M,C INX H INX D LDAX D MOV C,M MOV M,A XCHG  PUSH B PUSH D ; S2=BC . . . . . . S1=DE $EJECT ; IN THIS STAGE, SWITCHES OF POINTERS ARE MADE UNTIL THERE IS  ; S2 . . . . . . S1 HL . . . DE SKIP1 LEFT: PUSH B ; HL . . . DE S2 . . . . . . S1 MOV L,C POP B ; S1 . . . . . DE HL . . . . . BC XTHL ; HL . . . . . DE S1 . .          ADJUSTMENT OF BC OR DE MUST FIRST BE MADE, DEPENDING ON THE ENTRY POINT. RCURS1: ; S2 . . . . . DE BC . . .  MOV M,C DCX D DCX H MOV C,L RET DSEG BCGTDE: ; CALL EXTEA ; SINGLE POINTER IN ITS FINAL POSITION, WITH ALL LESSER POINTERS ; TO THE LEFT AND ALL GREATER POINTERS TO THE RIGHT. CMP CALL HDSORT ; SORT THE FIRST HALF POP D POP H ; POP OFF THE POINTERS TO THE OTHER HALF . . . BC PUSH H ; S1 . . . . . DE S2 . . . . . BC CENTER SUB E MOV A,H $ TITLE('=====>>> STOPIF <<<=====') STOPIF: DO; /**********************************************************************. . S1 ; GOOD DCX D DCX D SKIP2 RCURS2: ; S2 RNALLY-PASSED "BC GREATER THAN DE" ; ROUTINE SO AS TO PRESERVE B,C,D,E AND RETURN F: CALL BCGTDE JFALSE CRUZF CALL SWITCH CRUZB: DCX D DCX D IFCROSS RCURS2 JMP HDSORT ; SORT THE OTHER HALF $EJECT SWITCH: ; SWITCH WORD POINTED AT BY BC WITH WORD POINTED  SBB D POP H ; HL . . . . . DE S1 . . . . . BC JNC LEFT RIGHT: XTHL ;**/ /* */ /* '(C) Intel Corporation 1981'. All rights reserved. No */ /* part of this program . . . . . DE BC . . . . . S1 ; GOOD INX B INX B ; NOW COMPUTE WHIC ; THE ANSWER IN THE CARRY FLAG (CARRY=TRUE) PUSH B PUSH D DB (CALL 0) PADDR: DW 0  CMPB: CALL BCGTDE JFALSE CRUZB CALL SWITCH CRUZF: INX B INX B IFCROSS RAT BY DE ; SAVE B,C,D,E MOV H,B MOV L,C LDAX D MOV C,M MOV M,A     TERNAL; DECLARE (AFTN,COUNT) WORD, (BUF$P,STATUS$P) POINTER; END WRITE; SEEK: PROCEDURE(AFTN,MODE,BLOCKNO$P,BYT LEN WORD, /* THE NUMBER OF CHARACTER TO WRITE OUT */ BUF ADDRESS; /* THE ADDRESS OF THE BUFFER */ IF LEN > 0 THAH', TAB LITERALLY '09H', FF LITERALLY '0CH', BELL LITERALLY '07H', BOOLEAN LITERALLY 'BYTE'; /* EXTERNALAIL(122) BYTE, NON$LIST$MSG (*) BYTE DATA('NOT A LISTING ==>',0), EMSG (*) BYTE DATA ('PROGRAM ERROR IN',0), WMSG (*) B OF STOPIF IS DESIGNED TO RUN WITH THE ASSEMBLERS AS WELL AS PL/M. ADDITIONALLY, THE PRESENCE OF A PAGE BREAK SHOULD NOT FOUL S WORD, /* FOR CALLS TO ISIS */ COMMAND$SIZE WORD, ACTUAL WORD, AFTN WORD, (BLOCK$NUMBER, BYTE$NUMBER) WORD, BUFFed into any language or computer language, in any */ /* form or by any means, electronic, mechanical, magnetic, */ /* ENO$P,STATUS$P) EXTERNAL; DECLARE (AFTN,MODE) WORD, (BLOCKNO$P,BYTENO$P,STATUS$P) POINTER; END SEEK; ERROR: PRO PROCEDURES FROM ISIS */ OPEN: PROCEDURE(AFTN$P,FILENAME$P,ACCESS,MODE,STATUS$P) EXTERNAL; DECLARE (AFTN$P,FILENAME$PYTE DATA ('PROGRAM WARNING IN',0); /* LOCAL PROCEDURES */ CHECK$STATUS: PROCEDURE; IF STATUS <> 0 THEN DO; UP STOPIF. */ DECLARE COPYRIGHT (*) BYTE DATA ('(C) INTEL CORP 1981'); DECLARE PROGRAM$VERSION$NUMBER$STRING (*) BYTE DATER(257) BYTE, /* THE LAST 128 BYTES OF THE LISTING */ START$BUF BYTE INITIAL(128), /* POINTER INTO BUFFER,  optical, chemical, manual or otherwise, without the prior */ /* written permission of Intel Corporation, 3065 BowersCEDURE (NUMBER) EXTERNAL; DECLARE NUMBER WORD; END ERROR; EXIT: PROCEDURE EXTERNAL; END EXIT; WHOCON: PROCEDURE(AFTN,,STATUS$P) POINTER, (ACCESS,MODE) WORD; END OPEN; READ: PROCEDURE(AFTN,BUF$P,COUNT,ACTUAL$P,STATUS$P) EXTERNAL; DECLCALL ERROR(STATUS); CALL CONSOL(.(':VI: '),.(':VO: '),.STATUS); IF STATUS <> 0 THEN CALL ERROR(STATUS); CALLA ('program_version_number=V1.0',0); /* LITERALLY DEFINITIONS */ DECLARE TRUE LITERALLY '0FFH', FAL /* FIRST READ 128, THEN 0 */ LINE$CURSOR WORD, /* POINTER AT BEGINNING OF CURRENT LINE */ LINE$END WORD, /*  */ /* Avenue, Santa Clara, California, 95051, Attn: Software */ /* License Administration. */ /* FILE$NAME$P) EXTERNAL; DECLARE AFTN WORD, FILENAME$P POINTER; END WHOCON; CONSOL: PROCEDURE(INFILE$P,OUTFILE$P,ARE (AFTN,COUNT) WORD, (BUF$P,ACTUAL$P,STATUS$P) POINTER; END READ; WRITE: PROCEDURE(AFTN,BUF$P,COUNT,STATUS$P) EX EXIT; END; END CHECK$STATUS; DISPLAY: PROCEDURE(LEN,BUF) PUBLIC; /* WRITE OUT A BUFFER TO THE CONSOL */ DECLARE SE LITERALLY '0', WORD LITERALLY 'ADDRESS', POINTER LITERALLY 'ADDRESS', CR LITERALLY '0DH', LF LITERALLY '0LAST POSITION IN CURRENT LINE */ CURSOR WORD, /* POINTER AT FOR SCAN */ TIMER BYTE, /* FOR TIMING THE BELL */ COMMAND$T */ /************************************************************************/ /* THIS IMPROVED VERSIONSTATUS$P) EXTERNAL; DECLARE (INFILE$P,OUTFILE$P,STATUS$P) POINTER; END CONSOL; /* GLOBAL VARIABLES */ DECLARE STATU      0; IF CURSOR + J > LINE$END /* END OF BUFFER MINUS CR,LF */ THEN RETURN FALSE; IF BUFFER(CURSOR + J) <> MSG(J)  THEN CALL EXIT; IF EQUAL(.('0 Errors Detected',0)) /* PASCAL-86 */ THEN CALL EXIT; IF EQUAL(.('NOL EXIT; END FAIL; READ$BUF: PROCEDURE; IF BLOCK$NUMBER = 0 THEN CALL FAIL(.NON$LIST$MSG); BLOCK$NUMBER = BLOC= ' '; CURSOR = CURSOR + 1; END; IF EQUAL(.('ERROR',0)) THEN CALL FAIL(.EMSG); IFIL: PROCEDURE(MSG$P); DECLARE MSG$P POINTER, OUT$FILE$NAME(15) BYTE; CALL PRINT(MSG$P); CALL DISPLAY(COMK$STATUS; CALL SEEK(AFTN,0,.BLOCK$NUMBER,.BYTE$NUMBER,.STATUS); CALL READ$BUF; BUFFER(256) = CR; LINE$CURSOR, LINE$END =EN DO; CALL WRITE(0,BUF,LEN,.STATUS); CALL CHECK$STATUS; END; END DISPLAY; PRINT: PROCEDURE(BUF) PUBLIC;  THEN RETURN FALSE; J = J + 1; END; RETURN TRUE; END EQUAL; /* MAIN BEGIN */ /* READ COMMAND TAIL */ CK$NUMBER - 1; CALL SEEK(AFTN,2,.BLOCK$NUMBER,.BYTE$NUMBER,.STATUS); CALL CHECK$STATUS; CALL READ(AFTN,.BUFFER(START$B EQUAL(.('Error',0)) /* PASCAL-86 */ THEN CALL FAIL(.EMSG); IF EQUAL(.('WARNING',0)) THEN CALL FAIL(.MAND$SIZE,.COMMAND$TAIL); CALL WHOCON(0,.OUT$FILE$NAME); CALL CONSOL(.(':VI: '),.(':VO: '),.STATUS); CALL CHECK$STATUS; 255; DO WHILE LINE$CURSOR > 0; IF LINE$CURSOR = 127 THEN DO; START$BUF = 0; CALL READ$BUF; END; IF /* WRITE OUT A BUFFER TERMINATED BY NULL TO :CO: */ DECLARE BUF ADDRESS, /* ADDRESS OF BUFFER */ PTR ADALL READ(1,.COMMAND$TAIL,128,.COMMAND$SIZE,.STATUS); CALL CHECK$STATUS; CALL OPEN(.AFTN,.COMMAND$TAIL,1,0,.STATUS); IF STATUF),128,.ACTUAL,.STATUS); CALL CHECK$STATUS; END READ$BUF; EQUAL: PROCEDURE (MSG$P) BOOLEAN; /* COMPARE CONTENTS OF BUFWMSG); IF EQUAL(.('0 PROGRAM ERRORS',0)) /* SIII PL/M-86 */ THEN GOTO NEXT$LINE; IF EQUAL(.('0 PROGRA IF OUT$FILE$NAME(1) <> 'V' /* VIDEO OUTPUT */ THEN DO; CALL PRINT(MSG$P); CALL DISPLAY(COMMAND$SIZE,.COMMAND$TA BUFFER(LINE$CURSOR) = CR OR BUFFER(LINE$CURSOR) = LF THEN DO; /* END OF A LINE, SEARCH FOR 'ERROR' */ CURSOR = LINEDRESS, /* POINTER INTO BUFFER */ CHAR BASED PTR BYTE; /* CHARACTER IN BUFFER */ /* SEARCH FOR NULL */ PTR = BUF; US = 13 THEN CALL FAIL(.('NO SUCH FILE ==>',0)); IF STATUS = 4 OR STATUS = 5 OR STATUS = 23 OR STATUS = 28 THEN CALL FAIL(.('FER TO MESSAGE */ DECLARE MSG$P POINTER, MSG BASED MSG$P (1) BYTE, J BYTE; J = 0; DO WHILE MSG(J) <>M ERROR(S)',0)) /* SII PL/M-86 */ THEN CALL EXIT; IF EQUAL(.('0 PROGRAM WARNINGS',0)) /* SIII PL/M-86 */ IL); END; CALL PRINT(.(CR,LF,0)); DO TIMER = 1 TO 80; CALL DISPLAY(1,.(BELL)); CALL TIME(250); END; CAL$CURSOR + 1; IF BUFFER(CURSOR) <> FF THEN DO; DO WHILE LINE$END > CURSOR + 4; DO WHILE BUFFER(CURSOR)  DO WHILE CHAR <> 0; PTR = PTR + 1; END; /* print out buffer */ CALL DISPLAY(PTR - BUF,BUF); END PRINT; FAILLEGAL FILENAME SPECIFICATION ==>',0)); CALL CHECK$STATUS; CALL SEEK(AFTN,4,.BLOCK$NUMBER,.BYTE$NUMBER,.STATUS); CALL CHEC     IS MODULE SCANS THE COMMAND TAIL AND OPENS ALL THREE FILES */ DECLARE TRUE LITERALLY '0FFH', FALSE LITERALLY'0', CR  DECLARE (NUMBER,DIGITS) ADDRESS; END CONVND; CHECK$STATUS: PROCEDURE PUBLIC; /* CHECK STATUS AND IF NONZERO DON'T RETin any */ /* form or by any means, electronic, mechanical, magnetic, */ /* optical, chemical, manual or otherwiseR; READ: PROCEDURE(AFTN,BUF,COUNT,ACTUAL,STATUS) EXTERNAL; DECLARE(AFTN,BUF,COUNT,ACTUAL,STATUS) ADDRESS; END READ; WR                 OUT$FILE$NAME(15) BYTE INITIAL(' '), AFTN0 ADDRESS EXTERNAL, /* AFTN FOR FILE1 */ AFTN1 ADDRESS EXTERNAL, /* ERRORS',0)) /* ASM86, BOTH SII AND SIII */ THEN CALL EXIT; DO WHILE BUFFER(CURSOR) <> ' ' AND LINE$END > CURSLITERALLY'0DH', /* CARRIAGE RETURN */ LF LITERALLY'0AH', /* LINE FEED */ LINE(128) BYTE, /* COMMAND LINE */ DIGITS(6), without the prior */ /* written permission of Intel Corporation, 3065 Bowers */ /* Avenue, Santa Clara, CaliforITE: PROCEDURE(AFTN,BUF,COUNT,STATUS) EXTERNAL; DECLARE(AFTN,BUF,COUNT,STATUS) ADDRESS; END WRITE; EXIT: PROCEDURE EXTERNTAIL:DO; /************************************************************************/ /* */ /* '(C) I AFTN FOR FILE2 */ OUT$AFTN ADDRESS EXTERNAL, /* AFTN FOR OUTPUT FILE */ SYNCPARM BYTE EXTERNAL, ACTUAL ADDRESS PUBLIC,OR + 4; CURSOR = CURSOR + 1; END; END; /* ENOUGH SPACE FOR ERROR */ END; /* NOT A PAGE HEADING LI BYTE, /* USED FOR PRINTING SYNCPARM */ PTR ADDRESS, /* CURSOR POSITION IN SCANNING COMMAND LINE */ CHAR BASED PTR BYTE, /nia, 95051, Attn: Software */ /* License Administration. */ /* */ /************************AL; END EXIT; DISPLAY: PROCEDURE (LEN,BUFFER) EXTERNAL; DECLARE LEN BYTE, BUFFER ADDRESS; END DISPLAY; NEW$ntel Corporation 1981'. All rights reserved. No */ /* part of this program or publication may be reproduced, */ /*  /* NUMBER OF CHARACTERS READ IN */ STATUS ADDRESS PUBLIC; OPEN: PROCEDURE(AFTN,FILE,ACCESS,MODE,STATUS) EXTERNAL; DECLNE */ NEXT$LINE: LINE$CURSOR, LINE$END = LINE$CURSOR - 1; END; ELSE LINE$CURSOR = LINE$CURSOR - 1; END; CALL FAI* CHARACTER IN COMMAND LINE */ LEXLEN BYTE, /* LENGTH OF CURRENT LEXEME */ LEXPTR ADDRESS, /* POINTER AT CURRENT LEXEME */************************************************/ DECLARE COPYRIGHT (*) BYTE DATA ('(C) INTEL CORP 1981'); /* THLINE: PROCEDURE EXTERNAL; END NEW$LINE; DUMP: PROCEDURE EXTERNAL; END DUMP; CONVND: PROCEDURE(NUMBER,DIGITS) EXTERNAL;  transmitted, transcribed, stored in a retrievel system, or */ /* translated into any language or computer language, ARE(AFTN,FILE,ACCESS,MODE,STATUS) ADDRESS; END OPEN; ERROR: PROCEDURE(NUMBER) EXTERNAL; DECLARE NUMBER ADDRESS; END ERROL(.NON$LIST$MSG); END STOPIF;  LEXCHAR BASED LEXPTR BYTE, /* CHARACTER IN LEXEME */ FILE$NAME$0(15) BYTE EXTERNAL, FILE$NAME$1(15) BYTE EXTERNAL,      BASED PTR1 BYTE, /* CHARACTER IN STRING 1 */ CHAR2 BASED PTR2 BYTE, /* CHARACTER IN STRING 2 */ I BYTE; /* LOOP INDEX RE V1.0',CR,LF,LF),30,.STATUS); CALL CHECKSTATUS; CALL OPEN(.AFTN1,.FILE$NAME$1,1,0,.STATUS); /* OPEN SECOND IN FILE * '(') AND (CHAR <> ')') AND (CHAR <> '&') AND (CHAR <> CR); IF CHAR > 60H /* LOWER CASE */ THEN CHAR = CHAR -  SCAN; IF NOT EQUAL(1,.('('),LEXLEN,LEXPTR) THEN CALL SYN$ERR; CALL SCAN; SYNCPARM = 0; DO I = 1 TO LEXL) OR (CHAR = '&'); IF CHAR = '&' /* REPROMPT AND READ IN NEW LINE */ THEN DO; CALL WRITE(0,.('**'),2,.STATUS); EXPTR) THEN CALL SYN$ERR; CALL SCAN; CALL MOVE(LEXLEN,LEXPTR,.FILE$NAME$1); CALL SCAN; IF EQUAL(5,.('PRINT'),LEXURN */ IF STATUS<>0 THEN DO; CALL ERROR(STATUS); CALL EXIT; END; END CHECK$STATUS; SYN$ERR: P*/ IF LEN1 <> LEN2 THEN RETURN FALSE; DO I = 1 TO LEN1; IF CHAR1 <> CHAR2 THEN RETURN FALSE; PTR1 = PTR1 + 1; 20H; /* RAISE CASE */ PTR = PTR + 1; LEXLEN = LEXLEN + 1; END; END SCAN; EQUAL: PROCEDURE(LEN1,PTR1,LEN2,PTR2EN; IF (LEXCHAR < 30H) OR (LEXCHAR > 39H) THEN CALL SYN$ERR; SYNCPARM = SYNCPARM*10 + LEXCHAR - 30H; LEX CALL CHECK$STATUS; CALL READ(1,.LINE,128,.ACTUAL,.STATUS); CALL CHECK$STATUS; PTR = .LINE; END;LEN,LEXPTR) THEN DO; CALL SCAN; IF NOT EQUAL(1,.('('),LEXLEN,LEXPTR) THEN CALL SYN$ERR; CALL SCAN; CROCEDURE; /* REPORT FATAL SYNTAX ERROR. */ CALL WRITE(0,.('COMMAND FORMAT: TO &',CR,LF, '[ PTR2 = PTR2 + 1; END; RETURN TRUE; END EQUAL; COMMAND: PROCEDURE PUBLIC; /* PROCEDURE TO READ THE COMMAND ) BYTE; /* PROCEDURE TO TEST IF TWO STRINGS ARE EQUAL */ DECLARE LEN1 BYTE, /* LENGTH OF STRING 1 */ LEN2 BYTEPTR = LEXPTR + 1; END; CALL SCAN; IF NOT EQUAL(1,.(')'),LEXLEN,LEXPTR) THEN CALL SYN$ERR; CALL SCAN;  ELSE PTR = PTR + 1; END; LEXPTR = PTR; IF (CHAR = '(') OR (CHAR = ')') OR (CHAR = CR) THEN DO; LEXLEN = 1ALL MOVE(LEXLEN,LEXPTR,.OUT$FILE$NAME); CALL SCAN; IF NOT EQUAL(1,.(')'),LEXLEN,LEXPTR) THEN CALL SYN$ERR; CAL PRINT( ) ] [ SYNC ( ) ]',CR,LF),81,.STATUS); CALL CHECKSTATUS; CALL EXIT; END SYN$ERR; SCAN: PROCELINE AND OPEN FILES */ DECLARE I BYTE; /* LOOP INDEX */ CALL READ(1,.LINE,128,.ACTUAL,.STATUS); CALL CHECK$STATU, /* LENGTH OF STRING 2 */ PTR1 ADDRESS, /* ADDRESS OF STRING 1 */ PTR2 ADDRESS, /* ADDRESS OF STRING 2 */ CHAR1  END; ELSE SYNCPARM = 3; IF NOT EQUAL(1,.(CR),LEXLEN,LEXPTR) THEN CALL SYN$ERR; CALL WRITE(0,.('ISIS-II SOURCE COMPA; PTR = PTR + 1; RETURN; END; LEXLEN = 0; /* ISOLATE COMMAND WORD */ DO WHILE (CHAR <> ' ') AND (CHAR <>L SCAN; END; ELSE CALL MOVE(4,.(':CO:'),.OUT$FILE$NAME); IF EQUAL(4,.('SYNC'),LEXLEN,LEXPTR) THEN DO; CALLDURE; /* PROCEDURE TO RETURN THE NEXT LEXEME IN THE COMMAND TAIL */ /* SKIP BLANKS AND COMMAS */ DO WHILE (CHAR = ' 'S; PTR = .LINE; CALL SCAN; CALL MOVE(LEXLEN,LEXPTR,.FILE$NAME$0); CALL SCAN; IF NOT EQUAL(2,.('TO'),LEXLEN,L      chanical, magnetic, */ /* optical, chemical, manual or otherwise, without the prior */ /* written permission of I AS 'END', /* plm */ END$IF AS ' ', /* plm */ $ TITLE ('==> PASSIF -- TOKENSMOD -- UDI STYLE TOKENIZER <==') TOKENS$MOD: DO; /*****************************************1', /* open */ CONSOLE$OUTPUT AS '0', /* open */ CO; CALL DISPLAY(3,.(')',CR,LF)); CALL DISPLAY(8,.('FILE 1: ')); CALL DISPLAY(15,.FILE$NAME$0); CALL NEW$LINE; CALL AS '020H', /* plm */ BOOLEAN AS 'BYTE', / CALL CHECK$STATUS; CALL OPEN(.AFTN0,.FILE$NAME$0,1,0,.STATUS); /* OPEN FIRST IN FILE */ CALL CHECK$STATUS; CALL OPEN(.Ontel Corporation, 3065 Bowers */ /* Avenue, Santa Clara, California, 95051, Attn: Software */ /* License Adminis*******************************/ /* */ /* '(C) Intel Corporation 1981'. All rights reserved. No */ NTROL$Z AS '01AH', /* plm */ CR AS '0DH',  DISPLAY(8,.('FILE 2: ')); CALL DISPLAY(15,.FILE$NAME$1); CALL NEWLINE; CALL NEWLINE; CALL DUMP; END; END COMMAND;/* plm */ CHK AS 'CALL CHECK$STATUS', /* plm */ CLEAR$CHAR AS '01CH', /* 151UT$AFTN,.OUT$FILE$NAME,2,0,.STATUS); /* OPEN NEW OUT FILE */ CALL CHECK$STATUS; IF NOT EQUAL(15,.OUT$FILE$NAME,15,.(':CO: tration. */ /* */ /************************************************************************/ $ N/* part of this program or publication may be reproduced, */ /* transmitted, transcribed, stored in a retrievel sys /* plm */ DOT AS '''.''', /* char */ END$DO AS 'END',  END TAIL; 0 */ CO$ECHO$FILE AS '0F00H', /* open */ COLON AS ''':''',  ')) THEN DO; CALL DISPLAY(31,.(CR,LF,'ISIS-II SOURCE COMPARE X007',CR,LF)); CALL DISPLAY(6,.('PRINT(')); CALLOLIST /* LIT.INC */ DECLARE AS LITERALLY 'LITERALLY', /* plm */ AMPERSAtem, or */ /* translated into any language or computer language, in any */ /* form or by any means, electronic, me /* plm */ END$DO$CASE AS 'END', /* plm */ END$DO$WHILE "              !!!!!!!! ! ! ! ! !!!!!!!!!!!!!!"""""""" " " " " """""" /* char */ COMMA AS '02CH', /* plm */ CONSOLE$INPUT AS ' DISPLAY(15,.OUT$FILE$NAME); CALL DISPLAY(10,.(') SYNC(')); CALL CONVND(SYNCPARM,.DIGITS); CALL DISPLAY(3,2+.DIGITS)ND AS '''&''', /* ??? */ BELL AS '07H', /* plm */ BLANK!     COLON AS ''';''', /* plm */ SET AS '1', /* attrib */ STRING AS '(*) BYTE DATA',YTE, ENTRY$POINT ADDRESS; END IO$DEF; IO$SET: PROCEDURE (CONFIGURATION$BYTE) EXTERNAL; DECLARE CONFIGURATION$BYTE $UPDATE AS '3', /* open */ PUB$STRING AS '(*) BYTE PUBLIC DATA', /* plm */ RESET AS '0', NSOL$OUTPUT$FILE,STATUS$CON) EXTERNAL; DECLARE (CONSOLE$INPUT$FILE,CONSOL$OUTPUT$FILE,STATUS$CON) ADDRESS; END CONSOL; D*/ HASH$MARK AS '''#''', /* plm */ INIT$STG AS '(*) BYTE INITIAL', /* plm */ LEAD$IN$CHAR AS  /* ENDLIT.INC */ $ LIST $ NOLIST /* ISIS.INC */ ATTRIB: PROCEDURE(FILE$NAME$PTR,WHICH$ATTRIBUT END$ITERATED$DO AS 'END', /* plm */ END$LOOP AS ' ', /* plm */  /* plm */ TAB AS '09H', /* plm */ TRANSFER$CONTROL  /* attrib */ RETURN$MARKER$POS AS '0', /* seek */ SEEK$2$EOF AS '4ELETE: PROCEDURE (FILE$NAME$PTR,STATUS) EXTERNAL; DECLARE (FILE$NAME$PTR,STATUS) ADDRESS; END DELETE; ERROR: PROCEDU'07EH', /*1510 */ LF AS '0AH', /* plm */ NO$LINE$EDIT ASE,SET$OR$RESET,STATUS$PTR) EXTERNAL; DECLARE (FILE$NAME$PTR,WHICH$ATTRIBUTE,SET$OR$RESET,STATUS$PTR) ADDRESS; END ATTRIB;  EOF$CHAR AS 'CONTROL$Z', /* plm */ ESC AS '01BH',  AS '1', /* load */ TRUE AS '0FFH', /* plm */ ', /* seek */ SEEK$BACKWARD$BY$N AS '1', /* seek */ SEERE (ERROR$NUMBER) EXTERNAL; DECLARE ERROR$NUMBER ADDRESS; END ERROR; EXIT: PROCEDURE EXTERNAL; END EXIT; IO$CHK '0', /* open */ NULL AS '0FFFFH', /* ??? */ OPEN$FOR$READ AS '1',  CLOSE: PROCEDURE (AFTN,STATUS) EXTERNAL; DECLARE (AFTN,STATUS) ADDRESS; END CLOSE; CI: PROCEDURE BYTE EXTERNAL;  /* plm */ FALSE AS '0H', /* plm */ FF AS '0CH', /* ??? UNDERBAR AS '''_''', /* ??? */ USER$CI AS '0', /* ??? */ WRITK$FORWARD$BY$N AS '3', /* seek */ SEEK$2$N AS '2', /* seek */ SEMI: PROCEDURE BYTE EXTERNAL; END IO$CHK; IO$DEF: PROCEDURE (WHICH$DEVICE,ENTRY$POINT) EXTERNAL; DECLARE WHICH$DEVICE B /* open */ OPEN$FOR$WRITE AS '2', /* open */ OPEN$FOREND CI; CO: PROCEDURE (CHAR$CO) EXTERNAL; DECLARE CHAR$CO BYTE; END CO; CONSOL: PROCEDURE (CONSOLE$INPUT$FILE,CO */ FOREVER AS 'WHILE 1', /* plm */ FORMAT$ATTRIBUTE AS '3', /* attrib E$PROTECT$ATTRIBUTE AS '2', /* attrib */ ZERO$BIAS AS '0' /* load */ ; "      MAXIMUM$TOKEN$LENGTH AS '70', BI AS 'CALL BOMB$IF(STATUS)', FIRST$FIELD AS '0', SECOND$FIEL* END MAIN.INC */ $ LIST $ NOLIST /* ERRMSG.INC */ DECLARE BAD$SYNTAX$MSG (29) BYTE EXTERNAL, BOMB$IF$MSG) EXTERNAL; DECLARE (AFTN,BUFFER) ADDRESS; END WHOCON; WRITE: PROCEDURE (AFTN,BUFFER,COUNT,STATUS) EXTERNAL; DECLAREP$FILE$NAME (15) BYTE EXTERNAL, TOK$BUF (80) BYTE EXTERNAL; DECLARE KEY$WORDS (10) STRUCTURE (LENGTH BYTRESS; END READ; RENAME: PROCEDURE (OLD$NAME,NEW$NAME,STATUS$R) EXTERNAL; DECLARE (OLD$NAME,NEW$NAME,STATUS$R) ADDRESS;RNAL, FIRST$TIME$THROUGH BOOLEAN EXTERNAL, INITIALIZED$BANNER (74) BYTE EXTERNAL, PRINT$HASH$MARK BOOLEAN EXTERNABYTE; END IO$SET; LOAD: PROCEDURE (FILE,BIAS,CONTROL$OF$TRANSFER,ENTRY$POINT,STATUS) EXTERNAL; DECLARE (FILE,BIAS,CONTD AS '28', THIRD$FIELD AS '54', RIGHT$PARENTHESIS AS ''')''', LEFT$PARENTHESIS AS '''( (AFTN,BUFFER,COUNT,STATUS) ADDRESS; END WRITE; /* END ISIS.INC */ $ NOLIST /***************************************E, KEY$WORD (13) BYTE, PROC$PTR ADDRESS) EXTERNAL; CO$IS$VO: PROCEDURE BOOLEAN EXTERNAL; END CO$IS$VO; END RENAME; RESCAN: PROCEDURE (AFTN,STATUS) EXTERNAL; DECLARE (AFTN,STATUS) ADDRESS; END RESCAN; SEEK: PROCED %"""""""######## # # # # ##############$$$$$$$$ $ $ $ $ $$$$$$$$$$$$$$%%%ROL$OF$TRANSFER,ENTRY$POINT,STATUS) ADDRESS; END LOAD; MEMCK: PROCEDURE ADDRESS EXTERNAL; END MEMCK; OPEN: PROCE''', RI AS 'CALL REPORT$IF', UNRECOGNIZED$SWITCH$ERR AS '201', QUESTION$MARK AS '''?'''; $ *********************/ /* */ /* LITERALLY'S UNIQUE TO PASSIF */ /* */ EXIT$ROUTINE: PROCEDURE EXTERNAL; END EXIT$ROUTINE; RE$POSITION$CURSOR: PROCEDURE EXTERNAL; END RE$POSITION$CURURE (AFTN,MODE,BLOCKNO,BYTENO,STATUS) EXTERNAL; DECLARE (AFTN,MODE,BLOCKNO,BYTENO,STATUS) ADDRESS; END SEEK; SPATH: PRL, REPORT$FILE$ACTUAL ADDRESS EXTERNAL, REPORT$FILE$AFTN ADDRESS EXTERNAL, REPORT$FILE$STRING$BEGINNING ADDRESS EDURE(AFTN,FILENAME,ACCESS$MODE,LINE$EDIT$AFTN,ERROR) EXTERNAL; DECLARE (AFTN,FILENAME,ACCESS$MODE,LINE$EDIT$AFTN,ERROR) ADDRESLIST $ NOLIST /* MAIN.INC */ DECLARE ACTUAL ADDRESS EXTERNAL, AFTN ADDRESS EXTERNAL, COMMAND$TAIL$BUF (25 /************************************************************/ DECLARE MINIMUM$ACCEPTABLE$BANNER$LENGTH AS '73', SOR; MOVE: PROCEDURE (COUNT,SOURCE$PTR,DEST$PTR) EXTERNAL; DECLARE (COUNT,SOURCE$PTR,DEST$PTR) ADDRESS; END MOVE; /OCEDURE (FILE,BUFFER,STATUS) EXTERNAL; DECLARE (FILE,BUFFER,STATUS) ADDRESS; END SPATH; WHOCON: PROCEDURE (AFTN,BUFFERXTERNAL, SECOND$OUTPUT$MSG$PTR ADDRESS EXTERNAL, STATUS ADDRESS EXTERNAL, TMP$FILE$AFTN ADDRESS EXTERNAL, TMS; END OPEN; READ: PROCEDURE (AFTN,BUFFER,COUNT,ACTUAL,STATUS) EXTERNAL; DECLARE (AFTN,BUFFER,COUNT,ACTUAL,STATUS) ADD0) BYTE EXTERNAL, DELIMITER BYTE EXTERNAL, FIRST$BLOCK$BUF (128) BYTE EXTERNAL, FIRST$OUTPUT$MSG$PTR ADDRESS EXTE#      MSG$LENGTH: PROCEDURE (OLD$STYLE$MSG$PTR) BYTE EXTERNAL; DECLARE OLD$STYLE$MSG$PTR ADDRESS; END MSG$LENGTH; /* char quality assures characters for both the "token stuffing" procedures, and for the delimiter processing procedures. TheRE STATUS ADDRESS; END REPORT$ISIS$ERROR; REPORT$ASSERTION$SUCCESS: PROCEDURE EXTERNAL; END REPORT$ASSERTION$SUCCESS;ndle ampersands, and strip out comments; otherwise, their characters will be passed along. 4. If the token "DEBUG" appeaDELIMITER: PROCEDURE(ENFORCEE) EXTERNAL; DECLARE ENFORCEE BYTE; END ENFORCE$DELIMITER; NEXT$ARG: PROCEDURE EXTERNAL;AL NOTES */ /* */ /************************************************************/ /* $1 (12) BYTE EXTERNAL, BOMB$IF$MSG$2 (40) BYTE EXTERNAL, DURING$ASSERTION$CHECK$MSG (50) BYTE EXTEEND REPORT.INC */ $ LIST $ NOLIST /* FUNC.INC */ FILE$EXISTS: PROCEDURE EXTERNAL; END FILE$EXISTS; FILE$ABSENT REPORT$ASSERTION$FAILURE: PROCEDURE EXTERNAL; END REPORT$ASSERTION$FAILURE; REPORT$ASSERTION$FAILURE$W$ISIS$ERR: Prs as the first token in the command line, it is stripped out here. */ /************************************************ END NEXT$ARG; INTERPRET$COMMAND$LINE: PROCEDURE EXTERNAL; END INTERPRET$COMMAND$LINE; /* END CLI.INC */ $ LIST  1. The variable "actual" has been locally redefined in this module. 2. The procedure used to check isis status in this moduRNAL, PASSIF$INVOKED$BY$MSG (19) BYTE EXTERNAL, ZERO$LENGTH$FILE$MSG (40) BYTE EXTE: PROCEDURE EXTERNAL; END FILE$ABSENT; FILES$MATCH: PROCEDURE EXTERNAL; END FILES$MATCH; STRING$FOUND: PROCROCEDURE (STATUS) EXTERNAL; DECLARE STATUS ADDRESS; END REPORT$ASSERTION$FAILURE$W$ISIS$ERR; REPORT$ASSERTION$FAILURE************/ /* */ /* DESIGN NOTES */ /* */ /****** $ NOLIST /* REPORT.INC */ BOMB$IF: PROCEDURE (STATUS) EXTERNAL; DECLARE STATUS ADDRESS; END BOMB$IF; REPle is "bomb if" because Passif cannot make a reasonable failed assertion entry if it can't even read the command tail. 3.RNAL; /* END ERRMSG.INC */ $ LIST $ NOLIST /* CLI.INC */ DECLARE BUF$COUNT BYTE EXTERNAL; UDI$STRING$MATCH: PREDURE EXTERNAL; END STRING$FOUND; STRING$ABSENT: PROCEDURE EXTERNAL; END STRING$ABSENT; /* END FUNC.INC */ $ LIS$W$MSG: PROCEDURE (OLD$STYLE$MSG$PTR) EXTERNAL; DECLARE OLD$STYLE$MSG$PTR ADDRESS; END REPORT$ASSERTION$FAILURE$W$MSG;****************************************************** This tokenizer has a very hierarchical design The procedure next$ORT$SYNTAX$ERROR: PROCEDURE EXTERNAL; END REPORT$SYNTAX$ERROR; REPORT$ISIS$ERROR: PROCEDURE (STATUS) EXTERNAL; DECLA The variable string$mode affects the functioning of the next$char procedure. If string$mode is false, then next$char will haOCEDURE (STG$1$PTR,STG$2$PTR) BOOLEAN EXTERNAL; DECLARE (STG$1$PTR,STG$2$PTR) ADDRESS; END UDI$STRING$MATCH; ENFORCE$T $ EJECT /************************************************************/ /* */ /* GENER$     ***********************************/ /* */ /* PUBLIC PROCEDURES */ /*  starts at the very beginning of the command line to be compatible with the UDI convention. */ CALL RESCAN******/ /* */ /* LITERALLY'S */ /* */ /***************************************************************/ STUFF$CHAR: PROCEDURE; USER$BUF(TOKEN$LENGTH+1) = CHAR;  GLOBAL VARIABLES */ /* */ /**********************************************************TOKEN$LENGTH BASED USER$BUF$PTR BYTE; DECLARE ACTUAL ADDRESS; DECLARE RETURNEE BYTE; /* We use a different variable procedure "bad$char" makes sure that a character is printable before passing it on. Since next$char is a procedure whic */ /************************************************************/ FORCUP: PROCEDURE (CHAR$PTR) PUBLIC; ************************************************/ DECLARE MAXIMUM$PHYSICAL$LINE$LENGTH AS '122'; DECLARE INVALID$COMMAND TOKEN$LENGTH = TOKEN$LENGTH + 1; END STUFF$CHAR; REFRESH$CI$BUF: PROCEDURE; CALL READ **/ DECLARE BIGGER$BUF (131) BYTE DATA (BLANK), LOCAL$BUF (130) BYTE AT (.BIGGER$BUF(1)), BUF$PTR ADDRESS, CHAR for status information, in this procedure, than elsewhere, since this procedure is allowed to set the other status variabh advances the buffer pointer before it performs it checking, said checking would not ordinarily performed on the first charac DECLARE CHAR$PTR ADDRESS, CHAR BASED CHAR$PTR BYTE; IF CHAR>='a' AND CHAR<='z' THEN CHAR = CHAR - 20$SYNTAX AS '203'; DECLARE UP$ARROW AS '''^'''; DECLARE NO$ERROR$DETECTED AS '0'; DECLARE TILDE  (CONSOLE$INPUT,.LOCAL$BUF,SIZE(LOCAL$BUF),.ACTUAL,.LOCAL$STATUS); CALL BOMB$IF(LOCAL$STATUS); BUF$P BASED BUF$PTR BYTE; DECLARE FIRST$TOKEN$REQUESTED BOOLEAN INITIAL (TRUE); DECLARE STRING$MODE BOOLEAN INITIAL (FALSE); Dle. */ DECLARE LOCAL$STATUS ADDRESS; $ EJECT /************************************************************/ ter in the buffer, except that the first character looked at will be a dummy blank. END OF DESIH; ENDIF END FORCUP; GET$ARGUMENT: PROCEDURE (USER$BUF$PTR,STATUS$PTR) BYTE PUBLIC; DECLARE USER$BUF$PTR ADDREAS '07EH'; DECLARE RUB$OUT AS '07FH'; DECLARE QUOTE AS '''"'''; $ EJECT /*************************TR = .BIGGER$BUF(0); END REFRESH$CI$BUF; OVER$ALL$INITIALIZATION: PROCEDURE; /* Get$argumentECLARE PROMPT STRING ('**'); DECLARE DEBUG$STG STRING (5,'DEBUG'); /******************************************************/* */ /* PROCEDURES LOCAL TO GET$ARGUMENT */ /* */ /*********GN NOTES */ $ EJECT /************************************************************/ /* */ /* SS; DECLARE STATUS$PTR ADDRESS, STAT BASED STATUS$PTR BYTE; DECLARE USER$BUF BASED USER$BUF$PTR (100) BYTE; DECLARE %      pointing to the start of the next token. This function is correctly handled for the case of carriage retu /* This is the "line too long" condition. */ CALL NEXT$CHAR$ERROR$CONDITION; ELSE IF STRING$MODE THEN  conditions in token mode are 1. line too long 2. illegal character (e.g., escape) If an error is de /* FIRST EXECUTABLE IN NEXT$CHAR */ /* */ /*********************ND INITIALIZE$FOR$THIS$TOKEN; BLANK$OR$TAB: PROCEDURE (A$CHAR) BOOLEAN; DECLARE A$CHAR BYTE; IF A$CHAR=BLANKHAR$ERROR$CONDITION: PROCEDURE; CHAR = HASH$MARK; STAT = INVALID$COMMAND$SYNTAX; (CONSOLE$INPUT,.STATUS); BI; CALL REFRESH$CI$BUF; END OVER$ALL$INITIALIZATION; INITIALIZE$FOR$THISrn, whether or not an error state exists, by the set$delimiter procedure. Next$char will change all tected, then the errant character is overwritten by a carriage return, and status is set to isis error 203, which is def***************************************/ BUF$PTR = BUF$PTR + 1; /* Check all possible error condtions, as specif OR A$CHAR=TAB THEN RETURN TRUE; ELSE RETURN FALSE; ENDIF END BLANK$OR$TAB; NEXT$CHAR:  END NEXT$CHAR$ERROR$CONDITION; BAD$CHAR: PROCEDURE BOOLEAN; RETURN (CHAR>=0 AND CHAR<=19H AND (NOT (CH$TOKEN: PROCEDURE; /* Initialize the data fields returned to the user, in case get$argument has to rlowercase characters to uppercase, unless string$mode is true. */ $ EJECT /*************************ined as "invalid command syntax". After encountering an illegal character, or error condition, the uied in the comment above. */ /* First check for line too long. This error condition applies in both string mode and PROCEDURE; /* This procedure detects some error conditions. The possible error conditions detectable AR=CR OR CHAR=TAB))) OR CHAR = UP$ARROW OR CHAR > 07FH; END eturn "unexpectedly". */ TOKEN$LENGTH = 0; RETURNEE = HASH$MARK; STAT = NO$ERROR$DETECTED; E***********************************/ /* */ /* PROCEDURES LOCAL TO NEXT$CHAR ser should be able to get the remaining tokens on the line. The rest of this code expects that buf$ptr will be  token mode. */ check$current$character: IF BUF$PTR > .LOCAL$BUF(MAXIMUM$PHYSICAL$LINE$LENGTH) THEN in string mode are 1. carriage return encountered 2. physical line too long The possible errorBAD$CHAR; $ EJECT /************************************************************/ /* */ "'%%%% % % % % %%%%%%%%%%%%%%&&&&&&&& & & & & &&&&&&&&&&&&&&'''''''' ' ' ' ' '' */ /* */ /************************************************************/ NEXT$C&     FORCUP(BUF$PTR); ENDIF END NEXT$CHAR; SKIP$CHAFF: PROCEDURE; DO WHILE BLANK$OR$TAB(CHAR);  END TOKEN$DELIMITER; $ EJECT SET$DELIMITER: PROCEDURE; /* This procedure expects char to be L BOMB$IF(LOCAL$STATUS); GOTO check$current$character; ENDDO;  RETURN (A$CHAR = TILDE) OR (A$CHAR = '+') OR (A$CHAR = '-') OR  can finally check for the non-error conditions which require special handling: ampersands, and comments. */ (A$CHAR>=0 AND A$CHAR<=20H) OR (A$CHAR = ',') OR (A$CHAR = ')') OR (A$ DO; /* Now, check for carriage-return encountered in string mode. */  CALL NEXT$CHAR; END$DO$WHILE; END SKIP$CHAFF; $ EJECT /****************************************** ELSE IF CHAR=SEMICOLON THEN DO; /* the line is terminated by the  (A$CHAR = '&') OR (A$CHAR = '|') OR (A$CHAR = ']') OR  IF CHAR=AMPERSAND THEN DO; CALL WRITE(CONSOLE$OUTPUT,CHAR = '(') OR (A$CHAR = '=') OR (A$CHAR = '#') OR (A$CHAR = '!')  IF CHAR = CR THEN DO; STAT = INVALID$COMMAND$SYNTAX; ENDDO; ******************/ /* */ /* TOKEN$DELIMITER */ /*  detection of this comment. */ CHAR = CR; ENDDO;  (A$CHAR = '[') OR (A$CHAR = '>') OR (A$CHAR = '<') OR (A$CHAR = '; .PROMPT ,SIZE(PROMPT),  OR (A$CHAR = '$') OR (A$CHAR = '%') OR (A$CHAR = '''') OR  ENDIF ENDDO; ELSE DO; /* Check for the illegal character error conditi */ /************************************************************/ TOKEN$DELIMITER: PROCEDURE (A$CHAR) B ENDIF ENDDO; ENDIF ENDDO; ENDIF IF NOT STRING$MODE THEN CALL ') OR (A$CHAR = RUBOUT); END EXPRESSION$2; RETURN EXPRESSION$1 OR EXPRESSION$2;  .LOCAL$STATUS); CALL REFRESH$CI$BUF; CAL (A$CHAR = '\'); END EXPRESSION$1; EXPRESSION$2: PROCEDURE BOOLEAN; on. */ IF BAD$CHAR THEN CALL NEXT$CHAR$ERROR$CONDITION; ELSE DO; /* Now, weOOLEAN; DECLARE A$CHAR BYTE; EXPRESSION$1: PROCEDURE BOOLEAN; RETURN '     s then pass on a single quote. If the quote is only a single quote, then do not pass it on, END$DO$WHILE; END$IF END STUFF$TOKEN; TOKEN$TOO$LONG: PROCEDURE BYTE; RETURN TOKEN$ */ /************************************************************/ HANDLE$QUOTED$STRING: PROCEDURE;  */ /* */ /************************************************************/ STUFF$TOKEN: PROCto the next token. */ CALL SKIP$CHAFF; IF TOKEN$DELIMITER(CHAR) THEN DO; RETURNEE = CH RETURN; ENDIF ENDDO; ELSE DO; /* The current character can havpointing to the first character following the token. This procedure processes the strings of consecutive delimiters, as but terminate the string. */ CALL NEXT$CHAR; IF CHAR=QUOTE THEN /* Pass on a single quote to stand for the d loop$begin: CALL NEXT$CHAR; IF CHAR = CR THEN DO; /* Carriage-return will terminaEDURE; /* This procedure expects the current character to be pointing to a token. */ IF CHAR=QUOTE THEN AR; IF NOT CHAR=CR THEN CALL NEXT$CHAR; ENDIF ENDDO; ELSE Re no interest to those procedures interested in terminating the string. */ CALL STUFF$CHAR; GO specified by UDI; i.e., strings of blanks and tabs followed a fresh token become a single blank, but strings of blanks%'''''''''''(((((((( ( ( (te a string. Prepare to return. */ CALL STUFF$CHAR; RETURN; ENDDO; DO; STRING$MODE = TRUE; CALL HANDLE$QUOTED$STRING; STRING$MODE = FALSE; ENDDO; ETURNEE = BLANK; ENDIF END SET$DELIMITER; $ EJECT /********************************************TO loop$begin; ENDDO; ENDIF END HANDLE$QUOTED$STRING; $ EJECT /******************* and tabs followed by one of the other delimiters are thrown away. If the "true" or "final" (after the chaff has bouble quotes. */ DO; CALL STUFF$CHAR; GOTO loop$begin ELSE IF CHAR=QUOTE THEN DO; /* Check for double quotes. If there are double quote ELSE DO WHILE NOT TOKEN$DELIMITER(CHAR); CALL STUFF$CHAR; CALL NEXT$CHAR; ****************/ /* */ /* HANDLE$QUOTED$STRING */ /* *****************************************/ /* */ /* STUFF$TOKEN een skipped) delimiter is anything besides a carriage return, then set$delimiter will advance buf$ptr ; ENDDO; ELSE /* The previous quote has terminated the string. */ (     Unpack: DO; /************************************************************************/ /* */ /* 'as 'END; ELSE IF'; dcl elsee as 'END; ELSE DO;'; dcl endif as 'END;'; dcl whilee as 'DO WHILE'; dcl endwhile as 'END;'; dclop; ENDDO; ENDIF ENDDO; ENDIF IF TOKEN$TOO$LONG THEN DO; CALL CORREverting bytes with the high bit on into a string of blanks whose length is the lower seven bits of the byte. All  */ /************************************************************/ IF FIRST$TOKEN$REQUESTED THEN CALL lifornia, 95051, Attn: Software */ /* License Administration. */ /* */ /*******************LENGTH > MAXIMUM$TOKEN$LENGTH; END TOKEN$TOO$LONG; CORRECT$TOKEN$LENGTH: PROCEDURE; DECLARE CORRECTION$FACT(C) Intel Corporation 1981'. All rights reserved. No */ /* part of this program or publication may be reproduced, */CT$TOKEN$LENGTH; STAT = INVALID$COMMAND$SYNTAX; RETURN BLANK; ENDDO; ENDIF CALL SET$other characters are passed through without alteration. */ DECLARE dcl LITERALLY 'DECLARE'; DECLARE as LITERALLY 'OVER$ALL$INITIALIZATION; ENDIF CALL INITIALIZE$FOR$THIS$TOKEN; begin$loop: CALL SKIP$CHAFF; CALL STUFF$TO*****************************************************/ DECLARE COPYRIGHT (*) BYTE DATA ('(C) INTEL CORP 1981'); DEOR BYTE; CORRECTION$FACTOR = TOKEN$LENGTH - MAXIMUM$TOKEN$LENGTH; BUF$PTR = BUF$PTR - CORRECTION$FACTOR; TOKEN$LENGTH = /* transmitted, transcribed, stored in a retrievel system, or */ /* translated into any language or computer languDELIMITER; RETURN RETURNEE; END GET$ARGUMENT; END TOKENS$MOD; LITERALLY'; dcl boolean as 'BYTE'; dcl depart as '0FFH'; dcl true as '0FFH'; dcl false as '0'; dcl character as 'BYTE'; KEN; IF FIRST$TOKEN$REQUESTED THEN DO; FIRST$TOKEN$REQUESTED = FALSE; IF UDI$STRING$MATCHCLARE PROGRAM$VERSION$NUMBER$STRING (*) BYTE DATA ('program_version_number=V1.0',0); /* This program is desig TOKEN$LENGTH - CORRECTION$FACTOR; END CORRECT$TOKEN$LENGTH; $ EJECT /**********************************age, in any */ /* form or by any means, electronic, mechanical, magnetic, */ /* optical, chemical, manual or othe* (((((((((((((()))))))) ) ) ) ) ))))))))))))))******** * * * * **********dcl pointer as 'ADDRESS'; dcl int1 as 'BYTE'; dcl int2 as 'ADDRESS'; dcl nil as '0'; dcl thenn as 'THEN DO;'; dcl elseif (.DEBUG$STG(0),.USER$BUF(0)) THEN DO; TOKEN$LENGTH = 0; GOTO begin$loned to accept packed files and decompress the blanks back to their original forms Blanks are decompressed by con**************************/ /* */ /* FIRST EXECUTABLE CODE IN PROCEDURE GET$ARGUMENT */ /*rwise, without the prior */ /* written permission of Intel Corporation, 3065 Bowers */ /* Avenue, Santa Clara, Ca)     r, pn, wc$used) BYTE EXTERNAL; DECLARE (pathname$ptr, pn, wc$used) ADDRESS; END wpath; unpath: PROCEDURE(int, ext) cr; char$ref = char$ref + 1; endwhile RETURN char$ref; end scan$blank; command$tail$error: PROCEDURE; CALURE (status, filename$ptr, callexit) EXTERNAL; DECLARE (status, filename$ptr) ADDRESS; DECLARE callexit boolean; ENsuch$file as '13'; dcl star$dot$LST(16) character initial(0,'******LST '); deblank: PROCEDURE( char$ref ) pointer; buffer,count,status) EXTERNAL; DECLARE (aft,buffer,count,status) ADDRESS; END write; delete: PROCEDURE (file,staput$file$name(16) character PUBLIC; dcl input$name pointer PUBLIC; dcl output$name pointer PUBLIC; dcl in$name pointer; dcl  for as 'DO'; dcl endfor as 'END;'; dcl enddo as 'END;'; dcl cr as '0DH'; dcl lf as '0AH'; /* system EXTERNALs */ op EXTERNAL; DECLARE (int, ext) ADDRESS; END unpath; unpacker: PROCEDURE boolean external; end unpacker; dcl versioD file$error; dcl disk$type BYTE PUBLIC; /* needed by dmeq */ dmeq: PROCEDURE (dir$aftn, search$arg, initial$i$no, dir$/* scan for next non-blank */ dcl char$ref pointer; dcl char BASED char$ref character; whilee char = ' '; ctus) EXTERNAL; DECLARE (file,status) ADDRESS; END delete; exit: PROCEDURE EXTERNAL; END exit; seq: PRout$name pointer; dcl no$error$occured boolean; dcl directory$name(16) character initial(':F0:ISIS.DIR '); dcl dir$aftn inten: PROCEDURE (aft,file,access,mode,status) EXTERNAL; DECLARE (aft,file,access,mode,status) ADDRESS; END open; cn(4) character data('V1.0'); dcl (actual,status) int2; dcl out$aftn int2 PUBLIC; dcl in$aftn int2 PUBLIC; dcl command$line(1entry) ADDRESS EXTERNAL; DECLARE (dir$aftn, search$arg, initial$i$no, dir$entry) ADDRESS; END dmeq; spath: PROCEDUhar$ref = char$ref + 1; endwhile RETURN char$ref; end deblank; scan$blank: PROCEDURE( char$ref ) pointer; /* scaOCEDURE (s1,s2,len) boolean EXTERNAL; DECLARE s1 ADDRESS; DECLARE s2 ADDRESS; DECLARE len BYTE; END seq; 2; dcl path$name(16) character; dcl out$path$name(16) character; dcl max$directory$length int2; dcl file$found boolean; dcllose: PROCEDURE (aft,status) EXTERNAL; DECLARE (aft,status) ADDRESS; END close; read: PROCEDURE (aft,buffer,c20) character; dcl command$pointer pointer; dcl command$char based command$pointer character; dcl delete$source boolean; dclRE(file, buffer, status) EXTERNAL; DECLARE (file, buffer, status) ADDRESS; END spath; wpath: PROCEDURE(pathname$ptn for a blank character */ dcl char$ref pointer; dcl char BASED char$ref character; whilee char <> ' ' and char <>force$upper: PROCEDURE (buffer$ptr) EXTERNAL; DECLARE buffer$ptr ADDRESS; END force$upper; file$error: PROCED wildcard$used boolean; dcl directory$entry int2; dcl source$disk int1; dcl buf16(16) character; dcl found boolean; dcl no$ount,actual,status) EXTERNAL; DECLARE (aft,buffer,count,actual,status) ADDRESS; END read; write: PROCEDURE (aft, default$output boolean; dcl default$extension(3) character initial('PCK'); dcl input$file$name(16) character PUBLIC; dcl out*     ********************/ dcl i int1; dcl internal$name(16) character; CALL move(15, .(' '), .output$fut$name, true); if not wildcard$used thenn default$output = false; endif elsee /* generate te RETURN true; endif end more$input$files; generate$default$output$filename: PROCEDURE; /******************** command$pointer=deblank(scan$blank(command$pointer)); command$pointer = deblank(scan$blank(command$pointer)); CALcard pathname and returns true. If no * more matching file names are found, false is returned. * ***************mand$line,120,.actual,.status); CALL force$upper(.command$line); command$pointer = deblank(.command$line); in$name =L write(0,.command$line,command$pointer-.command$line,.status); CALL write(0,.('#'),1,.status); CALL write(0,command$pointilename); CALL move(15, .out$path$name, .internal$name); for i = 1 to 14; if out$path$name(i) = '*' or out$path$n******************************************************** * * This procedure generates the default output$filename by c (***++++++++ + + + + ++++++++++++*************************************************************/ directory$entry = dmeq(diraftn, .pathname, directory$entry, command$pointer; wildcard$used = true; status = wpath(in$name,.path$name,.wild$card$used); CALL file$error(status, er,actual-(command$pointer-.command$line),.status); CALL write(0,.('command tail error',cr,lf),20,.status); CALL exit; EName(i) = '?' thenn internal$name(i) = buf16(i); endif endfor CALL unpath(.internal$name, .output$filenahanging * the input$filename extension to .PCK if no output filename was * specified. If a name was specified (with wL move(command$pointer - out$name, out$name, .output$filename); endif default$output = true; if out$name <> nil then .buf16); if directory$entry >= max$directory$length + 1 thenn RETURN false; elsee found = true; buin$name, true); output$name = .output$file$name; CALL move (15, .(' '), .output$filename); command$pD command$tail$error; more$input$files: PROCEDURE boolean; /***********************************************************me); end generate$default$output$filename; /* initialize values and open files */ CALL write(0,.('ISIS-II BLANK ildcard) then the * appropriate replacements are made. * ********************************************************n wildcard$used = true; status = wpath(out$name, .out$path$name, .wildcard$used); CALL file$error(status, of16(0) = source$disk; CALL move(15,.(' '),.input$filename); CALL unpath(.buf16, .input$file$name); ointer = deblank(scan$blank(command$pointer)); out$name = nil; if seq(command$pointer,.('TO '),3) thenn out$name,***************** * * This routine sets up the global input$file$name with the next file * which matches the wildDECOMPRESSOR, '),29,.status); CALL write(0,.version,4,.status); CALL write(0,.(cr,lf),2,.status); CALL read(1,.com+     lt$output$filename; CALL open(.outaftn,output$name,2,0,.status); CALL file$error(status,output$name,false); Unpacker: DO; /************************************************************************/ /* */ /* name, true); if not default$output thenn CALL open(.outaftn,output$name,2,0,.status); CALL file$error(statust$name, false); CALL write(0,.(' DELETED'),8,.status); endif CALL write(0,.(cr,lf),2,.status); $error; /* setup wild card search */ directory$name(2) = (source$disk := path$name(0)) + '0'; path$name(0) = 0; rite(0,.(' UNPACKED '),10,.status); elsee CALL write(0,.(' ERROR '),10,.status); endif mplate for :F#:*.LST for output */ CALL move(15, .star$dot$LST, .out$path$name); out$path$name(0) = pathname(0);  if status <> 0 thenn no$error$occured = false; CALL close(inaftn, .status); CAL,output$name,true); endif input$name = .input$filename; whilee more$input$files; no$error$occured = true;  endif endwhile CALL close(dir$aftn, .status); CALL file$error(status, .directory$name, true); if not fo CALL spath(.directory$name, .buf16, .status); CALL file$error(status, .directory$name, true); disk$type = buf16(11);  if default$output thenn CALL close(outaftn,.status); CALL file$error(status,output$name,false); endif delete$source = true; if seq(command$pointer, .('DELETE'),6) thenn delete$source = true; commanL file$error(status, input$name, false); endif endif if no$error$occured thenn CALL write(0,.( CALL open(.inaftn,input$name,1,0,.status); CALL file$error(status,input$name,false); if status <> 0 thenn und thenn CALL file$error(no$such$file, in$name, true); endif CALL exit; end Unpack;  if disk$type = 4 thenn max$directory$length = 992; elsee max$directory$length = 200; endif found =  endif CALL close(inaftn, .status); CALL file$error(status, input$name, false); if dd$pointer = deblank(scan$blank(command$pointer)); elseif seq(command$pointer, .('NODELETE'),8) thenn delete$source = ' '),2,.status); CALL write(0,input$name,15,.status); CALL write(0,.(' TO '),4,.status); CALL wri no$error$occured = false; endif if default$output and no$error$occured thenn CALL generate$defau+,,,,,,,, , , , , ,,,,,,,,,,,,,,-------- - - - - -false; directory$entry = 0; CALL open(.diraftn, .directory$name, 1, 0, .status); CALL file$error(status, .directory$elete$source and no$error$occured thenn CALL delete(input$name, .status); CALL file$error(status, inpufalse; command$pointer = deblank(scan$blank(command$pointer)); endif if command$char <> cr then call command$tailte(0,output$name,15,.status); no$error$occured = not unpacker; if no$error$occured thenn CALL w,     F'; dcl elsee as 'END; ELSE DO;'; dcl endif as 'END;'; dcl for as 'DO'; dcl endfor as 'END;'; dcl whilee as buffer$size,.status); call file$error(status,output$name,false); if status <> 0 thenn RETURN false; must not be used by the system. This byte is the negation of the number of blanks which have been compressed.  dcl (input$name, output$name) address EXTERNAL; dcl compress boolean; dcl compression$byte byte; dcl (i,j) addresCalifornia, 95051, Attn: Software */ /* License Administration. */ /* */ /*****************E(status,ptr,callexit) EXTERNAL; DECLARE (status,ptr) ADDRESS; DECLARE callexit BOOLEAN; end file$error; /*  '(C) Intel Corporation 1981'. All rights reserved. No */ /* part of this program or publication may be reproduced, 'DO WHILE'; dcl endwhile as 'END;'; dcl until literally 'while not'; dcl end$of$file literally 'actual=0'; dcl*/ /* symbolic definitions */ DECLARE dcl LITERALLY 'DECLARE'; DECLARE as LITERALLY 'LITERALLY'; dcl s; output: PROCEDURE(put$char) boolean; /* this procedure accepts a character and fills a buffer when the bu*******************************************************/ /* This routine is the logical opposite of the progra declarations */ dcl output$buffer(buffer$size) byte; dcl input$buffer(buffer$size) byte; dcl output$pointer ad*/ /* transmitted, transcribed, stored in a retrievel system, or */ /* translated into any language or computer lan buffer$size literally '20480'; dcl limit literally 'buffer$size-1'; dcl compress$1 literally '81h'; read: PROCEDURE true as '0FFH'; dcl false as '0'; dcl boolean as 'BYTE'; dcl int1 as 'BYTE'; dcl int2 as 'ADDRESS'; dcl poinffer is full, it is then written to the output file. */ dcl put$char character; output$character=put$char; m pack this routine accepts as input a file containing the compression bytes produced by pack, reexpands them dress; dcl output$character based output$pointer byte; dcl input$pointer address; dcl input$character based input$poguage, in any */ /* form or by any means, electronic, mechanical, magnetic, */ /* optical, chemical, manual or ot(aft,buffer,count,actual,status) EXTERNAL; DECLARE (aft,buffer,count,actual,status) ADDRESS; END read; write: PROCEter as 'ADDRESS'; dcl character as 'BYTE'; dcl nil as '0'; dcl thenn as 'THEN DO;'; dcl elseif as 'END; ELSE I output$pointer=output$pointer+1; if output$pointer > .output$buffer+limit thenn call write(outaftn,.output$buffer, and outputs the result. The compression bytes are bytes which have the sign bit on which implies that parity inter byte; dcl status address; dcl actual address; dcl outaftn address EXTERNAL; dcl inaftn address EXTERNAL; herwise, without the prior */ /* written permission of Intel Corporation, 3065 Bowers */ /* Avenue, Santa Clara, DURE (aft,buffer,count,status) EXTERNAL; DECLARE (aft,buffer,count,status) ADDRESS; END write; file$error: PROCEDUR-     r; END Unpacker; ZZ2) EXTERNAL;DECLARE (ZZ1,ZZ2)ADDRESS;END; READU :PROCEDURE (ZZ1,ZZ2) EXTERNAL;DECLARE (ZZ1,ZZ2)ADDRESS;END; SBYTEU :PROCEDURe; endif endfor elsee if not output(input$character) thenn RRE PROGRAM$VERSION$NUMBER$STRING (*) BYTE DATA ('program_version_number=V1.0',0); $NOLIST /* PEX */ DECLARE SCr; input$pointer=.input$buffer; compress=false; /* begin processing */ call read(inaftn,.input$buffer, in any */ /* form or by any means, electronic, mechanical, magnetic, */ /* optical, chemical, manual or otherwi endif output$pointer=.output$buffer; endif RETURN true; END output; flush: PROCEDURE; /* this rout------------.....ETURN true; endif endif input$pointer=input$pointer+1; endfor call read(inaftANP ADDRESS EXTERNAL; DECLARE SCANBYTE BASED SCANP BYTE; FORCUP :PROCEDURE BYTE EXTERNAL;END; MIN :PROCEDURE (ZZ1,ZZ2)ADDRESS,buffer$size,.actual,.status); call file$error(status,input$name,false); if status <> 0 thenn RETURN true; ense, without the prior */ /* written permission of Intel Corporation, 3065 Bowers */ /* Avenue, Santa Clara, Califine flushes the output buffer at the end of the program */ if output$pointer = .output$buffer thenn RETURN; enUPPER: DO; /************************************************************************/ /* */ /* '(C)n,.input$buffer,buffer$size,.actual,.status); call file$error(status,input$name,false); if status <> 0 thenn  EXTERNAL;DECLARE (ZZ1,ZZ2)ADDRESS;END; DECLARE FATAL BYTE EXTERNAL; DECLARE ACTUAL ADDRESS EXTERNAL; EX :PROCEDURE EXTERNALdif whilee not end$of$file; for i = 0 to actual-1; if input$character > 127 thenn /* expornia, 95051, Attn: Software */ /* License Administration. */ /* */ /**********************dif call write(outaftn,.output$buffer,output$pointer-.output$buffer, .status); call file$error(status,output$name Intel Corporation 1981'. All rights reserved. No */ /* part of this program or publication may be reproduced, */ / RETURN true; endif input$pointer=.input$buffer; endfor call flush; RETURN false; END unpacke;END; MEMCK :PROCEDURE ADDRESS EXTERNAL;END; OPENU :PROCEDURE (ZZ1) EXTERNAL;DECLARE (ZZ1)ADDRESS;END; READC :PROCEDURE (ZZ1,and blanks */ for j = 1 to -input$character; if not output(' ') thenn RETURN tru**************************************************/ DECLARE COPYRIGHT (*) BYTE DATA ('(C) INTEL CORP 1981'); DECLA,false); END flush; unpacker: PROCEDURE boolean PUBLIC; /* initialize values */ output$pointer=.output$buffe* transmitted, transcribed, stored in a retrievel system, or */ /* translated into any language or computer language.     ***************************************************/ DECLARE COPYRIGHT (*) BYTE DATA ('(C) INTEL CORP 1981'); DECLARE PROGE (0, .('**'), 2, .STATUS); CALL READ (1, CMND$PTR + 3, 128, .ACTUAL, .STATUS); CMND = CMND$PTR + ACTUAL + 3; IFEND; C/* transmitted, transcribed, stored in a retrievel system, or */ /* translated into any language or computer languag ACTUAL) ADDRESS; DCL (CMND, CMND$PTR) ADDRESS, (CMND$CH BASED CMND$PTR) (1) BYTE; DCL (FILE1, FILE2) (15) BYTE; DCL (PN) STR END; CALL SBYTEU(-ACTUAL); CALL WRITEU(.MEMORY,ACTUAL); END; END UPPER; A,B,C,D,E) EXTERNAL; DCL (A,B,C,D,E) ADDRESS; PROCEND; WRITE: PROC (A,B,C,D) EXTERNAL; DCL (A,B,C,D) ADDRESS; PROCEND; SPATH:E (ZZ1) EXTERNAL;DECLARE (ZZ1)ADDRESS;END; WRITEU :PROCEDURE (ZZ1,ZZ2) EXTERNAL;DECLARE (ZZ1,ZZ2)ADDRESS;END; DECLARE FOREVER RAM$VERSION$NUMBER$STRING (*) BYTE DATA ('program_version_number=V1.0',0); DECLARE LIT LITERALLY 'LITERALLY', DCL Le, in any */ /* form or by any means, electronic, mechanical, magnetic, */ /* optical, chemical, manual or otherwUCTURE (DEV BYTE, NAME (6) BYTE, EXT (3) BYTE, DEV$TYPE BYTE, DRIVE$TYPE BYTE); DCL (COLD$START$CO) BYTE; DCL (CH) BYTE; .. . . . . ..............//////// / / / PROC (A,B,C) EXTERNAL; DCL (A,B,C) ADDRESS; PROCEND; CONSOL: PROC (A,B,C) EXTERNAL; DCL (A,B,C) ADDRESS; PROCEND; WHOCON:LITERALLY'WHILE 1'; DECLARE TRUE LITERALLY'255'; /* ENDPEX */ $LIST DECLARE CAPACITY ADDRESS; CAPACITY = MIN(32512,MEMCK-IT 'DECLARE', TRUE LIT '0FFH', FALSE LIT '000H', PROC LIT 'PROCEDURE', PROCEND LIT 'END', THENDO LIT 'THEN DO;', ise, without the prior */ /* written permission of Intel Corporation, 3065 Bowers */ /* Avenue, Santa Clara, CaliCALL RESCAN (1, .STATUS); CALL READ (1, .MEMORY, 128, .ACTUAL, .STATUS); /* Get command tail. */ CMND = .MEMORY + ACTUAL; CMNWAIT$MOD: DO; /************************************************************************/ /* */ /* '(C PROC (A,B) EXTERNAL; DCL (A,B) ADDRESS; PROCEND; IOCHK: PROC BYTE EXTERNAL; PROCEND; CSTS: PROC BYTE EXTERNAL; .MEMORY); FATAL = TRUE; CALL READC(.MEMORY,100); CALL OPENU(.MEMORY); DO FOREVER; CALL READU(.MEMORY,CAPACITY); IF ACTUA ELSEIF LIT 'END; ELSE IF', ELSEDO LIT 'END; ELSE DO;', IFEND LIT 'END', WHILEND LIT 'END', CR LIT '0DH', LF fornia, 95051, Attn: Software */ /* License Administration. */ /* */ /*********************D$PTR = .MEMORY; DO WHILE CMND$PTR < CMND; IF CMND$CH (0) = '&' THENDO CMND$CH (1) = CR; CMND$CH (2) = LF; CALL WRIT) Intel Corporation 1981'. All rights reserved. No */ /* part of this program or publication may be reproduced, */  PROCEND; CI: PROC BYTE EXTERNAL; PROCEND; CO: PROC (A) EXTERNAL; DCL (A) BYTE; PROCEND; DCL (STATUS,L = 0 THEN CALL EX; SCAN$P = .MEMORY; DO WHILE SCAN$P < .MEMORY + ACTUAL; SCAN$BYTE = FORCUP; SCAN$P = SCAN$P + 1; LIT '0AH'; EXIT: PROC EXTERNAL; PROCEND; RESCAN: PROC (A,B) EXTERNAL; DCL (A,B) ADDRESS; PROCEND; READ: PROC (/     $ TITLE ('WHICH -- VERSION_NUMBER_SEARCHER') WHICH$MOD: DO; /************************************************************FTN,ERROR) ADDRESS; END OPEN; READ: PROCEDURE (AFTN,BUFFER,COUNT,ACTUAL,STATUS) EXTERNAL; DECLARE (AFTN,BUFFER,COUNT,A(':TO: '), .FILE2); CALL CONSOL (.FILE1, .FILE2, .STATUS); ELSEIF COLD$START$CO = 1 THENDO /* Cold start CONSOL is crt. * */ /**************************************************************/ CLOSE: PROCEDURE (AFTN,STATUS) EXTERNAL; p to count the seconds here. */ DO WHILE NOT CSTS; /* No keys hit yet, just wait. */ CALL TIME (250); CH = CH + 1; IF065 Bowers */ /* Avenue, Santa Clara, California, 95051, Attn: Software */ /* License Administration. MND$PTR = CMND$PTR + 1; WHILEND; CALL WHOCON (0, .FILE1); /* Find out what the :CO: file is. */ CALL SPATH (.FILE1, .PN, .S************/ /* */ /* '(C) Intel Corporation 1981'. All rights reserved. No */ /* part of thi/ CALL MOVE (5, .(':VI: '), .FILE1); CALL MOVE (5, .(':VO: '), .FILE2); CALL CONSOL (.FILE1, .FILE2, .STATUS); IFDECLARE (AFTN,STATUS) ADDRESS; END CLOSE; CO: PROCEDURE (CHAR$CO) EXTERNAL; DECLARE CHAR$CO BYTE; END CO; ERROR: CH = 199 THENDO /* Ring bell once every 5 second or so. */ CH = 0; CALL CO (7); IFEND; WHILEND; CH = CI AND 7FH;*/ /* */ /************************************************************************/ DECLARE COPYRIGHT (*) TATUS); COLD$START$CO = IOCHK AND 3; IF (PN.DEV = 7) AND (COLD$START$CO = 0) THENDO /* :CO: = :TO: */ ELSEIF (PN.DEV = 9) ANDs program or publication may be reproduced, */ /* transmitted, transcribed, stored in a retrievel system, or */ /* END; CALL EXIT; IFEND; WHILEND; END WAIT$MOD;  PROCEDURE (ERROR$NUMBER) EXTERNAL; DECLARE ERROR$NUMBER ADDRESS; END ERROR; EXIT: PROCEDURE EXTERNAL; END EXIT; IF CH = CR THENDO /* Got a CR, exit and continue. */ CALL EXIT; ELSEIF CH = 03H THENDO /* Got an Control-C, abort the reBYTE DATA ('(C) INTEL CORP 1981'); DECLARE PROGRAM$VERSION$NUMBER$STRING (*) BYTE DATA ('program_version_number=',1,'V1. (COLD$START$CO = 1) THENDO /* :CO: = :VO: */ ELSEDO CMND$PTR = .MEMORY; DO WHILE CMND$PTR < CMND; CALL CO (CMND$CH (0)) translated into any language or computer language, in any */ /* form or by any means, electronic, mechanical, magnetic,1 //////////////00000000 0 0 0 0 0000000000000011111111 1 1 1 1 1111111111 OPEN: PROCEDURE(AFTN,FILENAME,ACCESS$MODE,LINE$EDIT$AFTN,ERROR) EXTERNAL; DECLARE (AFTN,FILENAME,ACCESS$MODE,LINE$EDIT$Ast. */ IF COLD$START$CO = 0 THENDO /* Cold start CONSOL is tty. */ CALL MOVE (5, .(':TI: '), .FILE1); CALL MOVE (5, .0D',0); /**************************************************************/ /* EXTERNAL PROCEDURES ; CMND$PTR = CMND$PTR + 1; WHILEND; IFEND; /* Wait for CR or Control-C. */ DO WHILE TRUE; CH = 198; /* Used as a tem */ /* optical, chemical, manual or otherwise, without the prior */ /* written permission of Intel Corporation, 30      LIT '1', SPACE LIT '020H', /* plm */ TAB CK$STATUS: PROCEDURE (ISIS$STATUS); DECLARE ISIS$STATUS ADDRESS; IF ISIS$STATUS <> 0 THEN DO;  LIT '0H', /* plm */ LF LIT '0AH', /* plm */ TH ADDRESS; DECLARE PROGRAM$MSG$PRINTED BOOLEAN; /********************************************************/ /* NK LIT '020H', /* plm */ BOOLEAN LIT 'BYTE', T$FOUND$MSG (*) BYTE INITIAL (' file does not contain a program version number', CR,LF); DECLARE FILE$NAME (15) BCTUAL,STATUS) ADDRESS; END READ; WRITE: PROCEDURE (AFTN,BUFFER,COUNT,STATUS) EXTERNAL; DECLARE (AFTN,BUFFER,COUNT,STAT LIT '09H', /* plm */ TRUE LIT '0FFH'; /* plm */ NO$LINE$EDIT LIT '0', /* open */ OPEN$FOR$READ LIT '1',  UTILITY PROCEDURES */ /********************************************************/ SKIP$BLANKS$N$TABS:  /* plm */ CHK LIT 'CALL CHECK$STATUS(STATUS)', /* plm */ CONSOLE$INPUT YTE INITIAL (':F0: '); DECLARE BUFFER(READ$BUFFER$LENGTH) BYTE; DECLARE SUCCESSFUL$FIND BYTE; DECLARE END$OF$FUS) ADDRESS; END WRITE; /*************************************************************/ /* LITERALLY DECLA $EJECT /************************************************************/ /* GLOBAL VARIABLE DECLARATION  /* open */ OPEN$FOR$WRITE LIT '2', /* open */ READ$BUFFER$LENGPROCEDURE (CHAR$PTR) ADDRESS ; DECLARE CHAR$PTR ADDRESS; DECLARE CHAR BASED CHAR$PTR BYTE; DO WHILE (CHAR = LIT '1', CONSOLE$OUTPUT LIT '0', CR LIT '0DH', ILE BYTE; DECLARE STATUS ADDRESS; DECLARE ACTUAL ADDRESS; DECLARE AFTN$IN ADDRESS; DECLARE I BYTE; DECLARE (LEN, LENRATION */ /*************************************************************/ DECLARE  */ /************************************************************/ DECLARE STRING$TO$SEARCH (*) BYTE INITIAL TH LIT '2048', /* plm */ SENTINEL$0 LIT '0', SENTINEL$1  BLANK) OR (CHAR = TAB); CHAR$PTR = CHAR$PTR + 1; END; RETURN CHAR$PTR; END SKIP$BLANKS$N$TABS; CHE /* plm */ CRLF LIT '0DH,0AH', /* plm */ FALSE 1) ADDRESS; DECLARE STRING$INDEX BYTE; DECLARE BUFFER$INDEX ADDRESS; DECLARE BUFFER$PTR ADDRESS; DECLARE VERSION$MSG$LENG LIT LITERALLY 'LITERALLY', BELL LIT '07H', /* plm */ BLA ('program_version_number='); DECLARE FOUND$MSG (*) BYTE INITIAL (' program version number is '); DECLARE NO1     (4); /* illegal filename specification */ CALL EXIT; END; RETURN TMP$PTR; END FILE$NAME$LENGTH;VERSION$TYPE$X) THEN DO; CHAR$PTR = CHAR$PTR + 1;  FILE$NAME$LENGTH: PROCEDURE(PTR) BYTE; DECLARE PTR ADDRESS; DECLARE CHAR BASED PTR BYTE; DECLARE TMP$V OR VERSION$TYPE$X THEN DO; VERSION$MSG$LENGTH = 4; PROGRAM$MSG$PRINTED = TRUE; TALIZE: PROCEDURE(PTR, LEN); DECLARE PTR ADDRESS, CHAR BASED PTR BYTE; DECLARE LEN BYTE; STRING$INDEX >= LEN1 THEN RETURN TRUE; ELSE RETURN FALSE; END STRING$FOUND; CHECK$VERSION$NUMBE CALL ERROR(ISIS$STATUS); CALL EXIT; END; END CHECK$STATUS; STOP$EVERYTHING: PROCEDURE(MSG$PTR);  STRING$FOUND: PROCEDURE (BUFFER$PTR, LEN0) BOOLEAN; DECLARE BUFFER$PTR ADDRESS; DECLARE LEN0 ADDRESS;$PTR ADDRESS; TMP$PTR = PTR; DO WHILE ( CHAR >= 'A' AND CHAR <= 'Z' ) OR ( A /11122222222 2 2 2 2 222222222222223333 DECLARE I BYTE; DO I = 1 TO LEN; IF CHAR >= 'a' AND CHAR <= 'z' THEN CHAR = CHAR - SR: PROCEDURE(CHAR$PTR) ; DECLARE CHAR$PTR ADDRESS, CHAR BASED CHAR$PTR BYTE; DECLARE (VERSION DECLARE MSG$PTR ADDRESS, MSG BASED MSG$PTR (256) BYTE; DECLARE MSG$LENGTH ADDRESS; MSG$LENGTH = 0;  DECLARE BUFFER$CHAR BASED BUFFER$PTR(256) BYTE; BUFFER$INDEX = 0; DO WHILE BUFFER$INDEX < LEN0 AND STSCII$DIGIT(CHAR) ) OR CHAR = '.' OR CHAR = ':' ;  CHAR$PTR = CHAR$PTR + 1; IF ASCII$DIGIT(CHAR) THEN DO; CHAR$PTRPACE; PTR = PTR + 1; END; END CAPITALIZE; ASCII$DIGIT: PROCEDURE (CHAR) BOOLEAN; DECLARE CHAR BY$TYPE$V, VERSION$TYPE$X) BYTE; VERSION$TYPE$V, VERSION$TYPE$X = FALSE; IF CHAR = 'V' THEN VERSIO DO WHILE (MSG(MSG$LENGTH) <> 0) AND (MSG$LENGTH < 255); MSG$LENGTH = MSG$LENGTH + 1; END; CALL WRITERING$INDEX < LEN1; IF BUFFER$CHAR(BUFFER$INDEX) = STRING$TO$SEARCH(STRING$INDEX) THEN STRING$INDEX = STR PTR = PTR + 1; END; TMP$PTR = PTR - TMP$PTR; IF TMP$PTR > 14 THEN DO; CALL ERROR = CHAR$PTR + 1; IF (CHAR = '.' AND VERSION$TYPE$V) OR (ASCII$DIGIT(CHAR) AND TE; IF CHAR >= '0' AND CHAR <= '9' THEN RETURN TRUE; ELSE RETURN FALSE; END ASCII$DIGIT; N$TYPE$V = TRUE; ELSE IF CHAR = 'X' THEN VERSION$TYPE$X = TRUE; IF VERSION$TYPE(CONSOLE$OUTPUT, MSG$PTR, MSG$LENGTH, .STATUS); CHK; CALL CO(BELL); CALL EXIT; END STOP$EVERYTHING; CAPIING$INDEX + 1; ELSE STRING$INDEX = 0; BUFFER$INDEX = BUFFER$INDEX + 1; END; IF 2     LEN + 4; FILE$NAME(I) = CHAR; CHAR$PTR = CHAR$PTR + 1; END; CHAR$PTR = SKIP$BLANKS$N$TABS(CHAR$PTK; CALL WRITE(CONSOLE$OUTPUT, .(CRLF), 2, .STATUS); CHK; END; ELSE DO; CAL BYTE; DECLARE CHAR$PTR ADDRESS, CHAR BASED CHAR$PTR BYTE; CALL READ(CONSOLE$INPUT, .COMMAND$TAIL, LENGTH( IF SUCCESSFUL$FIND THEN END$OF$FILE = TRUE; END; END; END; ENESSAGE LENGTH */ VERSION$MSG$LENGTH = VERSION$MSG$LENGTH + 1; CHAR$PTR = CHAR$PTR + 1;  IF ACTUAL < READ$BUFFER$LENGTH THEN END$OF$FILE = TRUE; BUFFER$PTR = .BUFFER; DO  IF ASCII$DIGIT(CHAR) THEN RETURN; END; R ); IF CHAR <> CR THEN CALL STOP$EVERYTHING(.('Syntax is "WHICH " ',CR, LF, 0)); END PARSE$COMMAND$TACOMMAND$TAIL), .ACTUAL, .STATUS); CHK; COMMAND$TAIL(ACTUAL - 1) = CR; CALL CAPITALIZE(.COMMAND$TAIL, D SEARCH$FOR$STRING; PRINT$RESULT: PROCEDURE; IF SUCCESSFUL$FIND THEN DO; IF PROGRAM$MSG END; RETURN; END; SUCCESSFUL$FIND = FALSE; STRING$INDEX = 0; END CHECK$VERSIOWHILE NOT SUCCESSFUL$FIND AND BUFFER$PTR < .BUFFER(ACTUAL); SUCCESSFUL$FIND = STRING$FOUND(BUFFER$PTR,  END; END; IF CHAR = SENTINEL$1 THEN DO; /* LOOK FOR 1...0 COMBINATION */ CHAR$PTR = CHAR$PIL; SEARCH$FOR$STRING: PROCEDURE; CALL OPEN(.AFTN$IN, .FILE$NAME, OPEN$FOR$READ, NO$LINE$EDIT, .STATUS); ACTUAL); CHAR$PTR = SKIP$BLANKS$N$TABS(.COMMAND$TAIL); LEN = FILE$NAME$LENGTH(CHAR$PTR); IF CHAR = ':' THEN $PRINTED THEN DO; CALL WRITE(CONSOLE$OUTPUT, .FOUND$MSG, LENGTH(FOUND$MSG), .STATUS); N$NUMBER; /*******************************************************/ /* MAIN PROCEDURES * .BUFFER(ACTUAL) - BUFFER$PTR); BUFFER$PTR = BUFFER$PTR + BUFFER$INDEX; TR + 1; /* ADVANCE BEYOND THE SENTINEL */ BUFFER$PTR = BUFFER$PTR + 1; /* DON'T PRINT THE SENTINEL */  CHK; LEN1 = LENGTH(STRING$TO$SEARCH); SUCCESSFUL$FIND, END$OF$FILE = FALSE; STRING$INDEX = 0;  DO I = 0 TO LEN; FILE$NAME(I) = CHAR; CHAR$PTR = CHAR$PTR + 1; END; ELSE DO I = 4 TO  CHK; END; CALL WRITE(CONSOLE$OUTPUT, BUFFER$PTR, VERSION$MSG$LENGTH, .STATUS); CH/ /*******************************************************/ PARSE$COMMAND$TAIL: PROCEDURE; DECLARE COMMAND$TAIL(140) IF SUCCESSFUL$FIND THEN DO; CALL CHECK$VERSION$NUMBER(BUFFER$PTR);  PROGRAM$MSG$PRINTED = FALSE; VERSION$MSG$LENGTH = 0; DO WHILE CHAR <> SENTINEL$0; /* DETERMINE THE M DO WHILE NOT END$OF$FILE; CALL READ(AFTN$IN, .BUFFER, READ$BUFFER$LENGTH, .ACTUAL, .STATUS); CHK; 3     ROGRAM$VERSION$NUMBER$STRING (*) BYTE DATA ('program_version_number=V1.0',0); DECLARE LIT LITERALLY 'LITERALLY', TERNAL; DCL (PTR,LEN) ADDRESS; END; READ1: PROC (PTR,LEN) EXTERNAL; DCL (PTR,LEN) ADDRESS; Euage, in any */ /* form or by any means, electronic, mechanical, magnetic, */ /* optical, chemical, manual or oth NAME$ADDED LIT '1', NEW$LINE LIT '3', DONE LIT '0'; DCL NO$NUM$EXTEN5333 3 3 3 3 3333333333333344444444 4 4 4 4 4444444444444455555555 5 5 5 5 555CK$ISIS$STATUS(STATUS)', TOEND LIT '7FFFH', TOBEG LIT '08000H' ; DCL comtrace L WRITE(CONSOLE$OUTPUT, .NOT$FOUND$MSG, LENGTH(NOT$FOUND$MSG), .STATUS); CHK; END;  DCL LIT 'DECLARE', TRUE LIT '0FFH', FALSE LIT '000H', PROC LIT erwise, without the prior */ /* written permission of Intel Corporation, 3065 Bowers */ /* Avenue, Santa Clara, CSION LIT '0FFFFH'; $EJECT EXIT: PROC EXTERNAL; END; RESCAN: PROXLATE2$MOD: DO; /************************************************************************/ /* */ /*  LIT '/*'; /* for debugging procedure trace */ DCL PCNT$0$TYPE LIT '0', PCNT$0$DOT$TYPE CALL CLOSE(AFTN$IN, .STATUS); CHK; END PRINT$RESULT; $EJECT /*********************************************************/ 'PROCEDURE', ENDPROC LIT 'END;', THENN LIT 'THEN DO;', ELLSE LIT 'END; ELSEalifornia, 95051, Attn: Software */ /* License Administration. */ /* */ /******************C (AFT,ST) EXTERNAL; DCL (AFT, ST) ADDRESS; END; CO: PROC (CHR) EXTERNAL; DCL CHR BYTE; '(C) Intel Corporation 1981'. All rights reserved. No */ /* part of this program or publication may be reproduced, *LIT '1', PCNT$0$DOT$EXT$TYPE LIT '2', NUMB$0$TYPE LIT '3'; DCL NAME$DOT$TYPE LIT '0',  /* MAIN EXECUTABLE CODE */ /*********************************************************/ CA DO;', ELSIF LIT 'END; ELSE IF', ENDIF LIT 'END;', ENDDO LIT 'END;', ******************************************************/ DECLARE COPYRIGHT (*) BYTE DATA ('(C) INTEL CORP 1981'); DECLARE P END; READC: PROC (PTR,LEN) EXTERNAL; DCL (PTR,LEN) ADDRESS; END; READI: PROC (PTR,LEN) EX/ /* transmitted, transcribed, stored in a retrievel system, or */ /* translated into any language or computer lang NAME$DOT$EXT$TYPE LIT '1', NAME$ONLY$TYPE LIT '2'; DCL UNKNOWN$TYPE LIT '10'; DCL LL PARSE$COMMAND$TAIL; CALL SEARCH$FOR$STRING; CALL PRINT$RESULT; CALL EXIT; END WHICH$MOD;  CR LIT '0DH', LF LIT '0AH', NULL LIT '0', CHK LIT 'CALL CHE4     C (PTR) EXTERNAL; DCL PTR ADDRESS; END; WRITEO: PROC(P,L) EXTERNAL; DCL (P,L) ADDRESS TYPE BYTE); DCL FILL$INDEX BYTE; DCL MAX$FILLS LIT '30'; DCL FILL$ARRAY (MAX$FILLS) STRUCTURE ( FILL$PTR ADDRESS,  END; OUT$PRINT: PROC (PTR) EXTERNAL; DCL PTR ADDRESS; END; OUT$DEC$R: PROC (VAL,W) EX SCANBYTE BASED SCANP BYTE, SCANP$TMP ADDRESS; DCL BLOKNO ADDRESS, BYTENO ADDRESS; /**************************TERNAL; DCL (P1,P2) ADDRESS; END; SEEK: PROC (A,M,B,C,S) EXTERNAL; DCL (A,M,B,C,S) ADDRESS; EEND; GETD: PROC(DRIVE,CON,COUNT,ACTUAL$COUNT,BUFFER,STATUS) EXTERNAL; DCL (DRIVE,CON,COUNT,ACTUAL$COUNT,BUFFER,STATUS) AND; OPENO: PROC (PTR) EXTERNAL; DCL PTR ADDRESS; END; OPENI: PROC (PTR) EXTERNAL; DCL PTR; END; WRITEC: PROC(P,L) EXTERNAL; DCL (P,L) ADDRESS; END; ERROR: PROC(ERROR$NO) EXTERNAL; DCL VAL ADDRESS, W BYTE; END; DEC$IN: PROC ADDRESS EXTERNAL; E******************* G L O B A L S T R U C T U R E S *********************************************/ DCL NAMEINDEX ADDRND; SCANMATCH: PROC(P)BYTE EXTERNAL; DCL P ADDRESS; END; SCAN$WHILE:PROC(P) EXTERNAL; DCL P DDRESS; END; WRITE:PROC(AFTN,BUFFER,COUNT,STATUS) EXTERNAL; DCL (AFTN,BUFFER,COUNT,STATUS) ADDRESS;  ADDRESS; END; OPEN1: PROC (PTR,MO) EXTERNAL; DCL PTR ADDRESS,MO BYTE; END; CLOSEO: PROTERNAL; DCL ERROR$NO ADDRESS; END; MEM$CK: PROC ADDRESS EXTERNAL; END; DEL: PROC(PTR) EXTERNAL; DCL PTR ADDRESS; END; FMOVE: PROC (C,S,D) EXTERNAL; DCL (C,ESS; DCL MAXINDEX LIT '200'; DCL NAME$LIST (MAXINDEX) STRUCTURE ( DRIVE (4) BYTE,  ADDRESS; END; SCAN$UNTIL:PROC(P) EXTERNAL; DCL P ADDRESS; END; TERM$CH:  END; DCL (STATUS,REPORT,ERRED,FATAL,ACTUAL) ADDRESS EXTERNAL; DCL (SCANP,OBUFP,GIVEUP) ADDRESS C EXTERNAL; END; CLOSEI: PROC EXTERNAL; ND; SPATH: PROC(FILE,BUFFER,STATUS) EXTERNAL; DCL (FILE,BUFFER,STATUS) ADDRESS; END; S,D) ADDRESS; END; WHOCI: PROC (PTR) EXTERNAL; DCL PTR ADDRESS; END; WHOCO: PRO NAME (6) BYTE, EXT (3) BYTE, PROC BYTE EXTERNAL; END; OUT$CHAR: PROC (CHAR) EXTERNAL; DCL CHAR BYTE; EXTERNAL, (SCANENDED,TARLEN,JOKER) BYTE EXTERNAL; DCL LEADCHAR BYTE EXTERNAL; $EJECT DCL END; CLOSE1: PROC EXTERNAL; END; CONS: PROC (P1,P2) EX LOAD: PROC(FILE,BIAS,SWITCH,ENTRY,STATUS) EXTERNAL; DCL (FILE,BIAS,SWITCH,ENTRY,STATUS) ADDRESS; 5      FILENAME (6) BYTE, EXTENSION (3) BYTE, ATTRIBUTES BYTE, EOF$COL > 0; CALL PRINT(.('.',0)); VAL = VAL - 1; ENDDO CALL PRINT(.MPLATE ADDRESS; DCL MONITOR ADDRESS DATA(0); DCL CONNECTION ADDRESS INITIAL(0); DCL MEM$TOP ADDRESS; DCL END$OF$DIRECTORY ADUT,5); CALL OUTPRINT(.(') ',0)); CALL OUTCHAR(NULL); CALL PRINT(.MSG$BUF); CALL PRINT$CR$EXIT(PTR); E) BYTE; DCL (FROM$PTR, FILL$PTR) ADDRESS; DCL ENDOFLIST BYTE; DCL DEBUG$FLAG BYTE INITIAL (FALSE); D CHR <> NULL; PTR = PTR + 1; ENDDO CALL WRITEC(TMP$PTR,PTR-TMP$PTR); END PRINT; PRINT$CR: PROC (PTR); DCL PTR TYPE BYTE, EXT (4) BYTE, UNT BYTE, NUM$DATA$BLKS ADDRESS, HEADER$BLK$PTR ADDRESS); DCL DIR$NAME (50) BYTE AT (.DIRECTODRESS; DCL READING$REMOTE BYTE; /********************************************* D I R E C T O R Y G L O B A L S ****NDIF END CHK$STATUS; CHECK$ISIS$STATUS: PROC(ISIS$STATUS); DCL ISIS$STATUS ADDRESS; IF ISIS$STATUS <> 0 THEN CL HALT$FLAG BYTE INITIAL (FALSE); DCL SCRUNCH$FLAG BYTE INITIAL (FALSE); DCL TARGET (10) BYTE PUBLIC  ADDRESS; CALL PRINT(PTR); CALL PRINT(.(CR,LF,0)); END PRINT$CR; PRINT$CR$EXIT: PROC (PTR); DCL PTR ADDRESS; CAL DRIVE (4) BYTE); /********************************************* G L O B A L V A R I A B RY$NAME); $EJECT /********************************************* C O M M O N P R O C E D U R E S **********************************************************/ DCL DIR$TO$SEARCH BYTE; DCL DIRECTORY$NAME (*) BYTE DATA(':F :ISIS.DIR '); DCL DIR DO; CALL ERROR(ISIS$STATUS); CALL MONITOR; END; END CHECK$ISIS$STATUS; comtrace BEG$PR$DEBUG: PROC (; DCL READBUF (129) BYTE; DCL MSG$BUF (128) BYTE; DCL BLANK$STR (16) BYTE DATA(' '); DCL NULLSTL PRINT$CR(PTR); CALL EXIT; END; CHK$STATUS: PROC (PTR); DCL PTR ADDRESS; DCL STATUS$OUT ADDRESS; IF STATUS <> 0L E S *********************************************/ DCL FRONT$EXT LIT '512', READ$LEN LIT '1024'; 38555555555566666666 6 6 6 6 6666666666666677777777 7 7 7 7 77777777777777$BUF (16384) BYTE; DCL DIR$ENTRY$PTR ADDRESS, DIR$ENTRY BASED DIR$ENTRY$PTR STRUCTURE (PRESENCE BYTE,  PTR,VAL,PROC$PTR); DCL (PTR,PROC$PTR) ADDRESS, VAL BYTE; IF DEBUG$FLAG THENN DO WHILE VARING(16) BYTE DATA(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); DCL DR$STR(4) BYTE DATA(':F#:'); DCL LENGTH$TO$WRITE$FROM$TE THENN STATUS$OUT = STATUS; CALL PRINT(.('bad status (= ',0)); OBUFP = .MSG$BUF; CALL OUT$DEC$R(STATUS$ODCL TEMPLATE (1536) BYTE; DCL PAD BYTE; /* this is a pad for template, do not disturb */ DCL INVOK$NAME (16****************************/ PRINT: PROC (PTR); DCL (TMP$PTR,PTR) ADDRESS,CHR BASED PTR BYTE; TMP$PTR = PTR; DO WHILE6      (CHAR) BYTE; DCL CHAR BYTE; RETURN( LET$OR$DIG$CH$WP(CHAR) OR DOT$CH$WP(CHAR) OR COLON$CH$WP(CHAR)); END FILE$CH$WP; ANBYTE) OR DOT$CH$WP(SCANBYTE)OR COLON$CH$WP(SCANBYTE) ); END FILE$CH; BLANK$CH: PROC BYTE; RETURN(BLANK$CH$ CHAR <= 'Z') ); END LET$CH$WP; DIG$CH$WP: PROC (CHAR) BYTE; DCL CHAR BYTE; RETURN ((CHAR >= '0' AND CHAR <= PROC BYTE; RETURN(SCANBYTE='('); END LP; COMMA: PROC BYTE; RETURN(SCANBYTE=','); END COMMA; ENDIF END END$PR$DEBUG; /* opt */ DEBLANK: PROC (PTR) ADDRESS; DCL PTR ADDRESS,CHR BASCE$LESS$OR$EQUAL; ENFORCE$GREATER$OR$EQUAL: PROC (VAL,LIM$VAL,PROC$PTR); DCL(VAL,LIM$VAL,PROC$PTR) ADDRESS; IF VAL < ('entering ',0)); CALL PRINT$CR(PTR); CALL PROC$PTR; ENDIF END BEG$PR$DEBUG; BLANK$CH$WP: PROC (CHAR) BYTE; DCL CHAR BYTE; RETURN (CHAR = ' '); END BLANK$CH$WP; LENGTH$OF: PROC  '9')); END DIG$CH$WP; LET$OR$DIG$CH$WP: PROC (CHAR) BYTE; DCL CHAR BYTE; RETURN (LET$CH$WP(CHAR) OR DIG$CH$WP(CHAR) DIG$CH: PROC BYTE; RETURN(DIG$CH$WP(SCANBYTE)); END DIG$CH; LET$OR$DIG$CH: PROC BYTE; RETURN (LET$OR$DIG$ED PTR BYTE; DO WHILE CHR = ' '; PTR = PTR + 1; ENDDO RETURN PTR; END DEBLANK; LESSER$OF: PROC (VAL1,VAL2) ADDRESS;LIM$VAL THEN CALL PROC$PTR; END ENFORCE$GREATER$OR$EQUAL; ENFORCE$WITHIN$BOUNDS: PROC (VAL,HI$LIM,LO$LIM,PROC$PTR); DCL( comtrace END$PR$DEBUG: PROC( PTR,VAL,PROC$PTR); DCL (PTR,PROC$PTR) ADDRESS, VAL BYTE; IF DEBUG$FLAG(PROC$PTR) ADDRESS; DCL (PROC$PTR,TMP$PTR,LEN) ADDRESS; TMP$PTR = SCANP; CALL SCANWHILE(PROC$PTR); LEN = SCANP - TMP); END LET$OR$DIG$CH$WP; DOT$CH$WP: PROC (CHAR) BYTE; DCL CHAR BYTE; RETURN (CHAR = '.'); END DOT$CH$WP; CH$WP(SCANBYTE)); END LET$OR$DIG$CH; DOT$CH: PROC BYTE; RETURN(DOT$CH$WP(SCANBYTE)); END DOT$CH; COLON$CH:  DCL (VAL1,VAL2) ADDRESS; IF VAL1 > VAL2 THENN RETURN VAL2; ELLSE RETURN VAL1; ENDIF END LESSER$OF; VAL,HI$LIM,LO$LIM,PROC$PTR) ADDRESS; CALL ENFORCE$LESS$OR$EQUAL(VAL,HI$LIM,PROC$PTR); CALL ENFORCE$GREATER$OR$EQUAL(VAL, THENN DO WHILE VAL > 0; CALL PRINT(.('.',0)); VAL = VAL - 1; $PTR; SCANP = TMP$PTR; RETURN LEN; END LENGTH$OF; NULL$PROC: PROC; SCANP = SCANP; END NULL$PROC; ENFORCE$LESS$OCOLON$CH$WP: PROC (CHAR) BYTE; DCL CHAR BYTE; RETURN (CHAR = ':'); END COLON$CH$WP; FILE$CH$WP: PROC PROC BYTE; RETURN(COLON$CH$WP(SCANBYTE)); END COLON$CH; FILE$CH: PROC BYTE; RETURN(LET$OR$DIG$CH$WP(SCLET$CH$WP: PROC (CHAR) BYTE; DCL CHAR BYTE; RETURN ( (CHAR >= 'a' AND CHAR <= 'z') OR (CHAR >= 'A' ANDLO$LIM,PROC$PTR); END ENFORCE$WITHIN$BOUNDS; LET$CH: PROC BYTE; RETURN(LET$CH$WP(SCANBYTE)); END LET$CH; LP:ENDDO CALL PRINT(.('leaving ',0)); CALL PRINT$CR(PTR); CALL PROC$PTR; R$EQUAL: PROC (VAL,LIM$VAL,PROC$PTR); DCL(VAL,LIM$VAL,PROC$PTR) ADDRESS; IF VAL > LIM$VAL THEN CALL PROC$PTR; END ENFOR7     IF CALL EXIT; /* f i n i s h e d ! ! ! */ comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC);  BASED B$PTR$PTR ADDRESS; DCL TMP$PTR ADDRESS; comtrace DCL PROC$NAME (*) BYTE DATA('set$fill$drive',0);  ')); /* new :ci:, same :co: */ SCANP = CI$PTR + 1; IF SCANBYTE = 'F' THENN /* old :ci: = :f?:... --> dels an array of pointers into the expanded template. 4) fill an array describing the type of sub. parameter, pr16) BYTE; DCL CI$PTR ADDRESS; LP: PROC BYTE; RETURN (SCANBYTE='('); END LP; COMMA: PROC BYTE; RETURN ($INDEX = 0; READBUF(128) = CR; comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */ END FIRST$INIT; $EJECTWP(SCANBYTE)); END BLANK$CH; NULL$CH: PROC BYTE; RETURN (SCANBYTE = NULL); END NULL$CH; ENFORCE$NO$TOKENS: /* opt */ END RESTORE; $EJECT /*************************************************** I N I T I A L I Z A T I O lete */ DCL MSG(*) BYTE DATA('xlate2 error: restore seek',0); CALL DEL(.NAME$CI); /* and console oveeceding drive # , etc. *****************************************************/ BUILD$TEMPLATE: PROC ; DCL (BEG$SUB$PTR,ENSCANBYTE=','); END COMMA; comtrace DCL PROC$NAME (*) BYTE DATA('restore',0); /* opt */ comtrace CALL BEG$ /**************************************************** T E M P L A T E P R O C E S S I N G P R O C PROC; DO WHILE NOT TERM$CH ; IF NOT BLANK$CH THENN CALL PRINT$CR$EXIT(.('only blanks allowed after &',0)); N ***************************************************/ FIRST$INIT: PROC; DCL TMP$PTR ADDRESS; comtrace DCL PROC$NAMEr to old pos */ CALL CHK$STATUS(.('cannot delete .cs file',0)); CALL SCANUNTIL(.LP); BLOKNO = DEC$IN; D$SUB$PTR) ADDRESS; SUBSTITUTION$FOUND: PROC (F$INDEX,B$PTR$PTR,E$PTR$PTR,LIMIT) BYTE; DCL (F$INDEX, B$PTR$PTR, E$PTPR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */ CALL FMOVE(15,.BLANK$STR,.NAME$CI); /* current :E D U R E S ****************************************************/ /**************************************************** th ENDIF SCANP = SCANP + 1; ENDDO END ENFORCE$NO$TOKENS; RESTORE: PROC; /* this procedure interprets the restor (*) BYTE DATA('first$init',0); /* opt */ comtrace CALL BEG$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */ REPORT = FALSE;CALL SCANUNTIL(.COMMA); BYTENO = DEC$IN; CALL SEEK(1,2,.BLOKNO,.BYTENO,.STATUS); CALL CHK$STATUS(.MSG); ENDR$PTR, LIMIT, TMP$PTR) ADDRESS; SET$FILL$DRIVE: PROC (F$INDEX,B$PTR$PTR); DCL (F$INDEX,B$PTR$PTR) ADDRESS, B$PTRci: */ CALL WHOCI(.NAME$CI); /* current :ci: name saved, file to be deleted */ CALL CONS(CI$PTR:=DEBLANK(SCANP),.(':CO:ese procedures 1) read in the template file 2) expand the template file at the substitution characters 3) file command in the xlate2.cs file */ /* restores the previous :ci: file and deletes the xlate2.cs file */ DCL NAME$CI ( /* set sys.lib status checking to false */ CALL FMOVE(16,.BLANK$STR,.INVOK$NAME); NAME$INDEX = 0; FILL8     Y(F$INDEX).TYPE = NUMB$0$TYPE; ELSIF SCANBYTE = '%' THENN SCANP = SCANP + 2; NBYTE <> '#' ; SCANP = SCANP + 1; ENDDO SCANP = SCANP + 1; IF SCANBYTE = '0' ANace CALL END$PR$DEBUG(.PROC$NAME,3,.NULL$PROC); /* opt */ END SET$FILL$DRIVE; SET$FILL$EXT: PROC (F$INDEX,E$PTR$PTR = SCANP; ENDIF ELLSE CALL PRINT$CR$EXIT(.('xlate2 error: set$fill$index',0)); ENDIF NP; SCANP = SCANP - 2; IF COLON$CH THENN SCANP = SCANP - 3; B$PTR = SCANNGTH$OF(.LET$OR$DIG$CH); IF LEN$EXT > 3 THENN CALL PRINT$CR$EXIT(.('ext part too lo5 :8888888 8 8 8 8 8888888888888899999999 9 9 9 9 99999999999999:::::::: : : : IF BLANK$CH THENN E$PTR = SCANP; FILL$ARRAY(F$INDEX).TYPE = PCNT$0$TYPE; R); DCL (F$INDEX,E$PTR$PTR) ADDRESS, E$PTR BASED E$PTR$PTR ADDRESS; comtrace DCL PROC$NAME (*) B E$PTR = LESSER$OF(E$PTR,.TEMPLATE+FRONT$EXT+ACTUAL); comtrace CALL END$PR$DEBUG(.PROC$NAME,3,.NULL$PROC); P; CALL FMOVE(4,SCANP,.FILL$ARRAY(F$INDEX).DRIVE); SCANP = SCANP + 2; IF SCANBYTE = '?' THEng',0)); ELLSE CALL FMOVE(3,.BLANK$STR ,.FILL$ARRAY(F$INDEX).EXT);  PR$DEBUG: PROC; CALL PRINT(.('fill index : ',0)); OBUFP = .MSG$BUF;  ELSIF DOT$CH THENN SCANP = SCANP + 1; IF NOT (LET$OR$DIG$CH) THENN YTE DATA('set$fill$ext',0); /* opt */ comtrace CALL BEG$PR$DEBUG(.PROC$NAME,3,.NULL$PROC); /* opt */ SCANP  /* opt */ END SET$FILL$EXT; comtrace DCL PROC$NAME (*) BYTE DATA('substitution$found',0); /* opt */ comtraNN CALL FMOVE(1,.DIR$TO$SEARCH,.FILL$ARRAY(F$INDEX).DRIVE(2)); ENDIF ELLSE CALL FMOV CALL FMOVE(LEN$EXT,SCANP,.FILL$ARRAY(F$INDEX).EXT); E$PTR,SCANP = SCANP + LEN$EXT;  CALL OUT$DEC$R(F$INDEX,5); CALL OUT$CHAR(NULL); CALL PRINT$CR(.MSG$BUF);  E$PTR = SCANP; FILL$ARRAY(F$INDEX).TYPE = PCNT$0$DOT$TYPE; ELLSE = SCANP - 1; IF SCANBYTE = '#' THENN E$PTR,SCANP = SCANP + 2; FILL$ARRAce CALL BEG$PR$DEBUG(.PROC$NAME,2,.NULL$PROC); /* opt */ DO WHILE TRUE; DO WHILE SCANBYTE <> '%' AND SCAE(4,.NULL$STRING,.FILL$ARRAY(F$INDEX).DRIVE); B$PTR = SCANP + 1; ENDIF SCANP = TMP$PTR; comtr ENDIF ENDIF ELLSE FILL$ARRAY(F$INDEX).TYPE = UNKNOWN$TYPE; E$PT END PR$DEBUG; CALL BEG$PR$DEBUG(.PROC$NAME,3,.PR$DEBUG); /* opt */ TMP$PTR = SCA DCL LEN$EXT ADDRESS; FILL$ARRAY(F$INDEX).TYPE = PCNT$0$DOT$EXT$TYPE; LEN$EXT = LE9     ns exceeded',0)); ENDIF ENDDO IF FILL$INDEX = 0 THENN CALL PRINT$CR$EXIT( .('no substitution sig); ELSE DO; FREE$SPACE = 0E800H - .MEMORY; COUNT = FREE$SPACE/16; FRONT$EXT; FILL$PTR = .TEMPLATE; DO WHILE SUBSTITUTION$FOUND(FILL$INDEX,.BEG$SUB$PTR,.END$SUB$PTR, DCL COUNT ADDRESS; DCL FREE$SPACE ADDRESS; DCL ACTUAL$ENTRY ADDRESS; DCL ENTRY ADDRESS; comtrace DCL PROC$NAMEENDIF ENDDO END SUBSTITUTION$FOUND; comtrace DCL PROC$NAME (*) BYTE DATA('build$template',0); /* opt */ ROM$PTR; LENGTH$TO$WRITE$FROM$TEMPLATE = FILL$PTR - .TEMPLATE; CALL FMOVE(1,.(0),(FILL$PTR+1)); comtrace CALL END$PRD SCANP <= LIMIT THENN DCL TMP$PTR ADDRESS; TMP$PTR = SCANP; CALL SET$FILL$DRIVE(F$ns in the template',0)); ELLSE FILL$INDEX = FILL$INDEX - 1; ENDIF IF FROM$PTR > .TEMPLATE+ACTUAL+FRONT$EXT  .TEMPLATE(FRONT$EXT+ACTUAL-1)); CALL FMOVE(BEG$SUB$PTR-FROM$PTR,FROM$PTR,FILL$PTR); FILL$PTR = FILL$PTR (*) BYTE DATA('read$directory',0); CALL BEG$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */ DIR$NAME(2) = NAKED comtrace CALL BEG$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */ CALL READI(.TEMPLATE+FRONT$EXT, READ$LEN); C$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */ END BUILD$TEMPLATE; $ EJECT /*********************************************INDEX,B$PTR$PTR); CALL SET$FILL$EXT(F$INDEX,E$PTR$PTR); SCANP = TMP$PTR; comtrace CALL END$PTHENN CALL PRINT$CR$EXIT(.('xlate2 error: build$template',0)); ENDIF CALL FMOVE(.TEMPLATE+FRONT$EXT+ACTUAL-FROM$P + BEG$SUB$PTR-FROM$PTR; FILL$ARRAY(FILL$INDEX).FILL$PTR = FILL$PTR; FILL$PTR = FILL$PTR + 16; FROM$PTR,SCA$DEVICE$NUMBER; CALL SPATH(.DIRECTORY$NAME,.BUFFER,.STATUS); CHK; IF BUFFER(10) = 3 AND BUFFER(11) = 5 THEN ALL CHK$STATUS(.('cannot read template file',0)); TEMPLATE(FRONT$EXT + ACTUAL) = NULL; IF ACTUAL = 1024 THENN ***** D I R E C T O R Y M A N I P U L A T I N G P R O C E D U R E S *************************************R$DEBUG(.PROC$NAME,2,.NULL$PROC); /* opt */ RETURN TRUE; ELSIF SCANP > LIMIT TR, FROM$PTR, FILL$PTR); /* this is a kludge, we want to add the -1 in the fmove but dont because we might end up witNP = END$SUB$PTR; IF (FILL$INDEX := FILL$INDEX + 1) > MAX$FILLS THENN CALL PRINT$CR$EXIT(.('maximum substitutio DO; MEM$TOP = MEM$CK - 13; IF MEM$TOP < 0E800H THEN CALL CHK$STATUS(.('insufficient memory',0) /* syntax chk opt */ CALL PRINT$CR$EXIT(.('template file too large',0)); ENDIF FROM$PTR,SCANP = .TEMPLATE+**************/ READ$DIRECTORY: PROC (NAKED$DEVICE$NUMBER) ; DCL NAKED$DEVICE$NUMBER BYTE; DCL BUFFER(12) BYTE;  THENN comtrace CALL END$PR$DEBUG(.PROC$NAME,2,.NULL$PROC); /* opt */ RETURN FALSE; h a 64k move, so we only adjust the fill$ptr accordingly. */ FILL$PTR = FILL$PTR + .TEMPLATE+FRONT$EXT+ACTUAL - F:     lly numeric ascii sequence. */ DCL PTR ADDRESS, CHAR BASED PTR (10) BYTE; DCL L BYTE; GEST$EXTENSION = 0; /* Grand directory search loop. */ DO WHILE DIR$ENTRY$PTR < END$OF$DIRECTORY; IF NOT READINGREAD$DIRECTORY; GREATEST$EXT: PROC (NAME$PART$PTR) ADDRESS; DCL NAME$PART$PTR ADDRESS; DCL LARGEST$EXTENSION ADDRESS; ELLSE CALL FMOVE(LEN$1,NAME$PTR$1,.COMP$BUF); CALL FMOVE(1,.(0),.COMP$BUF(LEN$1)); TMP = SC CALL CHK$STATUS(.('cannot open directory file',0)); CALL READ1(.DIR$BUF,SIZE(DIR$BUF)); CALL CHK$STATUSND VALUE; NAME$PARTS$MATCH: PROC (NAME$PTR$1,NAME$PTR$2) BYTE; DCL (NAME$PTR$1,NAME$PTR$2) ADDRESS,  CALL LOAD(.(':F0:ISIS.OV0 '),0,0,.ENTRY,.STATUS); CHK; CALL GETD(NAKED$DEVICE$NUMBER-'0',.CONNECTION,COUNT,  DO L=0 TO 2; IF NOT DIG$CH$WP(CHAR(L)) THENN RETURN FALSE; END DCL NUM$EXTENSION$FOUND BYTE; NUMERIC$EXTENSION: PROC (PTR) BYTE; /* Given a pointer into memory, this proceduANP; SCANP = NAME$PTR$2; MATCH = SCAN$MATCH(.COMP$BUF); SCANP = TMP; RETURN MATCH; (.('cannot read directory file',0)); /* Dir$buf is larger than an ISIS V4.0 hard disk directory */ CALL C TMP ADDRESS, COMP$BUF (7) BYTE, MATCH BYTE, (LEN$1,LEN$2) ADDRESS; TMP = SCANP; SCANP = NAME .ACTUAL$ENTRY,.DIR$BUF,.STATUS); CHK; IF ACTUAL$ENTRY >= COUNT THEN CIF ENDDO RETURN TRUE; END NUMERIC$EXTENSION; VALUE: PROC (DIR$EXT$PTR) ADDRESS; DCL DIR$EXTre determines whether the byte pointed to, and the next two contiguous bytes, constitute a who ENDIF END NAME$PARTS$MATCH; comtrace DCL PROC$NAME (*) BYTE DATA('greatest$ext',0); /* opt */ comtrace CALLLOSE1; CALL CHK$STATUS(.('cannot close directory file',0)); READING$REMOTE = FALSE; END$OF$DI$PTR$1; LEN$1 = LESSER$OF(6,LENGTH$OF(.LET$OR$DIG$CH)); SCANP = NAME$PTR$2; LEN$2 = LESSER$OF(6,LENGTH$OF(.ALL CHK$STATUS(.('remote directory too large',0)); READING$REMOTE = TRUE; END$OF$DIRECTORY = .DIR$$PTR ADDRESS; DCL CHAR BASED DIR$EXT$PTR (3) BYTE; DCL T BYTE; DCL RESULT ADDRESS; RESULT = 8< ::::::::::::::;;;;;;;; ; ; ; ; ;;;;;;;;;;;;;;<<<<<<<< < < < < <<<<<<<<<< BEG$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */ DIR$ENTRY$PTR = .DIR$BUF; NUM$EXTENSION$FOUND = FALSE; LARRECTORY = .DIR$BUF + ACTUAL; comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */ END; END LET$OR$DIG$CH)); SCANP = TMP; IF LEN$1 <> LEN$2 THENN RETURN FALSE; BUF + (ACTUAL$ENTRY * 16); END; END; ELSE DO; CALL OPEN1(.DIRECTORY$NAME,1); 0; DO T = 0 TO 2; RESULT = (RESULT * 10) + CHAR(T) - '0'; ENDDO RETURN RESULT; E;      SCANP = .NAME$LIST(N$INDEX).NAME; OBUFP = .TMP$BUF; LENGTH$NAME$PART = LESSER$OF(6,LENGTH$OF(.LET$OR$DIG$CH)); CALL FMed */ IF NUMB$EXT >= 1000 THENN CALL PRINT(.('filename : ',0)); SCANP = .NAME$LI RETURN NO$NUM$EXTENSION; ENDIF END GREATEST$EXT; $EJECT /****************************************************** = LESSER$OF(3,LENGTH$OF(.LET$OR$DIG$CH)); CALL OUTCHAR('.'); CALL FMOVE(LENGTH$EXT,.FILL$ARRAY(F$INDEX).E(.DIR$ENTRY.EXTENSION); IF EXTENSION$NUM > LARGEST$EXTENSION THENN LARGEST$EXTENSION = EXTENSION$NU NAME$DOT$EXT$TYPE THENN DCL LENGTH$EXT BYTE; CALL OUTCHAR('.'); SCANP = .NAME$LIST(N$$REMOTE THEN DO; IF DIR$ENTRY.PRESENCE = 7FH THEN GO TO NO$MORE$DIR; IF DIR$ENTRYOVE(16,.BLANK$STR,OBUFP); IF FILL$ARRAY(F$INDEX).DRIVE(2) = '?' THENN FILL$ARRAY(F$INDEX).DRIVE(2) = DIR$TO$SEARCH; ** O U T P U T P R O C E D U R E S ********************************************************/ FILL$NAME: PROC (XT,OBUFP); ENDDO /* NUMB$0$TYPE */ DO; IF N$TYPE <> NAME$DOT$TYPE THENN DCL M; ENDIF ENDIF ENDIF bump$ptr: DIR$ENTRY$PTR = DIR$ENTRY$PTR + 16; ENDDO no$INDEX).EXT; LENGTH$EXT = LESSER$OF(3,LENGTH$OF(.LET$OR$DIG$CH)); CALL FMOVE(LENGTH$EXT,.NAME$LIST(N$.PRESENCE = 0FFH THEN GO TO BUMP$PTR; END; IF NAME$PARTS$MATCH(.DIR$ENTRY.FILENAME,NAME$PART$PTR)ENDIF IF FILL$ARRAY(F$INDEX).DRIVE(0) <> NULL THENN CALL FMOVE(4,.FILL$ARRAY(F$INDEX).DRIVE,OBUFP); ENDIF; OBUFP N$INDEX, F$INDEX); DCL (N$INDEX,F$INDEX) ADDRESS, (N$TYPE,F$TYPE) BYTE; DCL TMP$BUF (16) BYTE, LENGTH$NAME$PART BYTE; DNUMB$EXT ADDRESS; DCL NAMEPART (7) BYTE; CALL OUT$CHAR('.'); NUMB$EXT = GREATEST$EXT(.more$dir: IF NUM$EXTENSION$FOUND THENN comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opINDEX).EXT,OBUFP); ENDIF ENDDO /* PCNT$0$DOT$TYPE */ DO; ENDDO /* PCNT$0 AND (DIR$ENTRY.PRESENCE <> 0FFH) THENN IF NUMERIC$EXTENSION(.DIR$ENTRY.EXTE= OBUFP + 4; CALL FMOVE(LENGTH$NAME$PART,.NAME$LIST(N$INDEX).NAME,OBUFP); OBUFP = OBUFP + LENGTH$NAME$PART; IF CL MSG (*) BYTE DATA('xlate2 error: fill$name',0); N$TYPE = NAME$LIST(N$INDEX).TYPE; F$TYPE = FILL$ARRAY(F$INDEX).TYPE; NAME$LIST(N$INDEX).NAME); /* For the first version a wholly numeric 3 digit extension is requirt */ RETURN LARGEST$EXTENSION; ELLSE comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */ $DOT$EXT$TYPE */ DO; DCL LENGTH$EXT BYTE; SCANP = .FILL$ARRAY(F$INDEX).EXT; LENGTH$EXTNSION) THENN DCL EXTENSION$NUM ADDRESS; NUM$EXTENSION$FOUND = TRUE; EXTENSION$NUM = VALUE F$TYPE <= 3 THENN DO CASE F$TYPE; /* PCNT$0$TYPE */ DO; IF N$TYPE =<     ANP = TMP$PTR; CALL OPENO(.MSG$BUF); CALL CHK$STATUS(.('cannot open .cs file',0)); END OPEN$CONSOLE$FILE; MA*************************************************** D E B U G G I N G P R O C E D U R E S *************************: PROC; DCL TMP$FILL$INDEX ADDRESS, TMP$NAME$INDEX ADDRESS; DCL FILE$NAME (16) BYTE DATA(':F0:XLATE2.CS ',0); 1; ENDDO TMP$NAME$INDEX = TMP$NAME$INDEX + 1; CALL WRITEO(.TEMPLATE,LENGTH$TO$WRITE$FROM$TEMPLATE); ENDDO  F$TYPE <> UNKNOWN$TYPE THENN CALL PRINT$CR(.MSG); CALL PRINT(.('xlate2 error: fill$name, type = ',0)SG$BUF,OBUFP-.MSG$BUF); END MAKE$RESTORE$COMMAND; comtrace DCL PROC$NAME (*) BYTE DATA('output$list',0); /* oST(N$INDEX).NAME; CALL FMOVE(7,.NULL$STRING,.MSG$BUF); CALL FMOVE(LESSEROF(6,LENGTHOF(.LET$OR$KE$RESTORE$COMMAND: PROC; OBUFP = .MSG$BUF; CALL SEEK(1,0,.BLOKNO,.BYTENO,.STATUS); IF STATUS <> 0 THENN  DCL FILE$TO$EXECUTE (16) BYTE; OPEN$CONSOLE$FILE: PROC; DCL TMP$PTR ADDRESS; TMP$PTR = SCANP; CALL FMOVE( :?<<<======== = = = = ==============>>>>>>>> > > > > >>>>>>>>>>>>>>???????); OBUFP = .MSG$BUF; CALL OUTDECR(F$TYPE,3); CALL OUTCHAR(NULL); CALL PRINT(.MSG$BUF); CALL PRINT(pt */ comtrace CALL BEG$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */ CALL READ$DIRECTORY(DIR$TO$SEARCH); CALDIG$CH)),SCANP,.MSGBUF); OBUFP = .MSG$BUF(6); CALL OUTCHAR(NULL); CALL PRINT(BLOKNO,BYTENO = 0; ENDIF CALL FMOVE(15,.INVOK$NAME,OBUFP); OBUFP = OBUFP + 15; CALL OUTPRINT(.(' RESTORE ',016,.FILENAME,.MSG$BUF); SCANP = DEBLANK(.INVOK$NAME); IF COLON$CH THENN SCANP = SCANP + 2; IF DIG$CH T CALL WRITEO(.(CR,LF),2); CALL MAKE$RESTORE$COMMAND; CALL CLOSEO; IF NOT HALT$FLAG THENN CALL CONS(.FILE$TO$EXEC.(' on the ',0)); OBUFP = .MSG$BUF; CALL OUTDECR(F$INDEX+1,3); CALL PRINT(.MSG$BUF); CALL PRINT$CR$EXIT(L OPEN$CONSOLE$FILE; TMP$NAME$INDEX = 0; DO WHILE TMP$NAME$INDEX <= NAME$INDEX; TMP$FILL$INDEX = 0; DO WHILE T.MSGBUF); CALL PRINT$CR(.(' has no numeric extension',0)); ENDIF LEADCHAR = '0'; )); CALL FMOVE(15,.BLANK$STR,OBUFP); CALL WHOCI(OBUFP); OBUFP = OBUFP + 15; CALL OUTCHAR('('); CALL OUTHENN CALL FMOVE(1,SCANP,.MSG$BUF(2)); ENDIF ENDIF CALL FMOVE(16,.MSG$BUF,.FILE$TO$EXECUTE); SCUTE,.(':CO: ')); ENDIF comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */ END OUTPUT$LIST; /******.(' template substitution',0)); ENDIF CALL FMOVE(16,.TMP$BUF,FILL$ARRAY(F$INDEX).FILL$PTR); END FILL$NAME; OUTPUT$LISTMP$FILL$INDEX <= FILL$INDEX; CALL FILL$NAME(TMP$NAME$INDEX,TMP$FILL$INDEX); TMP$FILL$INDEX = TMP$FILL$INDEX +  CALL OUT$DEC$R(NUMB$EXT,3); LEADCHAR = ' '; ENDIF ENDDO ENDDO ELSIF $DEC$R(BLOKNO,5); CALL OUTCHAR(','); CALL OUT$DEC$R(BYTENO,5); CALL OUTPRINT(.(')',CR,LF,0)); CALL WRITEO(.M=      CALL PRINT$CR(.(' %0.ext type',0)); CALL PRINT$CR(.(' #0 type',0)); ENDDO ELSIF FILL$ARRAY(TMP$Implate file',0)); CALL SCANWHILE(.FILE$CH); SCANP = DEBLANK(SCANP); IF DIG$CH THENN DIR$TO$SEARCH = S CALL OUT$CHAR(NULL); CALL PRINT$CR(.MSG$BUF); END PRINTLIST; */ /* BULL: PROC; DCL TMP$INDEX BYTE; TMP$INDEX  SCANP$TMP = SCANP; CALL SCANWHILE(.FILE$CH); CALL FMOVE(SCANP-SCANP$TMP,SCANP$TMP,.INVOK$NAME); SCANP = DEBLNT$CR(.('name$dot$ext$type',0)); ENDDO DO; CALL PRINT$CR(.('name$only$type',0)); D$LINE: PROC; GET$TEMPLATE$FILENAME: PROC; DCL STAT$MSG (*) BYTE DATA('process$command$line',0); comtrace DCL PR*********************************/ /* PRINTLIST: PROC; DCL TMP$INDEX ADDRESS; TMP$INDEX = 0; DO WHILE TMP$INDEX <= NDEX).TYPE = UNKNOWN$TYPE THENN CALL PRINT$CR(.(' unknown type',0)); ELLSE CALL PRINT$CR(.('bogus type= 0; OBUFP = .MSG$BUF; CALL OUT$DEC$R(FILL$INDEX+1,3); CALL OUT$PRINT(.(' substitutions',0)); CALL OUT$CHAR(NULL); ANK(SCANP); HALT$FLAG = SCANMATCH(.('HALT!',0)); SCANP = DEBLANK(SCANP); IF SCANMATCH(.('?',0))  ENDDO ENDDO ELSIF NAMELIST(TMPINDEX).TYPE = UNKNOWN$TYPE THENN CALL PRINT$CR(.('unknowOC$NAME (*) BYTE DATA('get$template$filename',0);/* opt */ comtrace CALL BEG$PR$DEBUG(.PROC$NAME,2,.NULL$PROC); NAMEINDEX; DO; DCL SPACE(7) BYTE; SPACE(6) = NULL; CALL FMOVE(6,.NAMELIST(TMP$INDEX).NAME,.SPACE);',0)); ENDIF TMP$INDEX = TMP$INDEX + 1; ENDDO CALL PRINT$CR(.(' expanded template:',0)); CALL PRINT$CR(.TEM CALL PRINT$CR(.MSG$BUF); DO WHILE TMP$INDEX <= FILL$INDEX; IF FILL$ARRAY(TMP$INDEX).TYPE < 4 THENN DO CASE  THENN DCL VERNO (*) BYTE DATA('xlate2 X004',0); CALL PRINT$CR$EXIT(.VERNO); ELSIF SCANMATCH(.('Rn$type',0)); ELLSE CALL PRINT$CR(.('bad name type',0)); ENDIF TMP$INDEX = TMP$INDEX + 1;  /* opt */ CALL RESCAN(1,.STATUS); CALL CHK$STATUS(.STAT$MSG); CALL READC(.READBUF,128); CALL CHK$ST CALL PRINT$CR(.SPACE); IF NAMELIST(TMPINDEX).TYPE < 3 THENN DO CASE NAMELIST(TMPINDEX).TYPE; PLATE); END BULL; */ $EJECT /****************************************************** C O M M A N D L I N E P R FILL$ARRAY(TMP$INDEX).TYPE; CALL PRINT$CR(.(' %0 type',0)); CALL PRINT$CR(.(' %0. type',0)); ESTORE',0)) THENN CALL RESTORE; ENDIF CALL OPENI(DEBLANK(SCANP)); CALL CHK$STATUS(.('cannot open te ENDDO ENDDO OBUFP = .MSG$BUF; CALL OUT$DEC$R(NAME$INDEX+1,5); CALL OUT$PRINT(.(' filenames read from list',0)); ATUS(.STAT$MSG); SCANP = DEBLANK(.READBUF); DEBUG$FLAG = SCANMATCH(.('DEBUG',0)); SCANP = DEBLANK(SCANP);  DO; CALL PRINT$CR(.('name$dot$type',0)); ENDDO DO; CALL PRIO C E S S I N G P R O C E D U R E S ******************************************************/ PROCESS$COMMAN>      SCAN$P = SCANP + 1; IF LET$OR$DIG$CH THENN NAMELIST(N$INDEX).TYPE = NAMELSIF FILE$CH THENN CALL ADD$DRIVE(NAME$INDEX); CALL ADD$NAME(NAME$INDEX);  CALL PRINT$CR$EXIT(SCANP-7); ELLSE CALL FMOVE(6,.NULL$STRING,.NAMELIST(N$INDEX).NAME); SCANP = DEBLANK(SCANP); IF TERM$CH THENN comtrace CALL END$PR$DEBUG SCANP = SCANP + 4; ELLSE CALL FMOVE(4,.DR$STR,.NAME$LIST(N$INDEX).DRIVE); CALL F> 3 THENN CALL PRINT$CR$EXIT(.('ext > 3 chars',0)); ELLSE CALL FMOVE(3,.NUCANBYTE; SCANP = DEBLANK(SCANP+1); ELLSE CALL PRINT$CR$EXIT(.('missing drive #',0)); ENDIF c$DOT$EXT$TYPE; ELLSE NAMELIST(N$INDEX).TYPE = NAME$DOT$TYPE; ENDIF  CALL FMOVE(LEN$NAME$PART,SCANP,.NAME$LIST(N$INDEX).NAME); /* set type field in the event that i(.PROC$NAME,3,.NULL$PROC); /* opt */ RETURN DONE; ELSIF SCANMATCH(.('&',0)) THENN CALMOVE(1,.DIR$TO$SEARCH,.NAME$LIST(N$INDEX).DRIVE(2)); ENDIF END ADD$DRIVE; ADD$NAME: PROC (N$ILL$STRING,.NAME$LIST(N$INDEX).EXT); CALL FMOVE(LEN$EXT,SCANP,.NAME$LIST(N$INDEX).EXT); SCAomtrace CALL END$PR$DEBUG(.PROC$NAME,2,.NULL$PROC); /* opt */ END GET$TEMPLATE$FILENAME; MAKE$LIST: PROC ELLSE CALL PRINT$CR$EXIT(.('a blank or dot must follow name part',0)); ENDIF t will be used */ SCANP = SCANP + LEN$NAME$PART; IF BLANK$CH OR TERM$CH THENNL ENFORCE$NO$TOKENS; CALL PRINT(.('**',0)); CALL READC(.READBUF,128); SCANP = DEBLANK(.RENDEX); DCL (N$INDEX,LEN$NAME$PART) ADDRESS; IF (LEN$NAME$PART :=LENGTH$OF(.LET$OR$DIG$CH)) > 6 THENNNP = SCANP + LEN$EXT; ENDIF ENDIF END ADD$EXT; $EJECT comtrace DCL PROC$NAME; DCL FLAG BYTE; ADD$FILENAME: PROC BYTE; ADD$DRIVE: PROC (N$INDEX);  ENDIF END ADD$NAME; ADD$EXT: PROC (N$INDEX); DCL (N$INDEX,LEN$EXT) ADDRESS;  NAMELIST(N$INDEX).TYPE = NAME$ONLY$TYPE; ELSIF DOT$CH THENN ADBUF); comtrace CALL END$PR$DEBUG(.PROC$NAME,3,.NULL$PROC); /* opt */ RETURN NEW$LINE; E CALL PRINT$CR(.('name too long: ',0)); SCANP = SCANP + 7; SCANBYTE = NULL;  (*) BYTE DATA('add$filename',0); /* opt */ comtrace CALL BEG$PR$DEBUG(.PROC$NAME,3,.NULL$PROC); /* opt */ DCL N$INDEX ADDRESS; IF COLON$CH THENN CALL FMOVE(4,SCANP,.NAME$LIST(N$INDEX).DRIVE);  IF LET$OR$DIG$CH THENN IF (LEN$EXT := LENGTH$OF(.LET$OR$DIG$CH)) ?     KE$LIST; comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */ END PROCESS$COMMAND$LINE; $EJECT E; FLAG = ADD$FILENAME; ENDDO IF NAME$INDEX = 0 THENN CALL PRINT$CR$EXIT(.('0 filenames on coCALL PRINT$CR$EXIT(.(' not a filename',0)); ENDIF comtrace CALL END$PR$DEBUG(.PROC$NAME,3,.NULL$PROC);  CALL ADD$EXT(NAME$INDEX); NAME$INDEX = NAME$INDEX + 1; comtrace CALL END$PR$DEBUG(.PROC$NAME,3,.NULL/********************************************************* F I R S T E X E C U T A B L E C O D E **************mmand line',0)); ELLSE NAME$INDEX = NAME$INDEX - 1; ENDIF comtrace CALL END$PR$DEBUG(.PROC$NAME,2 /* opt */ END ADDFILENAME; comtrace DCL PROC$NAME (*) BYTE DATA('make$list',0); /* opt */ $PROC); /* opt */ RETURN NAME$ADDED; ELLSE /* syntax chk opt *******************************************/ CALL FIRST$INIT; CALL PROCESS$COMMAND$LINE; CALL BUILD$TEMPLATE; CALL OUTPUT$,.NULL$PROC); /* opt */ END MAKE$LIST; comtrace DCL PROC$NAME (*) BYTE DATA('process$command$line',0); /* o comtrace CALL BEG$PR$DEBUG(.PROC$NAME,2,.NULL$PROC); /* opt */ FLAG = NOT DONE; DO WHILE FLAG <> DON*/ DCL TEMP$PTR ADDRESS; TEMP$PTR = SCANP; DO WHILE NOT(BLANK$CH) AND NOT(TERM$CH); LIST; /* CALL PRINTLIST; CALL BULL; */ /* debug opt */ CALL EXIT; END XLATE2$MOD; pt */ comtrace CALL BEG$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */ CALL GET$TEMPLATE$FILENAME; CALL MA< ? ? ? ? ???? SCANP = SCANP + 1; ENDDO SCAN$BYTE = NULL; CALL PRINT(TEMP$PTR); @     A     B     C     D     E     F     G     H     I     J     K     L