Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0122/ulxcom.cor
There are 2 other files named ulxcom.cor in the archive. Click here to see a list.
-!ULXCOM.XPL_XCOM.XPL
-221,221
PROCEDURE_DEPTH CONTAINS THE CURRENT NUMBER OF PROCEDURES NESTED.
ALPHABET CONTAINS THE ABC'S IN UPPER CASE
*/
DECLARE ALPHABET CHARACTER INITIAL ('ABCDEFGHIJKLMNOPQRSTUVWXYZ');
-226,226
CURRENT_PROCEDURE CHARACTER,
PROCEDURE_DEPTH FIXED;
-679
I = 0;
DO WHILE I <= LENGTH(TEMPO);
IF BYTE(TEMPO,I) = 9 THEN /* EXPAND TAB CHAR */
DO;
TEMPO = SUBSTR(TEMPO,0,I) ^^ SUBSTR(X70,0,9-(I MOD 8))
^^ SUBSTR(TEMPO,I+1);
I = I + 9-(I MOD 8);
END;
ELSE
I = I + 1;
END;
-728
LOWUP: /* CONVERT S TO UPPER CASE */
PROCEDURE (S) CHARACTER;
DECLARE (S,T) CHARACTER;
T = '';
DO I = 0 TO LENGTH(S)-1;
IF BYTE(S,I) > 96 THEN
T = T ^^ SUBSTR(ALPHABET,BYTE(S,I)-97,1);
ELSE
T = T ^^ SUBSTR(S,I,1);
END;
RETURN T;
END LOWUP;
-753,753
CALL ERROR ('ILLEGAL CHARACTER: ' ^^ SUBSTR (TEXT, 0, 1) ^^
' (' ^^ BYTE(TEXT) ^^ ')', 0);
-754: /* CASE 1 */
-836,836
BCD = LOWUP(SUBSTR(TEXT, 0, CP));
-968,969
RCTR = 1;
END FLUSH_CODE_BUFFER;
-982,985
ELSE IF I = BYTE ('.') THEN K = "(3)45";
ELSE IF I = BYTE ('$') THEN K = "(3)46";
ELSE IF I = BYTE ('%') THEN K = "(3)47";
ELSE IF I >= BYTE ('0') & I <= BYTE ('9') THEN
-997,999
IF CODE_FULL(CODE_TAIL) THEN
DO;
IF CONTROL(BYTE('A')) THEN OUTPUT (CODEFILE) = CODE (CODE_TAIL);
-1998
-1999: END;
-2374,2374
J = 0;
DO I = 0 TO LENGTH(SOURCE)-1;
CH = SUBSTR(SOURCE,I,1);
IF (BYTE(CH) = BYTE('.')) & (J = 0) THEN
J = I;
END;
IF J = 0 THEN
J = LENGTH(SOURCE);
IF J = LENGTH(SOURCE) THEN
FILENAME(0) = 'SYSIN:' ^^ SOURCE ^^ '.XPL';
ELSE
FILENAME(0) = 'SYSIN:' ^^ SOURCE;
SOURCE = SUBSTR(SOURCE,0,J);
-2422
CHARTYPE (BYTE(' ')) = 1; /* MAKE A TAB CHARACTER A BLANK */
-2430
IF I < 27 THEN
DO;
NOT_LETTER_OR_DIGIT(J+32) = FALSE; /* INCLUDE LOWER CASE */
CHARTYPE(J+32) = 4;
END;
-2732
PROCEDURE_DEPTH = 0;
-2807,2807
;
-2808:/* 9 ^ <RETURN STATEMENT> ; */
-2975
-2979
-2994
-2997
-3011
PROCEDURE_DEPTH = PROCEDURE_DEPTH - 1;
-3012: /* EMIT A GRATUITOUS RETURN */
-3070
PROCEDURE_DEPTH = PROCEDURE_DEPTH + 1;
OUTPUT(-1) = SUBSTR(X70,0,PROCEDURE_DEPTH) ^^ CURRENT_PROCEDURE;
-3120,3120