Trailing-Edge
-
PDP-10 Archives
-
ALGOL-10_V10B_BIN_SRC_1err
-
algprm.mac
There are 8 other files named algprm.mac in the archive. Click here to see a list.
;
;
;COPYRIGHT (C) 1975,1981,1982 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;
;
;SUBTTL MAIN ASSIGNMENTS
; THIS FILE MUST BE COMPILED BEFORE ALL OTHER ALGOL FILES
SALL
MAJVNO==10 ; MAJOR VERSION NUMBER
MINVNO==2 ; MINOR VERSION NUMBER
EDTNO==310 ; EDIT NUMBER
VERNO==<MAJVNO>B11+<MINVNO>B17+EDTNO
DEFINE %TEXT(F,VMA,VMI,VED)
< DEFINE %'F(A,B)
<F A - B, VMA'VMI'('VED'), EUROPEAN SOFTWARE ENGINEERING, SEP-74
>>
%TEXT(UNIVERSAL,\MAJVNO,\"<100+MINVNO>,\EDTNO)
%TEXT(TITLE,\MAJVNO,\"<100+MINVNO>,\EDTNO)
%TEXT(SUBTTL,\MAJVNO,\"<100+MINVNO>,\EDTNO)
%UNIVERSAL(ALGPRM,ALGOL PARAMETER FILE)
KA10==0 ; PROCESSOR SWITCHES
KI10==1 ; FOR LIBRARY ONLY
; PDP-10 (KA10) VERSION: PROC==KA10
; PDP-10 (KI10) VERSION: PROC==KI10
IFNDEF PROC, <
PROC==KI10> ; DEFAULT: PDP-10 (KI10) VERSION
IF2, <
IFE PROC-KA10, <PRINTX KA10 version>
IFE PROC-KI10, <PRINTX KL/KI-10 version>
>
IFNDEF FTDDT, <FTDDT==-1>
IFNDEF FTSYM,<FTSYM==1> ; 1 to make compiler produce 1044 blocks by default.
IFE FTDDT,<FTSYM==0> ; Lets not be stupid, folks !
IFNDEF FTSTATS, <FTSTATS==0> ; 1 TO PRODUCE COMPILER STATS.
.JBREN==124 ; THESE ASSIGNMENTS WILL GIVE
.JBOPS==135 ; LOADING ERRORS IF JOBDAT CHANGES
.JBVER==137
.JBHDA=10
SUBTTL REVISION HISTORY
;EDIT SPR COMMENTS
;171 26346 ADD WARNING COUNT AND VERSION NUMBER, START EDIT HISTORY
;
;172 ----- DO NOT EXECUTE KA DOUBLE PRECISION INSTRUCTIONS IF THIS IS NOT
; A KA AND WE ARE NOT GENERATING CODE FOR ONE. ALSO ADD VERSION
; NUMBER TO ALGOTS.
;
;173 26563 FIX BY-NAME PARAMETER PASSING WITH TYPE CONVERSION (ALGOTS)
;
;174 26963 FIX REDIRECTED DUMP OUTPUT TO NOT DOUBLE LAST CHARACTER AT
; BRKBYT CALL (ALGOTS).
;
;175 26995 ALLOW TRAPPING EOF AFTER EDIT 145 (ALGOTS).
;
;176 27013 TRACING OF LABELS IN ALGDDT CAN CLOBBER AX (ALGOTS).
;
;177 27052 DO NOT CLOBBER SYMBOL TABLE IF A SYMBOL IN AN ENCLOSING
; BLOCK NEEDS TO BE EXTENDED (ERRONEOUS PROGRAM) (ALGCON).
;
;200 27046 REMEMBER THAT A CALL TO STRASS USES AC0 AND AC1
; (.CGASS IN ALGCOD).
;
;201 27238 DELOCATE SP ON CONTROL-C TRAP (ALGOTS).
;
;202 ----- IF PARAMETER MISMATCH DURING PARAMETER EVALUATION IN PARAM
; (ALGOTS), PUT DL BACK TO CALLER'S LEVEL SO THAT A GOOD
; CONTEXT IS AVAILABLE TO THE DEBUGGER.
;
;203 ----- ROUTINE "DEC" (ALGCON) PRINTS ONE TOO MANY CHARACTERS IF
; ASKED TO PRINT A ZERO IN THE LISTING FILE.
;
;204 ----- PRODUCE CORRECT WORD ALIGNMENT OF LISTING IF /CREF
; (ALGCON).
;
;205 ----- GENERATE LIBRARY NAMES ENDING IN L FOR /KL10 SWITCH
; (ALGSYS, ALGCON). MUST RECOMPILE LIBRARY DUE TO ALGSYS
; CHANGE!
;
;206 ----- -20 ONLY EDIT
;
;207 27801 MORE OF EDIT 177 FOR EXTENSION OF SYMBOLS IN ERRONEOUS
; PROGRAMS (ALGCON).
;
;210 ----- ALLOW SIX CHARACTER FILE NAME IN OPENFILE (ALGLIB).
;
;211 ----- DO NOT TRAP OVERFLOWS CAUSED BY DDT (ALGOTS).
;
;212 28048 CHECK TRAP LABEL OUT OF SCOPE MORE CAREFULLY (ALGOTS).
;
;213 28097 PIM MODE AND BYTE MODE ARE CHARACTER MODES, NOT BINARY MODES
; (ALGOTS).
;
;214 ----- -20 ONLY EDIT.
;
;215 28340 ALLOW BLANKS EVERYWHERE IN LONG REAL CONSTANTS (ALGCON).
;
;216 28426 FIX NULL SKIPPING IN INBLK TO NOT DELOCATE CHANNEL NUMBER MORE
; THAN ONCE (ALGOTS).
;
;217 28469 PRECEED "UNDEFINED LABEL" ERROR WITH A QUESTION MARK AND
; SET WFLAG SO NO REL FILE WILL BE CREATED (ALGCON).
;
;220 ----- FIX EMBEDDED ASSIGNMENTS INVOLVING DOUBLE PRECISION OR STRING
; VARIABLES WHERE SOMETHING HAS BEEN STACKED. THIS WAS OLD EDIT
; 776, WHICH WAS WITHDRAWN BECAUSE IT BROKE /CHECKON, BUT THE
; SAMPLE PROGRAM WHICH BROKE NOW COMPILES (ALGCOD).
;
;221 28629 FIX CONSTANT FOLDING FOR LONG REAL CONSTANTS FOR MULTIPLY AND
; DIVIDE TO CHECK FOR OVERFLOW (ALGCOD).
;
;222 28695 ALGDDT WILL ILL MEM REF IF A BREAK POINT IS SET ON AN
; IMMEDIATE MODE INSTRUCTION, THE BREAKPOINT IS REACHED, AND THE
; PROGRAM THEN CONTINUED (ALGDDT).
;
;223 28682 LISTON/LISTOFF CAUSE MISSING OR EXTRA LISTING CHARACTERS
; DUE TO MISALIGNED BYTE POINTERS (ALGCON).
;
;224 29190 FIX INCORRECT POINTER IN A2 WHEN STRING PARAMETER IS PASSED BY
; NAME TO A PROCEDURE. (ALGOTS) [JBS 4/1/80]
;
;225 29014 FIX COMPILER ERROR THAT DIDN'T MAKE PROPER CODE TO POINT TO
; A0 FROM A2 (ALGFUN). JBS 4/11/80
;
;226 29460 FIX DOUBLE-PRECISION CONSTANT AT LLN8 IN ALGLIB. [JBS 4/11/80]
;
;227 29298 DO MEMORY MANAGEMENT IN RIGHT HALF OF AC TO AVOID ARITHMETIC
; OVERFLOWS WHEN WORKING WITH NON-SHARED HISEG (OVERFLOW OCCURS
; IF > 131071 WORDS ARE RETURNED TO THE HEAP).
; (ALGOTS) [JBS 5/20/80]
;
;230 29456 MAKE 10^[ < -63] WORK. RETURN 0 INSTEAD OF A FLOATING
; OVERFLOW. (ALGLIB) [JBS 5/22/80]
;
;231 29458 MAKE LONG REAL NUMBERS < 1 WITH MANTISSAS NEAR 1 PRINT
; CORRECTLY. THEY WERE BEGIN PRINTED AS 1.0 EXACTLY.
; (ALGOTS) [JBS 5/29/80]
;
;232 RAW REMOVE "LRLOAD" AND SIMILAR MACROS FROM ALGDDT AND ALGOTS.
; ALGPRM ALREADY CONTAINS THEM. [JBS 6/4/80]
;
;233 RAW ADD "DDT" COMMAND TO HELP FILE ALGDDT.HLP. [JBS 6/5/80]
;
;234 RAW ADD PORTALS IN ALGSYS SO ALGOTS CAN BE EXECUTE-ONLY.
; [JBS 6/6/80]
;
;235 RAW ".REENTER" COMMAND WOULD GENERATE INTERNAL ERROR IF USED TO
; GET INTO ALGDDT AFTER A FATAL ERROR ON A PTY.
; (ALGDDT) [JBS 6/6/80]
;
;236 RAW FIX FLOATING OVERFLOW FOR LONG REALS RAISED TO INTEGER
; POWERS WITH RESULTS LESS THAN OR EQUAL TO 10&&-64.
; (ALGLIB) [JBS 6/19/80]
;
;237 RAW FIX ILL. MEM. REF. PROBLEM WITH "WRITE(TIME)" STATEMENT, ETC.
; (ALGLIB) [JBS 6/21/80]
;
;240 29459 FIX INACCURATE ANSWERS FROM LEXP (DOUBLE PRECISION LOG).
; MAJOR REWRITE TO LEXP IN ALGLIB. [JBS 6/25/80]
;
;241 29672 DON'T LET ALGDDT START IF JACCT IS ON! [JBS 7/10/80] (ALGDDT)
;
;242 29457 FIX OCCASIONAL WRONG LINE # INFORMATION FROM ALGDDT AFTER
; PROGRAM BOMBS. THIS ONLY HAPPENED WHEN A "SYSER" UUO WITHOUT
; AN ADDRESS ARG. WAS EXECUTED. [JBS 7/28/80] (ALGOTS)
;
;243 29865 FIX ALGOTS AND ALGDDT SO THEY PROPERLY DETERMINE WHETHER
; OR NOT THEY ARE BEING RUN UNDER BATCH. ALL THEY DID WAS
; SEE IF THEY WERE CONTROLLED (I.E., ON A PTY INSTEAD OF REAL
; BATCH). [JBS 7/30/80] (ALGOTS, ALGDDT)
;
;244 29945 FIX GFIELD TO WORK WITH STRINGS. THE STRING HEADER ITSELF,
; RATHER THAN THE STRING, WAS THE TARGET FOR AN "LDB".
; [JBS 8/20/80] (ALGLIB)
;
;245 RAW ADD LOTS OF CODE TO GFIELD AND SFIELD TO HANDLE STRINGS.
; PREVIOUSLY, ALL BYTE MANIPULATION WAS BEING DONE IN THE
; STRING HEADER, RATHER THAN IN THE STRING PROPER. DEPENDS
; ON EDIT 244. [JBS 9/8/80]
;
;246 RAW FIX HEAP TABLE SCANNING - AREAS WHICH WERE IN USE WERE BEING
; USED ANYWAY. [JBS 1-OCT-80] (ALGOTS)
;
;247 30062 FIX INFINITE COMPILER LOOP IN ROUTINE "GET". [JBS 7-OCT-80]
; (ALGCON)
;
;***************************************
;REFORMAT EDIT HISTORY
;EDIT MODULE DATE SPR-NUMBER WHO
; COMMENTS
;***************************************
;250 ALGLIB 17-FEB-81 SPR 10-30625 JBS
; LONG REAL TO INTEGER CONVERSION INSIDE A PROCEDURE FAILS
; IF THE INTEGER ACTUAL PARAMETER IS AN ARRAY. LIBRARY
; PROCEDURE FOR LONG REAL TO INTEGER CONVERSION WAS STEPPING
; ON A2- ALL OTHER CONVERSION ROUTINES USED ONLY A0 AND A1.
;
;251 ALGLIB 23-APR-81 SPR 10-30813 JBS
; FIX "READ" ROUTINE IN ALGLIB. IT WAS RETURNING STRING SPACE TO
; TO THE HEAP BEFORE READING INTO THE STRING. THIS DOES NOT WORK
; IF EOF HAPPENS AND "TRAP(38)" HAS BEEN USED TO CATCH THE EOF.
; THE OLD STRING IS STILL INTACT BUT IT'S SPACE WAS DEALLOCATED.
; SUBSEQUENT MEMORY MANAGEMENT RETURNED THE STRING SPACE TWICE,
; OVERLAPING HEAP AREAS AND CAUSING DATA FROM DIFFERENT PARTS
; OF THE PROGRAM TO WRITE IN THE SAME AREA. ALSO, ANY EXPANDABLE
; HEAP SPACE OBTAINED BY THE ROUTINE WAS ALSO LOST, SO THE TRAP
; HANDLER WAS CHANGED TO CHECK A SEMAPHORE AND RELEASE ANY "LOST"
; SPACE.
;
;252 ALGCON 7-MAY-81 QAR 10-6411 JBS
; MAKE ERROR MESSAGE "ERROR ON A PREVIOUS LINE" HAVE AN ENTRY
; IN THE MESSAGE DISPATCH TABLE. OTHERWISE ANY TIME THE MESSAGE
; IS OUTSTR'ED, THE UUO DIES.
;
;253 ALGCON 21-MAY-81 SPR 10-31117 JBS
; FIX EDIT 204 SO CREF LISTINGS WON'T GET "ILLEGAL ADDRESS IN
; UUO" ERROR. LOCATION FIVEC WAS NOT BEING TREATED PROPERLY AND
; THE LISTING OUTPUT BUFFERS WERE DAMAGED. EDIT 204 MUST BE
; INSTALLED FIRST.
;
;254 ALGOTS 23-JUN-81 QAR 10-6262 JBS
; REINSTALL EDIT 772 FROM AUGUST 1977.
;
;255 ALGOTS 23-JUN-81 QAR 10-6261 JBS
; REINSTALL EDIT 771 FROM AUGUST 1977.
;
;256 ALGLIB 28-JUL-81 SPR 10-31070 JBS
; DELETE TRANSIENT STRING SPACE IN PROCEDURES WRITE, LENGTH,
; AND SIZE; MAKE DELETE RETURN STRING SPACE TO THE HEAP AFTER
; DELETING A STRING.
;
;257 ALGCON 5-AUG-81 QAR 10-6398 JBS
; FIX CREF GENERATION PROBLEM. WAS GETTING ILL. ADDR. IN UUO
; DUE TO EDIT 204. EDIT 204 IS REMOVED BY THIS EDIT. EDIT
; 253 SHOULD BE INSTALLED FIRST (THIS SIMPLY REMOVES ANOTHER
; PART OF EDIT 204).
;
;260 ALGOTS 9-AUG-81 QAR 10-6401 JBS
; MAKE LONG REAL ZERO PRINT AS 0, NOT 0&&-39.
;
;261 ALGLIB 9-AUG-81 QAR 10-6399 JBS
; PRINT <CR><FF> IN LIBRARY PROCEDURE "PAGE", NOT <CR><LF><FF>.
;
;262 ALGCOD 11-AUG-81 QAR 10-6405 JBS
; EDIT 220 BROKE /CHECKOFF WITH LONG REAL ARRAYS.
;
;263 ALGOTS 14-AUG-81 QAR 20-1719 JBS
; GIVE HEAP INTEGRITY CHECKER MORE INTEGRITY. IT WOULD LOOP
; FOREVER IF A NULL ENTRY WERE FOUND, WHICH CAN HAPPEN IF
; AN ARRAY GOES OUT-OF-BOUNDS WITH /CHECKOFF SPECIFIED.
;
;264 ALGDDT 17-AUG-81 QAR 10-6408 JBS
; MAKE ^R ECHO ALGDDT PROMPT AS WELL AS USER TYPEIN, FIX THE
; WAY ALGDDT DETERMINES IF THERE ARE MORE THAN 6 CHRS. IN A
; MODULE NAME.
;
;265 ALGLIB 19-AUG-81 QAR 10-6402 JBS
; TYPE GETSEG ERROR CODE IF GETSEG FAILS.
;
;266 ALGCON, 20-AUG-81 QAR 20-1553 JBS
; ALGSER TYPE OUT NAME OF MISSING LABEL OR PROCEDURE IF THERE IS
; NO MATCH FOR A FORWARD STATEMENT.
;
;267 ALGSTM 20-AUG-81 QAR 10-6409 JBS
; DON'T FORGET TO UNSTACK AFTER UNLABELED GOTO STATEMENTS.
; COMPLICATED "COMPUTED GOTO'S" CAUSE STACK MISALIGNMENT.
;
;270 ALGDDT 26-AUG-81 QAR 10-6407 JBS
; FAIL BETTER IF THERE IS NOT ENOUGH CORE TO START ALGDDT AFTER
; THE USER PROGRAM RUNS OUT OF CORE.
;
;271 ALGDDT 27-AUG-81 SPR 20-16711 JBS
; DON'T ASSUME INVALID BOOLEAN INPUT TO BE OCTAL #, DON'T
; BREAK ON ":=" (EDIT 264 BROKE THIS).
;
;272 ALGLIB 30-AUG-81 SPR 20-16709 JBS
; MAKE COS(0.0) YIELD 1, NOT 1.00000001. THIS IS NECESSARY
; FOR ARCCOS FUNCTIONS.
;
;273 ALGCON 30-SEP-81 SPR 20-16710 JBS
; CATCH USE OF SINGLE-QUOTE (I.E., RESERVED WORD DELIMITER)
; AFTER 'COMMENT' WHEN USING RESERVED WORD MODE, MAKE ROUTINE
; LMSGZ PRINT ERROR MESSAGES CORRECTLY DURING "PASS 1".
;
;274 ALGDDT, 30-SEP-81 QAR 20-1689 JBS
; ALGOTS, MISC. EDITS TO PRINT CORRECT LISTING HEADERS, ECHO ^C
; ALGCON FROM ALGDDT, BREAKOUTPUT WHEN ENTERING ALGDDT.
;
;275 ALGLIB 29-OCT-81 QAR 10-6512 JBS
; GET PROGRAM INFORMATION FROM GETTAB'S, NOT STARTUP AC'S, AND
; USE A PATH BLOCK IF IN AN SFD. MONITORS AFTER 7.01 DO NOT
; SUPPORT STARTUP AC'S.
;
;276 ALGCOD 12-OCT-81 QAR 20-1683 JBS
; FIX EDIT 262 TO USE CORRECT, NON-CONFLICTING AC'S FOR LOP
; AND SYM. THIS GENERATES CORRECT CODE FOR PLANTING RESULTS OF
; STRING AND LONG REAL CALCULATIONS.
;
;277 ALGOTS, 13-OCT-81 QAR 20-1704 JBS
; ALGPRM ACCOUNT FOR SKIP RETURN AFTER BREAKOUTPUT IN ERROR UUO HANDLER
; (REVISION OF EDIT 274), USE ANOTHER LOCATION TO SAVE A1 INSTEAD
; OF %SYS17 IN ERROR UUO HANDLER (STACK OVERFLOW IN THIS ROUTINE
; ALSO USED %SYS17), REVISE ALGOTS ROUTINE INITIA.
;
;300 ALGCON 23-OCT-81 QAR 10-6626 JBS
; PRINT NUMBER OF WARNINGS ON TTY WHEN CCL ENTRY IS USED, PUT
; "%" AND "?" BEFORE WARNING AND ERROR MESSAGES.
;
;301 ALGCON 21-OCT-81 QAR 20-1697 JBS
; PREVENT COMPILER HANG ON BAD USER SYNTAX.
;
;302 ALGCON 30-OCT-81 QAR 20-1707 JBS
; FIX ADDRESS CHECK WHEN DELETING BAD .REL FILE. BUFFER HEADER
; WAS GETTING STEPPED ON.
;
;303 ALGOTS, 26-OCT-81 QAR 10-6403 JBS
; ALGDDT, MAKE THE OTS EXECUTE-ONLY AS MUCH AS POSSIBLE. EXTENSION
; ALGSER, OF EDIT 234.
; ALGUTL
;
;304 ALGOTS, 4-NOV-81 QAR 20-1684 JBS
; ALGCON "GOTO" STATEMENT PROCESSOR FORGOT THAT CALLING GETOWN COULD
; CAUSE STACK SHIFTS, AND ACCORDINGLY DID NOT USE DELOCATED
; VALUES IN CALCULATIONS. ALSO, ADD A QUESTION MARK TO THE
; ERROR MESSAGE "UNDEFINED LABEL" IN ALGCON (TOPS-20 ONLY).
;
;305 ALGCON 5-NOV-81 QAR 10-6674 JBS
; FIX UNDEFINED TABLE SEARCH AT ZLAB (TOPS-10 ONLY).
;
;306 ALGCON 5-NOV-81 QAR 20-1706 JBS
; CHANGE COMPILER ERROR MESSAGE TO "NO VALUE ASSIGNED TO
; TYPED PROCEDURE, OR PROCEDURE NAME CONFLICTS WITH ANOTHER
; DEFINITION".
;
;307 ALGOTS 8-DEC-81 QAR 10-6745 JBS
; REMOVE EDIT 224 - BROKE "PRINT(LENGTH(VDATE))", ETC.
;
;310 ALGOTS 18-DEC-81 QAR 20-1732 JBS
; FIX ALGDDT "PROFILE" COMMAND BROKEN BY EDIT 303.
;
;END OF REVISION HISTORY
SUBTTL PATCH MACRO FOR DEVELOPMENT CHANGES
DEFINE PATCH (A),<
IFG <10-A>,<
PAT00'A=.
>
IFG <100-A>,<
IFLE <10-A>,<
PAT0'A=.
>>
IFLE <100-A>,<
PAT'A=.
>
>
SUBTTL EDIT MACRO FOR BUG-FIXES
DEFINE EDIT (A),<
IFG <10-A>,<
EDT00'A=.
>
IFG <100-A>,<
IFLE <10-A>,<
EDT0'A=.
>>
IFLE <100-A>,<
EDT'A=.
%E.'A=:0
>
>
SUBTTL ALGOL UUOS, OPDEFS AND MAGIC NUMBERS
; ALGOL UUOS:
OPDEF PJRST [JRST] ; PUSHJ POPJ COMBINATION
OPDEF DUMPR [001B8] ; DUMP UUO
OPDEF SYSER1 [002B8] ; SYSTEM ERROR UUO #1
OPDEF SYSER2 [003B8] ; SYSTEM ERROR UUO #2
OPDEF IOERR [004B8] ; INPUT/OUTPUT ERROR UUO
OPDEF LIBERR [005B8] ; LIBRARY ERROR UUO
OPDEF CCORE [006B8] ; CHANGE CORE UUO
OPDEF CCORE1 [007B8] ; SHIFT THE STACK
OPDEF BREAK [010B8] ; BREAKPOINT.
OPDEF DDTERR [011B8] ; ALGDDT ERROR.
; ALGOL OPDEFS:
OPDEF JFOVO [JFCL 11,]
; SPECIAL UNDERFLOW TREATMENT
OPDEF XCTA [XCT 1,]
; LEFT HAND SIDE REFERENCE
$A==000040 ; FLAG FOR DETECTING XCTA
IFE PROC-KA10,<
DEFINE LRLOAD(A,B)
< MOVE A,B
MOVE 1+A,1+B
>
DEFINE LRSTOR(A,B)
< MOVEM A,B
MOVEM 1+A,1+B
>
DEFINE LRNEG(A,B)
< DFN A,B
>>
IFE PROC-KI10,<
DEFINE LRLOAD(A,B)
< DMOVE A,B
>
DEFINE LRSTOR(A,B)
< DMOVEM A,B
>
DEFINE LRNEG(A,B)
< DMOVN A,A
IFN <<A+1>&17-<B>>,<PRINX DFN ERROR>
>>
; DEFAULT (& MINIMUM) HEAP SIZE
DELTA1==^D521
; KEN'S 'RANDOM' NUMBER:
RANDOM==647327
SUBTTL ACCUMULATOR ASSIGNMENTS
A0=0 ;[251] MUST BE 0 FOR SBYTE!
A1=1 ;[251]
A2=2 ;[251]
A3=3 ;[251]
A4=4 ;[251]
A5=5 ;[251]
A6=6 ;[251]
A7=7 ;[251]
A10=10 ;[251]
A11=11 ;[251]
A12=12 ;[251]
A13=13 ;[251]
DB=14 ;[251] DATA BASE
DL=15 ;[251] DYNAMIC LEVEL
AX=16 ;[251] AUXILIARY ADDRESS
SP=17 ;[251] DYNAMIC STACK POINTER
SUBTTL PROCEDURE CALL PARAMETER CODES
; PARAMETER CODES (FORMAL AND ACTUAL PARAMETER DESCRIPTORS):
; BIT 0: STATIC/DYNAMIC
$D==400000 ; DYNAMIC
; BITS 1-2: KIND:
$KIND==300000
$VAR==000000 ; VARIABLE
$EXP==100000 ; EXPRESSION
$ARR==200000 ; ARRAY
$PRO==300000 ; PROCEDURE
; BITS 3-8: TYPE:
$TYPE==077000
$I==007000 ; INTEGER
$R==016000 ; REAL
$LR==025000 ; LONG REAL
$C==031000 ; COMPLEX
$LC==032000 ; LONG COMPLEX
$B==043000 ; BOOLEAN
$S==070000 ; STRING
$L==052000 ; LABEL
$N==062000 ; NON-TYPE
; BITS 9-11: STATUS:
$STAT==000700
$STATUS==$STAT
$SIM==000000 ; SIMPLE
$REG==000100 ; REGULAR
$OWN==000200 ; OWN
$EXT==000300 ; EXTERNAL
$FOW==000400 ; FORWARD
$FON==000500 ; FORMAL-BY-NAME
$FOV==000600 ; FORMAL-BY-VALUE
$STMT==000700 ; STATEMENT
; BITS 12 - 17: P ADDRESS (ACTUALS)
$P==000077
$DEC==000040 ; DECLARED
; BITS 18 - 35: Q ADDRESS (ACTUALS)
; BITS 18 - 35: FORMAL PARAMETER ADDRESS (FORMALS)
; "WILD CARD" TYPES:
$WV==000000 ; WILD VARIABLE
$AB==001000 ; ARITHMETIC/BOOLEAN
$ABN==002000 ; ARITHMETIC/BOOLEAN/NON-TYPE
$IB==003000 ; INTEGER/BOOLEAN
$WF==004000 ; WILD FLOATING (REAL, LONG REAL)
$WA==040000 ; WILD ARITHMETIC (INTEGER, REAL, LONG REAL)
; COMPOUND TYPE BITS:
$ARC==040000 ; NOT ARITHMETIC
$IRLR==004000 ; INTEGER, REAL OR LONG REAL
$IR==060000 ; NOT (INTEGER OR REAL)
$CLC==044000 ; NOT (COMPLEX OR LONG COMPLEX)
$VAR1==020000 ; NOT VARIABLE OF ONE WORD
$VAR2==002000 ; NOT VARIABLE OF TWO WORDS
$VAL==000200 ; VALUE
; PROCEDURE INFORMATION (RELATIVE TO DL):
LINKDL==-7 ; DL CHAIN
LINKPC==-6 ; CONTEXT PC
PRGLNK==-5 ; PROGRAM LINK
PMBPTR==-4 ; POST-MORTEM BLOCK POINTER
CONDL==-3 ; CONTEXT DL
BLKPTR==-2 ; BLOCK POINTER
PLBLKL==-1 ; PROCEDURE LEVEL, BLOCK LEVEL
PRMMAX==12 ; MAXIMUM NUMBER OF PARAMETERS
; IN MIN, MAX ETC.
; BITS IN DB LEFT HALF
OMC1==400000 ; 0 - RUNNING ON KA10
; 1 - RUNNING ON KI10/KL10 (D.P. FLOATING PT)
OMC2==200000 ; 0 - RUNNING ON KA10/KI10
; 1 - RUNNING ON KL10
SMC1==100000 ; 0 - COMPILED ON KA10
; 1 - COMPILED ON KI10/KL10
SMC2==40000 ; 0 - COMPILED ON KA10/KI10
; 1 - COMPILED ON KL10
TMC1==20000 ; 0 - COMPILED FOR KA10
; 1 - COMPILED FOR KI10/KL10
TMC2==10000 ; 0 - COMPILED FOR KA10/KI10
; 1 - COMPILED FOR KL10
TRLVEL==4000 ; 0 - NO TRACE STATEMENTS
; 1 - PROGRAM CONTAINS TRACE STATEMENTS
INDDT==2000 ; 1 - IN DEBUGGING SYSTEM
STMTST==1000 ; 1 - USER HAS INTERRUPTED (^C)
TMPFL1==400 ; TEMPORARY FLAGS - USED ONLY IN GETOWN
TMPFL2==200 ; USED ONLY IN GETOWN
TMPFL3==100 ; USED ONLY IN FUNCT., AND IN ERRM30/DEBUGGER INTERFACE.
; BITS 13-17 ARE RESERVED !!!
OMC==OMC1
SMC==SMC1
TMC==TMC1
SUBTTL MAIN ASSIGNMENTS
; DUMP ROUTINE NOT LOADED: DUMP=0
; DUMP ROUTINE LOADED: DUMP=1
IFNDEF DUMP, <
DUMP=0> ; DEFAULT: DUMP ROUTINE NOT LOADED
SUBTTL DATA BASE STRUCTURE
%DBL==0
DEFINE %DBMAC(NAME,L<1>) <
NAME==%DBL
%DBL==%DBL+L
>
; ADDRESSES ARE RELATIVE TO THE DATA BASE (DB)
%DBMAC(%UUO,2) ; UUO ENTRY
%DBMAC(%CONC,4) ; CONTROL-C TRAP
%DBMAC(%CHAN) ; CURRENTLY SELECTED I/O CHANNELS
%DBMAC(%TTYCH) ; CURRENT CH #'S OPEN FOR TTY
%DBMAC(%RAND) ; RANDOM NUMBER
%DBMAC(%ESP) ; EMERGENCY STACK POINTER
%DBMAC(%ACCS,20) ; DUMP FOR USER ACCUMULATORS
%DBMAC(%SYS0) ; PARAMETER BLOCK ADDRESS
%DBMAC(%SYS1) ; INITIAL CORE SIZE
%DBMAC(%SYS2) ; INACTIVE HEAP CHAIN
%DBMAC(%SYS3) ; DATE OF STARTING PROGRAM
%DBMAC(%SYS4) ; TIME OF DAY AT START OF PROGRAM
%DBMAC(%SYS5) ; RUN TIME AT START OF PROGRAM
%DBMAC(%SYS6) ; DUMP COUNT
%DBMAC(%SYS7) ; GENERAL ACCUMULATOR SAVE
%DBMAC(%SYS10) ; GENERAL ACCUMULATOR SAVE
%DBMAC(%SYS11) ; GENERAL ACCUMULATOR SAVE
%DBMAC(%SYS12) ; GENERAL ACCUMULATOR SAVE
%DBMAC(%SYS13) ; GENERAL ACCUMULATOR SAVE
%DBMAC(%SYS14) ; USED IN APR ERROR HANDLER
%DBMAC(%SYS15) ; USED IN APR ERROR HANDLER
%DBMAC(%SYS16) ; USED IN APR ERROR HANDLER
%DBMAC(%SYS17) ; USED IN APR ERROR HANDLER
%DBMAC(%SYS20) ; COUNT OF STACK-SHIFTS
%DBMAC(%SYS21) ; SAVE INITIAL HEAP ORIGIN
%DBMAC(%SYS22) ; POINTER TO TRACE VECTOR
%DBMAC(%SYS23) ; COMPILER VERSION WORD
%DBMAC(%SYS24) ; MAX # USED WORDS IN HEAP-TABLE
%DBMAC(%IFDAT,3) ; FOR OVERLAY LOADER
%DBMAC(%SYSOV) ; FUNCT. PRIVATE HEAP-CHAIN BASE
%DBMAC(%%TTY) ; I/O DIRECTORY WORD FOR TTY (-1)
%DBMAC(%IODR,40) ; I/O DIRECTORY
%DBMAC(%TRAPS,100) ; TRAP VECTOR
%DBMAC(%TRPTR) ; POINTER TO CURRENT TRACE ENTRY
%DBMAC(%TRLNTH) ; LENGTH OF TRACE TABLE
%DBMAC(%TRLV) ; DYNAMIC BLOCK POINTER
%DBMAC(%TTY,6) ; CHANNEL -1 TTY (%TTCALL)
%DBMAC(%IBUFF,21) ; CHANNEL -1 INPUT BUFFER
%DBMAC(%OBUFF,21) ; CHANNEL -1 OUTPUT BUFFER
%DBMAC(%ES,22) ; EMERGENCY STACK
%DBMAC(%SFILE,12) ; SYMBOL FILE-NAME ETC.
%DBMAC(%DDTST) ; AOBJN POINTER TO SYMBOL TABLE
%DBMAC(%DDTBK) ; AOBJN POINTER TO BREAKPOINT TABLE
%DBMAC(%DDTAL) ; XWD ADDR OF CURRENT BREAKPOINT CONTROL BLOCK OR 0,
; PTR TO AUTOLIST TABLE OR 0 (FIXED 26. WORDS LONG)
%DBMAC(%DDTBI) ; AOBJN POINTER TO BLOCK INDEX
%DBMAC(%DDTBE) ; POINTER TO CURRENT BLKIDX ENTRY
%DBMAC(%DDTTY) ; SAVE OLD %CHAN DURING DDT.
%DBMAC(%DDTPT) ; XWD ADDR OF FAILING MODULE'S LOADER S.T. ENTRY,
; ADDR OF STN-ITEM OF ERROR OR PAUSE.
%DBMAC(%DDTIP) ; I/P POINTER, OR POINTER TO IT IF DDALST IS SET.
%DBMAC(%DDTER) ; L.H. = REDIRECT CHANNEL #,
; R.H. = ADDR OF LAST ERR MSG (FOR EXPERT/NOVICE)
%DBMAC(%DDTFL) ; SAVE FOR FLAG REGISTER.
%DBMAC(%DDTPC) ; XWD DL OF CONTEXT ESTABLISHED BY FNDADR,
; ADDR OF ERROR OR PAUSE. SAVED BY ERRMON OR PAUSE CODE.
%DBMAC(%DDTUW) ; FOR UNWIND COMMAND. XWD ADDR OF
; ORIGINAL ("PROPER") CONTEXT, HIGHEST (I.E.
; ("PROPER") DYNAMIC PROCEDURE LEVEL.
%DBMAC(%DDTPL) ; DYNAMIC PROCEDURE LEVEL
%DBMAC(%DDTDL) ; TRUE TOP-LEVEL DL (IN CASE OF THUNKS)
EDIT(043); ADD SOME LOCATIONS FOR CUSTOMERS
%DBMAC(%CUST1) ; [E043] TWO LOCATIONS FOR CUSTOMERS TO USE
%DBMAC(%CUST2) ; [E043] ..
%DBMAC(%DDTGO) ; ADDRESS OF "GOTO" BLOCK
%DBMAC(%DDTCB,33) ; ALGDDT COMMAND BUFFER
%DBMAC(%DDTFB,33) ; WHOLE-FIELD BUFFER
%DBMAC(%DDTIB,16) ; IDENTIFIER BUFFER
%DBMAC(%DDTNL) ; 'NEXT' DL,,'NEXT' B.P. ADDRESS
%DBMAC(%DDTCC) ; CONTROL-C STATUS WORD
%DBMAC(%UWCON) ; CONTEXT FOR UNWIND
%DBMAC(%UWTOP) ; MAXIMUM ALLOWED UNWIND
%DBMAC(%DDUWB) ; [E127] LH - CURRENT UNWOUND BLOCK LEVEL
; [E127] RH - MAX. BLOCK LVL AT THIS PROC LVL
%DBMAC(%DDERD) ; [E1000] ERROR DETECTED FLAG
%DBMAC(A01TMP,2) ; [231] TEMP. STORAGE FOR A0, A1 DURING "PRINT"
%DBMAC(A56TMP,2) ; [231] TEMP. STORAGE FOR A5, A6
%DBMAC(A13TMP) ; [231] TEMP. STORAGE FOR A13
%DBMAC(GETTMP,1) ; [251] "HEAP SPACE IN USE" SEMAPHORE
%DBMAC(%UUOTM) ; [277] USED IN UUO HANDLER AT ERRMNX
%DBL==%DBL ; LENGTH OF DATA-BASE
SUBTTL ENTRY FLAGS
; SET UP IN THE LH OF AX BY ALGOBJ IN ALGLIB:
REEN=400000 ; REENTER
SUBTTL IO CONTROL BITS
; STATUS BITS (IN LH OF IO DIRECTORY ENTRY)
PLDEV=400000 ; PHYSICAL/LOGICAL DEVICE (MUST BE BIT 0)
DIRDEV=200000 ; DIRECTORY DEVICE
TTYDEV=100000 ; TTY TYPE DEVICE
ABMODE=040000 ; ASCII/BINARY MODE
SPOPRN=020000 ; SPECIAL OPERATIONS PERMITTED
PLTDEV=010000 ; PLOTTER
TTYTTC=004000 ; TTY ON TTCALL
SPLDEV=002000 ; SPOOLED DEVICE
INDEV=001000 ; DEVICE CAN DO INPUT
ININT=000400 ; DEVICE INITED FOR INPUT
INFIL=000200 ; FILE OPEN FOR INPUT
INEOF=000100 ; INPUT EOF STATUS
INOK=000040 ; INPUT OK STATUS
OUTDEV=000020 ; DEVICE CAN DO OUTPUT
OUTINT=000010 ; DEVICE INITED FOR OUTPUT
OUTFIL=000004 ; FILE OPEN FOR OUTPUT
OUTEOF=000002 ; OUTPUT EOF STATUS
OUTOK=000001 ; OUTPUT OK STATUS
; MISCELLANEOUS SPECIAL BYTE VALUES:
LF=012 ; LINE FEED
FF=014 ; FORM FEED
CR=015 ; CARRIAGE RETURN
CONZ=032 ; CONTROL-Z
SUBTTL STRING ACCESS FLAGS
STR1=0 ; FIRST WORD
STR2=1 ; SECOND WORD
; FLAGS (USED IN LH OF SECOND WORD):
STRDYN=200000 ; DYNAMIC
STRPRC=100000 ; RESULT OF STRING PROCEDURE
STRSPB=070000 ; SPARE
STRBS=007700 ; BYTE SIZE
STRBSC=770077 ; STRBS COMPLEMENT
STRBC=000077 ; BYTE COUNT (CONTINUED IN RH)
STRBCC=777700 ; STRBC COMPLEMENT
;Flags for controlling Object Code dump formats (in L.H. of AC)
ZERFLG==400000
OBJOCT==200000
OBJASC==100000
OBJSIX==040000
OBJSYM==020000
OBJINT==010000
OBJREA==004000
OBJLR==0002000
OBJERR==001000
OBJDEF==OBJOCT!OBJSYM ;Default
; ERROR UUO FLAGS (LH OF M TABLES):
FATAL==400000 ; MUST BE BIT 0
ERRDEV==200000 ; INCLUDE DEVICE-NAME IN IOERR MSG
ERRFIL==100000 ; INCLUDE FILE.EXT IN IOERR MSG
ERR2PT==40000 ; MORE TO COME IN IOERR MSG
TRAPNO=000077
SUBTTL APR TRAP AND PC FLAGS
; APR TRAP FLAGS
APRO=000010 ; ARITHMETIC OVERFLOW
APRFPO=000100 ; FLOATING POINT OVERFLOW
APRNXM=010000 ; NONEXISTENT MEMORY
APRMPV=020000 ; MEMORY PROTECT VIOLATION
APRPLO=200000 ; PUSHDOWN LIST OVERFLOW
APRLOK=400000 ; TRAP LOCK
APRFLG=APRO!APRFPO!APRNXM!APRMPV!APRPLO!APRLOK
; PC FLAGS
PCNDIV=000040 ; NO DIVIDE
PCFPU=000100 ; FLOATING POINT UNDERFLOW
PCFPO=040000 ; FLOATING POINT OVERFLOW
PCO=400000 ; ARITHMETIC OVERFLOW
PCOVL=PCNDIV!PCFPO!PCO
; CONTROL-C TRAP FLAG
CONCF=2
ILLUUO=100 ; ILLEGAL UUO, ETC.
DQUOTA=20 ; EXCEEDING DISC QUOTA.
;PRINT FORMAT CONTROL FLAGS (LH OF A2):
NUMRNG=400000 ; NUMBER RANGE (EXPONENT SIGN - MUST BE BIT 0)
NUMSGN=200000 ; SIGN FLAG
INTOVL=100000 ; INTEGER OVERFLOW
LNGEXP=040000 ; LONG EXPONENT
LNGMAN=020000 ; LONG MANTISSA
DIGEXH=010000 ; DIGITS EXHAUSTED
NOSIGN=004000 ; PRINT - OR NOTHING (NOT SPACE FOR +)
; MAXIMUM SIGNIFICANCE:
INTDIG=^D11
SRDIG=^D9
SUBTTL MISC JOBDAT WORDS
JBTPRG=3
END