$ TITLE ('==> PASSIF -- FUNCMOD -- PERFORM MAJOR FUNCTIONS <==')
FUNC$MOD:
DO;
/************************************************************************/
/* */
/* 'Copyright 1981,1983 Intel Corporation'. All rights reserved. */
/* No part of this program or publication may be reproduced, */
/* transmitted, transcribed, stored in a retrievel system, or */
/* translated into any language or computer language, in any */
/* form or by any means, electronic, mechanical, magnetic, */
/* optical, chemical, manual or otherwise, without the prior */
/* written permission of Intel Corporation, 3065 Bowers */
/* Avenue, Santa Clara, California, 95051, Attn: Software */
/* License Administration. */
/* */
/************************************************************************/
$ NOLIST
/* LIT.INC */
DECLARE AS LITERALLY 'LITERALLY',
AMPERSAND AS '''&''',
BELL AS '07H',
BLANK AS '020H',
BOOLEAN AS 'BYTE',
CHK AS 'CALL CHECK$STATUS',
CLEAR$CHAR AS '01CH',
CO$ECHO$FILE AS '0F00H',
COLON AS ''':''',
COMMA AS '02CH',
CONSOLE$INPUT AS '1',
CONSOLE$OUTPUT AS '0',
CONTROL$Z AS '01AH',
CR AS '0DH',
DOT AS '''.''',
END$DO AS 'END',
END$DO$CASE AS 'END',
END$DO$WHILE AS 'END',
END$IF AS ' ',
END$ITERATED$DO AS 'END',
END$LOOP AS ' ',
EOF$CHAR AS 'CONTROL$Z',
ESC AS '01BH',
FALSE AS '0H',
FF AS '0CH',
FOREVER AS 'WHILE 1',
FORMAT$ATTRIBUTE AS '3',
HASH$MARK AS '''#''',
INIT$STG AS '(*) BYTE INITIAL',
LEAD$IN$CHAR AS '07EH',
LF AS '0AH',
NO$LINE$EDIT AS '0',
NULL AS '0FFFFH',
OPEN$FOR$READ AS '1',
OPEN$FOR$WRITE AS '2',
OPEN$FOR$UPDATE AS '3',
PUB$STRING AS '(*) BYTE PUBLIC DATA',
RESET AS '0',
RETURN$MARKER$POS AS '0',
SEEK$2$EOF AS '4',
SEEK$BACKWARD$BY$N AS '1',
SEEK$FORWARD$BY$N AS '3',
SEEK$2$N AS '2',
SEMICOLON AS ''';''',
SET AS '1',
STRING AS '(*) BYTE DATA',
TAB AS '09H',
TRANSFER$CONTROL AS '1',
TRUE AS '0FFH',
UNDERBAR AS '''_''',
USER$CI AS '0',
WRITE$PROTECT$ATTRIBUTE AS '2',
ZERO$BIAS AS '0';
/* ENDLIT.INC */
/* ISIS.INC */
OPEN: PROCEDURE(AFTN,FILENAME,ACCESS$MODE,LINE$EDIT$AFTN,ERROR) EXTERNAL;
DECLARE (AFTN,FILENAME,ACCESS$MODE,LINE$EDIT$AFTN,ERROR) ADDRESS; END;
MEMCK: PROCEDURE ADDRESS EXTERNAL; END;
READ: PROCEDURE (AFTN,BUFFER,COUNT,ACTUAL,STATUS) EXTERNAL;
DECLARE (AFTN,BUFFER,COUNT,ACTUAL,STATUS) ADDRESS; END;
CLOSE: PROCEDURE (AFTN,STATUS) EXTERNAL; DECLARE (AFTN,STATUS) ADDRESS; END;
DELETE: PROCEDURE (FILE$NAME$PTR,STATUS) EXTERNAL;
DECLARE (FILE$NAME$PTR,STATUS) ADDRESS; END;
SPATH: PROCEDURE (FILE,BUFFER,STATUS) EXTERNAL;
DECLARE (FILE,BUFFER,STATUS) ADDRESS; END;
/* END ISIS.INC */
/************************************************************/
/* */
/* LITERALLY'S UNIQUE TO PASSIF */
/* */
/************************************************************/
DECLARE
MINIMUM$ACCEPTABLE$BANNER$LENGTH AS '73',
MAXIMUM$TOKEN$LENGTH AS '70',
BI AS 'CALL BOMB$IF(STATUS)',
FIRST$FIELD AS '0',
SECOND$FIELD AS '28',
THIRD$FIELD AS '54',
RIGHT$PARENTHESIS AS ''')''',
LEFT$PARENTHESIS AS '''(''',
RI AS 'CALL REPORT$IF',
UNRECOGNIZED$SWITCH$ERR AS '201',
QUESTION$MARK AS '''?''';
/* MAIN.INC */
DECLARE
ACTUAL ADDRESS EXTERNAL,
AFTN ADDRESS EXTERNAL,
COMMAND$TAIL$BUF (250) BYTE EXTERNAL,
DELIMITER BYTE EXTERNAL,
FIRST$BLOCK$BUF (128) BYTE EXTERNAL,
FIRST$OUTPUT$MSG$PTR ADDRESS EXTERNAL,
FIRST$TIME$THROUGH BOOLEAN EXTERNAL,
INITIALIZED$BANNER (74) BYTE EXTERNAL,
PRINT$HASH$MARK BOOLEAN EXTERNAL,
REPORT$FILE$ACTUAL ADDRESS EXTERNAL,
REPORT$FILE$AFTN ADDRESS EXTERNAL,
REPORT$FILE$STRING$BEGINNING ADDRESS EXTERNAL,
SECOND$OUTPUT$MSG$PTR ADDRESS EXTERNAL,
STATUS ADDRESS EXTERNAL,
TMP$FILE$AFTN ADDRESS EXTERNAL,
TMP$FILE$NAME (15) BYTE EXTERNAL,
TOK$BUF (80) BYTE EXTERNAL;
DECLARE
KEY$WORDS (10) STRUCTURE
(LENGTH BYTE,
KEY$WORD (13) BYTE,
PROC$PTR ADDRESS) EXTERNAL;
MOVE: PROCEDURE (COUNT,SOURCE$PTR,DEST$PTR) EXTERNAL;
DECLARE (COUNT,SOURCE$PTR,DEST$PTR) ADDRESS; END;
/* END MAIN.INC */
/* ERRMSG.INC */
DECLARE
BAD$SYNTAX$MSG (29) BYTE EXTERNAL,
BOMB$IF$MSG$1 (12) BYTE EXTERNAL,
BOMB$IF$MSG$2 (40) BYTE EXTERNAL,
DURING$ASSERTION$CHECK$MSG (50) BYTE EXTERNAL,
PASSIF$INVOKED$BY$MSG (19) BYTE EXTERNAL,
ZERO$LENGTH$FILE$MSG (40) BYTE EXTERNAL;
/* END ERRMSG.INC */
/* CLI.INC */
DECLARE BUF$COUNT BYTE EXTERNAL;
UDI$STRING$MATCH: PROCEDURE (STG$1$PTR,STG$2$PTR) BOOLEAN EXTERNAL;
DECLARE (STG$1$PTR,STG$2$PTR) ADDRESS; END;
ENFORCE$DELIMITER: PROCEDURE(ENFORCEE) EXTERNAL; DECLARE ENFORCEE BYTE; END;
NEXT$ARG: PROCEDURE EXTERNAL; END;
/* END CLI.INC */
/* REPORT.INC */
REPORT$ISIS$ERROR: PROCEDURE (STATUS) EXTERNAL; DECLARE STATUS ADDRESS; END;
REPORT$ASSERTION$SUCCESS: PROCEDURE EXTERNAL; END;
REPORT$ASSERTION$FAILURE: PROCEDURE EXTERNAL; END;
REPORT$ASSERTION$FAILURE$W$ISIS$ERR: PROCEDURE (STATUS) EXTERNAL;
DECLARE STATUS ADDRESS; END;
REPORT$ASSERTION$FAILURE$W$MSG: PROCEDURE (OLD$STYLE$MSG$PTR) EXTERNAL;
DECLARE OLD$STYLE$MSG$PTR ADDRESS; END;
/* END REPORT.INC */
$ LIST
$ EJECT
/************************************************************/
/* */
/* PROCEDURES PERFORMING PASSIF FUNCTIONS */
/* */
/************************************************************/
/************************************************************/
/* */
/* NOTES */
/* */
/************************************************************/
/*
1. The token ri is a "literal" abbreviation of "call report$if",
which will call "report$assertion$failure$w$isis$err" if
status does not equal 0.
*/
/************************************************************/
/* */
/* LOCAL VARIABLES */
/* */
/************************************************************/
DECLARE (THE$STRING$WAS$FOUND,THE$STRING$SHOULD$BE$THERE) BOOLEAN;
/************************************************************/
/* */
/* LOCAL PROCEDURES */
/* */
/************************************************************/
REPORT$IF:
PROCEDURE;
IF STATUS<>0 THEN
CALL REPORT$ASSERTION$FAILURE$W$ISIS$ERR(STATUS);
END$IF
END
REPORT$IF;
it$is$spool$file: PROCEDURE(file$name$ptr,want$exist) BYTE;
DECLARE file$name$ptr ADDRESS, want$exist BYTE;
DECLARE test BYTE;
DECLARE spath$info STRUCTURE (
DEV BYTE,
NAME(6) BYTE,
EXT(3) BYTE,
DEV$TYPE BYTE,
DRIVE$TYPE BYTE);
CALL spath(file$name$ptr,.spath$info,.status);
IF spath$info.dev <> 29 THEN RETURN false;
CALL open(.aftn,file$name$ptr,2,0,.status); /* must open for output */
test = (status = 11); /* file already exists */
IF NOT test THEN
DO;
CALL close(aftn,.status);
CALL delete(file$name$ptr,.status);
END;
IF (test XOR want$exist) THEN
CALL report$assertion$failure;
ELSE CALL report$assertion$success;
RETURN true;
END;
$ EJECT
/************************************************************/
/* */
/* FILE$EXISTS */
/* */
/************************************************************/
FILE$EXISTS:
PROCEDURE PUBLIC;
CALL NEXT$ARG;
CALL ENFORCE$DELIMITER(RIGHT$PARENTHESIS);
IF it$is$spool$file(.tok$buf(1),true) THEN RETURN;
CALL OPEN(.AFTN,.TOK$BUF(1),OPEN$FOR$READ,NO$LINE$EDIT,.STATUS);
IF STATUS=13 THEN
CALL REPORT$ASSERTION$FAILURE;
ELSE IF STATUS<>0 THEN
CALL REPORT$ASSERTION$FAILURE$W$ISIS$ERR(STATUS);
ELSE
DO;
/* See whether file is of zero length. */
DECLARE SOME$SPACE BYTE;
CALL READ(AFTN,.SOME$SPACE,SIZE(SOME$SPACE),.ACTUAL,.STATUS); RI;
IF ACTUAL=0 THEN
CALL REPORT$ASSERTION$FAILURE$W$MSG(.ZERO$LENGTH$FILE$MSG);
ELSE
CALL REPORT$ASSERTION$SUCCESS;
END$IF
ENDDO;
END$IF
END
FILE$EXISTS;
$ EJECT
/************************************************************/
/* */
/* FILE$ABSENT */
/* */
/************************************************************/
FILE$ABSENT:
PROCEDURE PUBLIC;
CALL NEXT$ARG;
CALL ENFORCE$DELIMITER(RIGHT$PARENTHESIS);
IF it$is$spool$file(.tok$buf(1),false) THEN RETURN;
CALL OPEN(.AFTN,.TOK$BUF(1),OPEN$FOR$READ,NO$LINE$EDIT,.STATUS);
IF STATUS=13 THEN
CALL REPORT$ASSERTION$SUCCESS;
ELSE IF STATUS<>0 THEN
CALL REPORT$ASSERTION$FAILURE$W$ISIS$ERR(STATUS);
ELSE
CALL REPORT$ASSERTION$FAILURE;
END$IF
END
FILE$ABSENT;
$ EJECT
/************************************************************/
/* */
/* FILES$MATCH */
/* */
/************************************************************/
FILES$MATCH:
PROCEDURE PUBLIC;
DECLARE (AFTN$1,AFTN$2) ADDRESS;
DECLARE (ACTUAL$1,ACTUAL$2) ADDRESS;
DECLARE BUF$SIZ ADDRESS;
DECLARE (BUF$1$BOT,BUF$1$TOP,BUF$2$BOT,BUF$2$TOP) ADDRESS;
DECLARE (BUF$1$PTR,BUF$2$PTR) ADDRESS;
DECLARE BUF$1$BYTE BASED BUF$1$PTR BYTE,
BUF$2$BYTE BASED BUF$2$PTR BYTE;
/* Pick up the first filename. */
CALL NEXT$ARG;
CALL ENFORCE$DELIMITER(COMMA);
/* Open it. */
CALL OPEN(.AFTN$1,.TOK$BUF(1),OPEN$FOR$READ,NO$LINE$EDIT,.STATUS); RI;
/* Pick up the second filename. */
CALL NEXT$ARG;
CALL ENFORCE$DELIMITER(RIGHT$PARENTHESIS);
/* Open it. */
CALL OPEN(.AFTN$2,.TOK$BUF(1),OPEN$FOR$READ,NO$LINE$EDIT,.STATUS); RI;
/* Allocate buffers in free memory. */
BUF$SIZ = ((MEM$CK-.MEMORY)/256) * 128;
BUF$1$BOT = .MEMORY;
BUF$1$TOP = .MEMORY + BUF$SIZ - 1;
BUF$2$BOT = BUF$1$TOP + 1;
BUF$2$TOP = BUF$2$BOT + BUF$SIZ - 1;
/* Now, compare the files. */
/* B E G I N N I N G O F C O M P A R I S O N L O O P. */
begin$loop:
CALL READ(AFTN$1,BUF$1$BOT,BUF$SIZ,.ACTUAL$1,.STATUS);
CALL REPORT$ISIS$ERROR(STATUS);
CALL READ(AFTN$2,BUF$2$BOT,BUF$SIZ,.ACTUAL$2,.STATUS);
CALL REPORT$ISIS$ERROR(STATUS);
/* Perform fast check which may spot mismatched files. */
IF ACTUAL$1 <> ACTUAL$2 THEN
CALL REPORT$ASSERTION$FAILURE;
END$IF
BUF$1$PTR = BUF$1$BOT;
BUF$2$PTR = BUF$2$BOT;
DO WHILE BUF$1$PTR < BUF$1$BOT+ACTUAL$1;
IF BUF$1$BYTE <> BUF$2$BYTE THEN
CALL REPORT$ASSERTION$FAILURE;
END$IF
BUF$1$PTR = BUF$1$PTR + 1;
BUF$2$PTR = BUF$2$PTR + 1;
END$DO$WHILE;
IF ACTUAL$1=BUF$SIZ THEN
/* There may be more bytes to compare. */
GOTO begin$loop;
ELSE
/* The comparison was successful. */
CALL REPORT$ASSERTION$SUCCESS;
END$IF
end$loop
/* E N D O F C O M P A R I S O N L O O P. */
END
FILES$MATCH;
$ EJECT
/************************************************************/
/* */
/* STRING$IS$IN$FILE */
/* */
/************************************************************/
STRING$IS$IN$FILE:
PROCEDURE;
DECLARE STRING$BUF (85) BYTE;
DECLARE STRING$LENGTH BYTE AT (.STRING$BUF(0));
DECLARE FIRST$STRING$CHARACTER BYTE AT (.STRING$BUF(1));
DECLARE IN$TOKEN STRING (2,'IN');
DECLARE FILE$TOKEN STRING(4,'FILE');
DECLARE (BUF$BOT,BUF$TOP) ADDRESS;
DECLARE BUF$PTR ADDRESS,
BUF$CHAR BASED BUF$PTR (100) BYTE;
DECLARE BYTES$LEFT$IN$BUFFER ADDRESS;
DECLARE BUF$SIZ ADDRESS;
DECLARE DONT$START$SEARCH$PAST$HERE ADDRESS;
$ EJECT
/************************************************************/
/* */
/* PROCEDURES LOCAL TO STRING$IS$IN$FILE */
/* */
/************************************************************/
PERFORM$FANCY$BUFFER$REFRESH:
PROCEDURE;
/* The reason for the adjective "fancy" is because,
before any more reading is done, the text currently
left in the buffer is moved down to the bottom of
the buffer, and more text is appended above it.
We don't have to worry about the text destination
area overlapping the text source area because the
text source and destination areas are at the top and
bottom of the i/o buffer area, respectively; cannot
exceed 80 bytes each, and the i/o buffer area is huge.
After moving the block of text, the variables controlling
the string matching and buffering are modified so that
the string matching algorithim begins at the bottom of
the buffer, and searches the chunk of text which was at
the top.*/
DECLARE TMP$ACTUAL ADDRESS;
DECLARE TMP$COUNT ADDRESS;
BYTES$LEFT$IN$BUFFER = STRING$LENGTH - 1;
CALL MOVE(/*count*/ BYTES$LEFT$IN$BUFFER ,
/*source*/ (DONT$START$SEARCH$PAST$HERE+1),
/*destination*/ BUF$BOT ) ;
TMP$COUNT = BUF$SIZ - BYTES$LEFT$IN$BUFFER;
CALL READ(AFTN,
(BUF$BOT+BYTES$LEFT$IN$BUFFER),
TMP$COUNT,
.TMP$ACTUAL,
.STATUS);
CALL REPORT$ISIS$ERROR(STATUS);
/* Now, modify the "search-controlling" to restart the search at
the bottom of the buffer. */
ACTUAL = TMP$ACTUAL + BYTES$LEFT$IN$BUFFER;
END
PERFORM$FANCY$BUFFER$REFRESH;
REPORT$ASSERTION$VERDICT:
PROCEDURE (THE$STRING$WAS$FOUND);
DECLARE THE$STRING$WAS$FOUND BOOLEAN;
IF NOT (THE$STRING$WAS$FOUND xor THE$STRING$SHOULD$BE$THERE) THEN
CALL REPORT$ASSERTION$SUCCESS;
ELSE
CALL REPORT$ASSERTION$FAILURE;
END$IF
END
REPORT$ASSERTION$VERDICT;
STRING$MATCH$W$BUF:
PROCEDURE;
/* This procedure is the only way to get a positive verdict
on string matching. There are many ways to get a negative
verdict.
This procedure is attempting to match a UDI string with a
vanilla string, so the indices of the two strings in the
matching loop below will be off by one.
We can start the string comparison checking at the second
byte because the code which calls this procedure has already
checked the first byte. */
DECLARE INDEX BYTE;
DO INDEX=1 TO STRING$LENGTH-1;
IF STRING$BUF(INDEX+1)<>BUF$CHAR(INDEX) THEN
RETURN;
END$IF
END$DO$WHILE;
CALL REPORT$ASSERTION$VERDICT(TRUE);
END
STRING$MATCH$W$BUF;
NORMAL$FILE$READ:
PROCEDURE;
CALL READ(AFTN,BUF$BOT,BUF$SIZ,.ACTUAL,.STATUS); RI;
END
NORMAL$FILE$READ;
THERE$PROBABLY$IS$MORE$TEXT:
PROCEDURE BOOLEAN;
RETURN ACTUAL=BUF$SIZ;
END
THERE$PROBABLY$IS$MORE$TEXT;
$ EJECT
/************************************************************/
/* */
/* FIRST EXECUTABLE IN STRING$IS$IN$FILE */
/* */
/************************************************************/
/* Grab the string. */
CALL NEXT$ARG;
CALL ENFORCE$DELIMITER(RIGHT$PARENTHESIS);
/* Move string to local buffer. */
CALL MOVE(/*count*/ TOK$BUF(0)+1,
/*source*/ .TOK$BUF(0),
/*destination*/ .STRING$BUF);
/* Look for the "in". */
CALL NEXT$ARG;
CALL ENFORCE$DELIMITER(BLANK);
IF NOT UDI$STRING$MATCH(.IN$TOKEN,.TOK$BUF) THEN
CALL REPORT$ASSERTION$FAILURE$W$MSG(.BAD$SYNTAX$MSG);
END$IF
/* Look for the "file". */
CALL NEXT$ARG;
CALL ENFORCE$DELIMITER(LEFT$PARENTHESIS);
IF NOT UDI$STRING$MATCH(.FILE$TOKEN,.TOK$BUF) THEN
CALL REPORT$ASSERTION$FAILURE$W$MSG(.BAD$SYNTAX$MSG);
END$IF
/* Grab filename. */
CALL NEXT$ARG;
CALL ENFORCE$DELIMITER(RIGHT$PARENTHESIS);
/* Open file. */
CALL OPEN(.AFTN,.TOK$BUF(1),OPEN$FOR$READ,NO$LINE$EDIT,.STATUS);
CALL REPORT$ISIS$ERROR(STATUS);
/* Allocate buffers in free memory. */
BUF$SIZ = ((MEM$CK-.MEMORY)/128)*128;
BUF$BOT = .MEMORY;
BUF$TOP = BUF$BOT + BUF$SIZ - 1;
BUF$PTR = BUF$BOT;
$ EJECT
/************************************************************/
/* */
/* MAIN LOOP OF STRING$IS$IN$FILE */
/* */
/************************************************************/
/* read in file. */
CALL NORMAL$FILE$READ;
continue$string$search:
DONT$START$SEARCH$PAST$HERE = BUF$BOT + ACTUAL - STRING$LENGTH;
/**************************************************/
/* */
/* HERE FOLLOWS THE "SUB-LOOP" OF THE MAIN LOOP */
/* */
/**************************************************/
DO BUF$PTR = BUF$BOT TO DONT$START$SEARCH$PAST$HERE;
IF BUF$CHAR(0) = FIRST$STRING$CHARACTER THEN
CALL STRING$MATCH$W$BUF;
END$IF
END$ITERATED$DO;
IF THERE$PROBABLY$IS$MORE$TEXT THEN
DO;
CALL PERFORM$FANCY$BUFFER$REFRESH;
GOTO continue$string$search;
ENDDO;
ELSE
CALL REPORT$ASSERTION$VERDICT(FALSE);
END$IF
end$loop
/* The code should never get this far. If text is exhausted, then
the procedure which discovers that fact will call the procedure
report$assertion$verdict, which will report the fact, and not
return. If the string matches, then, similarly, the string
match procedure will call report$assertion$verdict, which will
not return. */
END
STRING$IS$IN$FILE;
$ EJECT
/************************************************************/
/* */
/* STRING$FOUND */
/* */
/************************************************************/
STRING$FOUND:
PROCEDURE PUBLIC;
THE$STRING$SHOULD$BE$THERE = TRUE;
CALL STRING$IS$IN$FILE;
END
STRING$FOUND;
/************************************************************/
/* */
/* STRING$ABSENT */
/* */
/************************************************************/
STRING$ABSENT:
PROCEDURE PUBLIC;
THE$STRING$SHOULD$BE$THERE = FALSE;
CALL STRING$IS$IN$FILE;
END
STRING$ABSENT;
END
FUNC$MOD;