UNIVERSAL FORPRM %4.(435) - FOROTS UNIVERSAL PARAMETER FILE
	SUBTTL	D. TODD/DRT/HPW/SRM/MD/DPL		09-APR-75
IFNDEF	FTWMU,<FTWMU==-1>	;0 IF DON'T WANT DEVTB. IN LOWSEG
				;STANDARD FOROTS HAS IT IN HIGHSEG.
;NOTE THAT THE ROUTINES IN FORWMU WHICH NORMALLY ACCEPT UNIT NUMBERS
;	WILL ONLY ACCEPT DEVICE NAMES IF THIS IS ZERO, AND THAT
;	DEVCHG WILL NOT WORK AT ALL.
	SUBTTL	REVISION HISTORY

;247	 -----	IMPLEMENT FULL SLIST AND ELIST
;250	 -----	IMPLEMENT ARRAY BOUNDS CHECKING
;260	 -----	SWITCH FT.EXT AND FT.ELT
;435	-----	FIX ERROR MACRO TO ALLOW UP TO 48 ERROR MSGS PER CLASS
	PASS2		;SAVE PRINT OUT ON PASS 2

;***COPYRIGHT 1972,1973,1974,1975 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***




; THIS FILE MUST BE ASSEMBLED WITH ALL SOURCE FILES
; OF THE FORTRAN OBJECT TIME STSTEM (FOROTS)

	MLON


VFOROT==4		;FOROTS SYSTEM VERSION NUMBER
VERNO==4		;MAJOR VERSION NUMBER
VEDIT==311		;EDIT NUMBER
VMINOR==00		;MINOR VERSION NUMBER
VWHO==0			;WHO EDITED LAST

VERPRM==BYTE (3)VWHO(9)VERNO(6)VMINOR(18)VEDIT

; EXTERNAL SYSTEM SYMBOLS
	EXTERN	.JBFF,.JBREL,.JBOPS,.JBSA,.JBTPC,.JBOPC,.JB41,.JBHRL
	EXTERN	FOROT%		;DEFINE ENTRY POINT TO FOROTS


; PDP-10 PROCESSOR SWITCHES
	; PDP-6		PR0CESS=PDP6
	; PDP-10 (KA10)	PROCESSOR=KA10
	; PDP-10 (KI10)	PROCESS==KI10

	PDP6==0
	KA10==1
	KI10==2
	IFNDEF CPU,<CPU==KA10>	;THE DEFAULT CPU

; FOROTS SYSTEM DEVICE

	;FOROTS ON DSK	SYSDEV=SIXBIT /DSK/
	;FOROTS ON SYS	SYSDEV=SIXBIT /SYS/

	IFNDEF SYSDEV,<SYSDEV=SIXBIT /SYS/> ;DEFAULT ON DSK FOR DEVELOP.


; SYSTEM PARAMETERS TO FOROTS
; ASSEMBLY OPTIONS
	;FOROTS VERSION NUMBERS FOR PREVIOUS RELEASES
	IFNDEF %V1,<%V1==-1>	;ASSEMBLE VERSION 1 CALLING SEQUENCE
				;DOES NOT CONFLICT WITH VERSION 2

	IFNDEF STK.SZ,<STK.SZ==100>	;DEFINE THE SIZE OF THE STACK
	IFNDEF STRCNK,<STRCNK==^D15>	;DEFAULT CHUNK SIZE FOR INTERNAL STRINGS
	IFNDEF QUEUER,<QUEUER==-1>	;ALLOW FOROTS TO CALL QMANGR FOR
				  	;FOR FILE PRINTING ETC.
	IFNDEF ASTFL,<ASTFL==-1>  	;SET ASTERICK FILL ON OVERFLOW ON
	IFNDEF CHKSUM,<CHKSUM==0> 	;SET CHECK SUMMING OF BINARY
	IFNDEF FORSE,<FORSE==-1>	;FORSE COMPATIABLE BINARY I/O
					;INPUT ONLY(BINARY)
	IFNDEF FLU.MX,<FLU.MX==^D63>	;THE LARGEST ALLOWABLE
					;FORTRAN LOGICAL UNIT NUMBER
			FLU.SZ==FLU.MX/6+2	;SIZE OF THE FLU TABLE
;	FORTRAN LIBRARY ASSEMBLY PARAMETERS
	IFNDEF F10LIB,<F10LIB==-1> 	;ASSEMBLE THE LIBRARY FOR FORTRAN 10
	IFNDEF F40LIB,<F40LIB==-1> 	;ASSEMBLE THE LIBRARY FOR F40
	IFN F40LIB,<%V1==-1>		;VERSION 1 CODE REQUIRED FOR F40 COMPILER


;	LOADING PARAMETERS
			CONCEA==0	;SET HIGH SEG PUBLIC
	DEFINE SEGMEN<	SALL
			CONCEA==-1	;SET HIGH SEGMENT CONCEALED
			TWOSEGMNETS
			RELOC 400000>
	DEFINE LIBSEG<	SALL
				>

;	TELL THE USER WHAT IS BEING ASSEMBLED

IFE CPU-PDP6,<PRINTX ASSEMBLING PDP-6 VERSION>
IFE CPU-KA10,<PRINTX ASSEMBLING KA-10 VERSION>
IFE CPU-KI10,<PRINTX ASSEMBLING KI-10 VERSION>
IFN F10LIB,<PRINTX ASSEMBLING FORTRAN 10 LIBRARY>
IFN F40LIB,<PRINTX ASSEMBLING F40 !JSA! ENTRIES>
	SUBTTL FORPRM - ACCUMULATOR ASSIGNMENTS
;TEMPORARY AC's.
T0=0	;The temporary AC's must be saved by  the
T1=1	;calling  program  or  module.   A called
T2=2	;routine  will  use  the  temporary  AC's
T3=3	;startiON SYt  T1  and working toward T5.
T4=4	;In general T0 will contain an  item  for
T5=5	;input  or  output  or  the  result  of a
	;conversion routine.
;GLOBAL AC's.
G1=6	;The GLOBAL AC's must be preserved by the
G2=7	;called  routine.   Any  routine  calling
G3=10	;another routine is  assured  the  GLOBAL
G4=11	;AC's  will remain unchanged, unless data
	;is to be passed as  arguments.   Passing
	;of  arguments must be clearly defined by
	;documentation in the calling and  called
	;routines.
;PERMANENT AC
P1=12	;P1 IS USED AS AN INTERNAL JSP AC.
P2=13	;AC P2 contain a pointer to  the  encoded
	;format  statement  in the right half and
	;flags in the left half.  The  left  half
	;flags   pertain   only   to  the  format
	;statement and the conversion routines.
;PERMANENT AC
P3=14	;The right half of P3 points to a  device
	;block   defining  the  functions  for  a
	;software   channel.    The   left   half
	;contains  flag  bits  pertaining  to the
	;unit pointed to by the right half.
;PERMANENT AC
P4=15	;P4 is a permanent  AC  pointing  to  the
	;orgin of the low segment data base.  The
	;contents of the right  half  of  p4  are
	;saved in the right half of .JBOPS in the
	;JOB DATA AREA.
L=16	;The link register contains a pointer  in
	;the  right  half pointing to an argument
	;block.  AC L is set up  by  the  FORTRAN
	;compiler  and used to transfer arguments
	;to FOROTS.
;PUSH DOWN POINTER
P=17	;The  stack   pointer   is   defined   at
	;initilization   time   and  can  not  be
	;redefined or used for any purpose  other
	;than the system stack pointer.  The only
	;exception  is   the   error   processing
	;routine  which  may  redefine  the stack
	;pointer to the  extended  stack  in  the
	;case of a push down overflow.
	SUBTTL	OPERATION CODE DEFINITIONS
; MISCELLANEOUS DEFINITIONS

	OPDEF PJRST [JRST]	;PUSHJ/POPJ
	OPDEF PJSP [JRST]	;JSP
	OPDEF	PJMPL	[JUMPL]	;[354] JUMPL/POPJ
	OPDEF JUMPO [JUMPL P3,]	;JUMP ON OUTPUT
	OPDEF JUMPI [JUMPGE P3,];JUMP ON INPUT
	OPDEF JUMPDP [JUMPL P2,]  ;JUMP ON SINGLE PRECISION VARIABLE
	OPDEF JUMPSP [JUMPGE P2,]  ;JUMP ON DOUBLE PRECISION VARIABLE
	OPDEF	KADFN [DFN]		;PRESERVE KA10 DEFINITION OF DFN
	SUBTTL PROCESSOR DEFINATION (KA10/KI10)

IFN CPU-KA10,<
DEFINE DOUBLE (A,B)<
	A
	B>
>

IFE CPU-KA10,<
DEFINE DOUBLE (A,B)<
ZZ1.==A&<777000,,0>
IFL ZZ1.,<ZZ1.==-ZZ1.-<1000,,0>>
ZZ1.==ZZ1.-<033000,,0>
IFE B,<ZZ1.==0>
ZZ2.==ZZ1.+<<B+200>_-8>&<000777,,777777>
IFL ZZ1.,<ZZ2.==0>
	A
	ZZ2.
SUPPRESS ZZ1.,ZZ2.>
DEFINE DMOVE(AC,M)<
	IFL <Z M>-<@>,<
	MOVE AC,M
	MOVE AC+1,1+M>

	IFGE <Z M>-<@>,<
	MOVEI AC+1,M
	MOVE AC,(AC+1)
	MOVE AC+1,1(AC+1)>
>

DEFINE	DMOVN(AC,M)<
	DMOVE AC,M
	DFN AC,AC+1>

DEFINE DMOVEM(AC,M)<
	MOVEM AC,M
	MOVEM AC+1,1+M
>

DEFINE FLMUL (AC,M,%OV)<
	MOVEM AC,AC+2
	FMPR AC+2,1+M
	JFCL (2)
	FMPR AC+1,M
	JFCL (2)
	UFA AC+1,AC+2
	JFCL
	FMPL AC,M
	JOV %OV
	UFA AC+1,AC+2
	FADL AC,AC+2
%OV: >

DEFINE FLDIV(AC,M,%OV)<
	FDVL AC,M
	JOV %OV
	MOVN AC+2,AC
	FMPR AC+2,1+M
	JFCL (2)
	UFA AC+1,AC+2
	FDVR AC+2,M
	JFCL
	FADL AC,AC+2
%OV: >

DEFINE FLADD(AC,M,%OV)<
	UFA AC+1,1+M
	FADL AC,M
	JOV %OV
	UFA AC+1,AC+2
	FADL AC,AC+2
%OV: >

>	;END OF KA10 CONDITIONAL
IFE CPU-KI10,<
OPDEF	FLADD	[DFAD]
OPDEF	FLMUL	[DFMP]
OPDEF	FLDIV	[DFDV]

DEFINE DFN (A,B)<	DMOVN A,A
IFN < <A+1>&17-<B>>,<PRINTX "DMOVN A,A" CAN'T REPLACE "DFN A,B">
>
>	;END OF KI10 CONDITIONAL

	SUBTTL FORPRM DATA MODE TYPE DEFINED BY FORTRAN BITS (14-17)

TP%UDF==0	;UNDEFINE TYPE CODE
TP%LOG==1	;LOGICAL
TP%INT==2	;INTEGER
TP%REA==4	;REAL
TP%OCT==6	;OCTAL
TP%DOR==10	;DOUBLE PRECISION REAL
TP%DOT==12	;DOUBLE PRECISION OCTAL
TP%COM==14	;COMPLEX
TP%LBL==7	;LABEL FIELD
TP%LIT==17	;LITERAL
	SUBTTL UUO BIT DEFINATIONS AND FLAGS

;LEFT HALT

;DEVCHR	DEVICE CHARASTICS UUO
DV.DRI==400000	;DECTAPE DIRECTORY IN CORE
DV.DSK==200000	;DEVICE IS A DSK
DV.CDR==100000	;DEVICE IS A READ 0R PUNCH (SEE DV.IN/DV.OUT)
DV.LPT==040000	;DEVICE IS A LINE PRINTER
DV.TTA==020000	;DEVICE IS THE USERS TTY
DV.TTU==010000	;DEVICE IS ANY TTY
DV.PTY==004000	;DEVICE IS A PTY
DV.DIS==002000	;DEVICE IS A DISPLAY
DV.LNG==001000	;LONG DISPATCH TABLE
DV.PTP==000400	;DEVICE IS A PAPER TAPE PUNCH
DV.PTR==000200	;DEVICE IS A PAPER TAPE READER
DV.DTA==000100	;DEVICE IS A DECTAPE
DV.AVL==000040	;DEVICE IS AVAILABLE
DV.MTA==000020	;DEVICE IA A MAG TAPE
DV.TTY==000010	;DEVICE IS A TELETYPE
DV.DIR==000004	;DEVICE HAS A DIRECTORY
DV.IN==000002	;DEVICE CAN DO INPUT
DV.OUT==000001	;DEVICE CAN DO OUTPUT

;RIGHT HALF

DV.ASC==400000	;DEVICE IS ASSIGN BY CONSOLE
DV.ASP==200000	;DEVICE IS ASIGNED BY PROGRAM

;DEVTYP DEVICE TYPE UUO

;LEFT HALT
TY.MAN==400000	;LOOKUP/ENTER MANDATORY
TY.AVL==000040	;DEVICE IS AVAILABLE
TY.SPL==000020	;DEVICE IS BEING SPOOLED
TY.INT==000010	;DEVICE IS INTERACTIVE DEVICE (BREAK OUTPUT)
TY.VAR==000004	;VARIABLE BUFFER SIZES
TY.IN==000002	;DEVICE CAN DO INPUT
TY.OUT==000001	;DEVICE CAN DO OUTPUT
	SUBTTL FOROTS FLAG DEFINATION BY ACCUMULATOR AND FUNCTION

;FLAGS DEFINED IN THE LEFT HALT OF AC P3

IO.INO==400000	;DIRECTION OF I/O 0=INPUT 1=OUTPUT (SIGN BIT ONLY)
IO.OPN==200000	;THE DEVICE IS OPEN LOOK/ENTER DONE
IO.RNG==100000	;CHANGE RINGS FOR THIS I/O REQUEST
IO.TTY==040000	;ANY TTY TYPE DEVICE
IO.TTA==020000	;USERS TTY (USES TTCALL'S)
IO.INT==010000	;INTERACTIVE DEVICE (BREAK OUTPUT)
IO.FMT==004000	;FORMAT STATEMENT IN USE
IO.EDC==002000	;PRECESSING ENCODE/DECODE REQUEST
IO.EOL==001000	;END OF LINE IS REACHED
IO.CCC==000400	;CONVERT THE FIRST CHARACTER OF A LINE (FORMS CONTROL)
IO.EOF==000200	;END OF THE INPUT STREAM CAN NOT ADVANCE
IO.STR==000100	;INCORE STRINGS ARE IN USE
IO.NON==000010	;NON STANDARD TYPE OF I/O (IMAGE,EBCDIC,BCD,ETC)
IO.RAN==000004	;RANDOM INPUT/OUTPUT
IO.SIO==000003	;SEQUENTAIL INPUT/OUTPUT
IO.SIN==000002	;SEQUENTIAL INPUT
IO.SOU==000001	;SEQUENTIAL OUTPUT

;FLAGS DEFINE IN G4 DURING OPEN STATEMENT PROCESSING
;INCLUDING ALL FLAGS IN P3 (ABOVE)

OP.OPN==400000	;SCANNER FLAG FOR FILES VRS MEMORY
OP.DIA==200000	;DIALOG ARGUMENT SCANNIN IN PROCESS
OP.ERR==100000	;ERROR FOUND IN OPEN ARGS
;40000	IS USED AS TEMPORAY DIALOGUE FLAG BY OPNARG
OP.SAC==20000	;OPNARG SET SOME RENAME ARGUMENT TO NEW VALUE


;FLAGS DEFINE IN THE LEFT HALF OF P2 DURING FORMAT PROCESSING

FT.PRC==400000	;0= SINGLE PRECISION , 1= DOUBLE PRECISION  SIGN ONLY
FT.ETP==200000	;1 E TYPE DATA CONVERSION (FLOUT-FLIRT)
FT.GTP==100000	;1 G TYPE CONVERSION
FT.LSD==040000	;SUPPRESS THE LEADING BLANKS FOR CONVERSION
FT.FSE==020000	;SET FORSE RECORD FOUND
FT.DOL==010000	;SUPPRESS THE <CR>,<LF> ON TTY OUTPUT
FT.LST==004000	;INPUT/OUTPUT LIST SEEN
FT.SLT==002000	;SLIST IN PROCESS
FT.EXT==001000	;EXTENDED LIST IN PROGRESS
FT.FIN==000400	;FIN CALLED
FT.NML==000200	;NAMELIST I/O
FT.LRP==000100	;LAST RIGHT PAREN SEEN

;BITS 30-35 ARE PROCESS DEPENDENT FLAGS AND ARE SHARED

;LIST DIRECTED I/O DEPENDENT FLAGS
FT.NUL==000040	;NULL ITEM SEEN
FT.QOT==000020	;QUOTED STRING SEEN IE '.............'
FT.SLH==000004	;[366] SLASH SEEN

;I/O LIST CALL PROCESSSING SWITCHES
FT.ELT=000010	;ELIST IN PROGRESS

;FORMAT STATEMENT ENCODING FLAGS
FT.TXX==000002	;SET T FORMAT SEEN (FORMAT ENCODING ONLY)
FT.SCL==000001	;NEGATIVE SCALE FACTOR FLAG (FORMAT ENCODING ONLY)

	SUBTTL FORPRM STATIC LOW SEGMENT DATA BASE DEFNS.

; THE STATIC LOW SEGMENT OF FOROTS IS ASSIGNED RELATIVE TO
; THE VALUE OF .JBFF AT INITILIZATION TIME.
; 
; THESE VALUES ARE RELATIVE TO .JBFF ONLY AND MUST BE INDEXED
; BY AC P4.
	DEFINE STATIC(NAME,SIZE)<	NAME==ZZ.
					ZZ.==ZZ.+SIZE>

;SYMBOL    DESCRITPION
ZZ.==0		;START THE STATIC TABLES AT RELATIVE ZERO

STATIC(ACC.SV,20)	;A sixteen word block to save the user's AC's.
			;All AC's are saved for debugging aids.
STATIC(IOL.SV,0)	;A 5 WORD BLOCK TO SAVE  AC'S (G3,G4,P1,P2,P3)
			;THIS BLOCK IS USED BY THE I/O LIST TO SAVE
			;A STATE TABLE OVER CALLS TO THE USER'S I/O LIST
STATIC(IOL.G3,1)	;SAVE AC G3
STATIC(IOL.G4,1)	;SAVE AC G4
STATIC(IOL.P1,1)	;SAVE AC P1
STATIC(IOL.P2,1)	;SAVE AC P2
STATIC(IOL.P3,1)	;SAVE AC P3
STATIC(USR.PC,1)	;The user's pc and flags save here
STATIC(ERR.PC,1)	;Optional error return address (ERR=)
			;Optional end of file return address(END=)
STATIC(MON.SV,1)	;The type of monitor currently running under.
STATIC(JOB.SV,1)	;GLOGAL JOB INFORMATION
STATIC(RUN.TM,1)	;ACCUMULATED RUNTIME SO FAR
STATIC(DAY.TM,1)	;TIME OF DAY THE PROGRAM IS STARTED
			;THESE TWO TABLE ARE PAIRED TOGETHER
STATIC(DEC.TB,3)	;DECODE buffer header
STATIC(ENC.TB,3)	;ENCODE buffer header
STATIC(CHN.TB,40)	;The software channel table.
			;CHANNELS 20-37 ARE PSEDUO CHANNELS TTY=20
STATIC(FRE.DY,1)	;A pointer to the free dynamic core heap.
STATIC(FMT.DY,1)	;A pointer to  the  encoded  FORMAT  STATEMENT
			;LIST
STATIC(FST.DY,1)	;A pointer to  the  current  FORMAT  STATEMENT
			;list.
STATIC(DAT.TP,3)	;Address  of   the   corrent   varriable   for
			;conversion.
STATIC(ERRMX.,1)	;ERROR COUNTER
STATIC(OVCNT.,1)	;ARITHMETIC FAULT COUNTER
STATIC(ILLEG.,1)	;ILLEGAL CHARACTER FLAG
STATIC(SCL.SV,1)	;Current scale factor (....nP.....)
STATIC(RER.SV,1)	;REREAD information.
STATIC(POS.TB,3)	;POSITION TABLE
			;POSTB+0=	CURRENT HORIZ POSITION
			;		+ FIXED LENGTH REORD
			;		- VARIABLE LENGTH RECORD
STATIC(FBG.BP,1)	;A byte pointer to the beginning of the format
			;statement.
STATIC(FEN.BP,1)	;A byte pointer  to  the  end  of  the  format
			;statement.
STATIC(LPN.BP,1)	;A point to the last level 0 or 1 left paren.
STATIC(FLU.BP,1)	;A BYTE POINTER TO THE FORTRAN LOGICAL UNIT TABLE WITH
			;THE CURRENT SOFTWARE CHANNEL NUMBER.
STATIC(ALT.PC,1)	;[225] The alternate return on END= or ERR=
STATIC(LST.TP,1)	;[247] Extended I/O list pointer
STATIC(CH.SAV,1)	;[354] Saved delimiter during FREE FORMAT input.
STATIC(REGS.0,1)	;[311] TO SAVE INITIAL RUN FILE SPEC (FORFUN)
STATIC(REGS.1,1)	;[311]
STATIC(REGS.2,1)	;[311]
STATIC(STK.SV,STK.SZ)	;The FOROTS system push down stack.
IFN FTWMU,<
;	S.M. #485.5	RRB/ 12-16-75
STATIC(DEV.TB,1)	;ADDRESS OF DEVTAB
STATIC(DEV.SZ,1)	;POSITIVE SIZE OF DEVTAB
>
STATIC(FLU.TB,FLU.SZ)	;The FORTRAN logical unit number table.
STATIC(PAG.TB,20)	;WORDS FOR FORFUN TO DO PAGE. UUOS
LOW.SZ==ZZ.		;SIZE OF THE STATIC LOW SEGMENT
	SUBTTL  FORPRM DD.BLK DEVICE BLOCK ALLOCATION

; THE DEVICE BLOCKS ARE ALLOCATED FROM FREE CORE AND POINTED TO
; BY TdressGHT HALF OF CHN.TB. THERE IS ONE DEVICE BLOCK FOR EVERY
; SOFTWARE CHANNEL THAT IS OPEN. ALL SYMBOLS DEFINED BELOW ARE
; RELATIVE TO THE BEGINNING OF THE DEVICE BLOCK.

	DEFINE DEVALC(NAME,SIZE)<	DD.'NAME==ZZ.
					ZZ.==ZZ.+SIZE>

;SYMBOL		DESCRIPTION
ZZ.==0			;START THE DEVICE BLOCK ORGIN AT RELATIVE ZERO
DEVALC(BLK,1)		;LEFT HALF
			; BIT  3    MAG TAPE PARITY
			; =1 FOR EVEN
			; =0 FOR ODD PARITY
			; BITS 4-5   DENSITY
			; =00	DEFAULT STANDARD
			; =01   200 BPI
			; =10   556 BPI
			; =11   800 BPI
			; BITS 6-9  INDEX TO THE ACCESS TABLE
			; BITS 10-13 INDEX TO THE MODE TABLE
			; BITS 14-17 INDEX TO THE DISPOSE TABLE
			;RIGHT HALF - COUNT OF INPUT/OUTPUT UUO'S
DEVALC(STS,1)		;DEVCHAR UUO BITS
DEVALC(OPN,1)		;FILE STATS, ETC (FIRST WORD OF THE OPEN UUO)
DEVALC(DEV,1)		;DEVICE NAME IN SIXBIT
DEVALC(RNG,1)		;LEFT - POINTER TO OUTPUT RING HEADER
			;RIGHT - POINTER TO INPUT RING HEADER
DEVALC(HRI,3)		;THE INPUT BUFFER RING HEADER
DEVALC(HRO,3)		;THE OUTPUT BUFFER RING HEADER
DEVALC(UNT,1)		;BITS (9-12) CONTAIN THE CHANNEL NUMBER
			;RIGHT HALT THE FORTRAN LOGICAL UNIT NUMBER (FLU)
DEVALC(ERV,1)		;POINTER TO THE ERROR VARIABLE IN USER CORE
DEVALC(LOG,1)		;FIXED LOGICAL RECORD SIZE IN WORDS
DEVALC(BUF,1)		;LEFT  - THE NUMBER OF BUFFERS ALLOCATED
			;RIGHT - THE SIZE OF EACH BUFFER
			;         INCLUDING THE THREE WORD HEAHER
DEVALC(CNV,1)		;ADDRESS OF A DYNAMIC CONVERSION TABLE
DEVALC(LIM,1)		;LEFT  - THE CURRENT LOGICAL RECORD
			;RIGHT - THE FILE SIZE LIMIT IN LOGICAL RECORDS
DEVALC(RLS,1)		;LEFT  - THE CURRENT REEL COUNT
			;RIGHT - THE ADDRESS OF AN ARRAY OF
			;        REEL IDENTIFICATIONS
DEVALC(CNT,1)		;EXTENDED LOOKUP/ENTER ARGUMENT COUNT
DEVALC(PPN,1)		;PROJECT #,PROGRAMMER # - OR A POINTER TO AN
			;SFD LIST
DEVALC(NAM,1)		;FILE NAME IN SIXBIT
DEVALC(EXT,1)		;FILE EXTENSION IN SIXBIT
DEVALC(PRV,1)		;FILE PRIVLEGES
DEVALC(SIZ,1)		;FILE SIZE
DEVALC(VER,1)		;OCTAL VERSION NUMBER
DEVALC(SPL,1)		;SPOOLING FILE NAME
DEVALC(EST,1)		;ESTIMENTED FIFE SIZE FOR ALLOCATION
DEVALC(ALC,1)		;FILE SIZE TO BE PRE-ALLOCATED
IFN QUEUER,<		;[240] IF QUEUEING IS ALLOWED
DEVALC(POS,1)		;[240] FIRST LOGICAL BLOCK TO ALLOCATE
DEVALC(FT1,1)		;[240] FUTURE NONPRIVILEGED ARGUMENT
DEVALC(NCA,1)		;[240] GNONPRIVILEGED CUSTOMER ARGUMENT
DEVALC(MTA,1)		;[240] TAPE LABEL
DEVALC(STR,1)		;[240] STRUCTURE NAME FOR FILE
>			;END OF QUEUER CONDITIONAL
DEVALC(ASC,1)		;ADDRESS OF THE ASSOCIATE VARIABLE FOR RANDOM
			;ACCESS MODE
DDB.SZ==ZZ.		;SIZE OF THE DEVICE BLOCK
	SUBTTL ENTRY POINTS TO FOROTS
; THE FOLLOWING MACRO DEFINITIOS ARE TAKEN FROM THE ALGOL OPERATING
; SYSTEM (ALGOT) WRITTEN BY RICHARD DE MORGEN.
; FOROTS USES THESE DEFINITIONS TO INSURE FUTURE COMPATIBILITY

	DEFINE R(A,B)
	<DEFINE B
	<FOROT%+A>>

	DEFINE JRSTI (C,A)
	<JRST C,A>

	DEFINE JRST (C,A)
	<IFNDEF Q,<Q=0>
	R \Q,A
	Q=Q+1>

	DEFINE FORDIR<
	JRST	1,INIT%		; FOROTS INITIALIZION ROUTINE (ASS DYNAMIC CORE)
	JRSTI	1,FORER%	;DEFINE THE ERROR PROCESSOR ENTRY POINT
	JRST	1,OPEN%		; DEVICE OPEN ROUTINE
	JRST	1,CLOSE%	; DEVICE CLOSE ROUTINE
	JRST	1,RELEA%	; DEVICE RELEASE ROUTINE
	JRST	1,IN%		; FORMATED INPUT ROUTINE
	JRST	1,OUT%		; FORMATED OUTPUT ROUTINE
	JRST	1,RTB%		; UN-FORMATED BINARY INPUT (CONTROL WORDS)
	JRST	1,WTB%		; UN-FORMATED BINARY OUTPUT (CONTROL WORDS)
	JRST	1,ENC%		; ENCODE ROUTINE
	JRST	1,DEC%		; DECODE ROUTINE
	JRST	1,NLI%		; NAMES LIST INPUT ROUTINE
	JRST	1,NLO%		; NAME LIST OUTPUT ROUTINE
	JRST	1,IOLST%	; INPUT/OUTPUT LIST PROCESSING ROUTINE
	JRST	1,FIN%		; INPUT/OUTPUT LIST TERMINATION ROUTINE
	JRST	1,MTOP%		; UTILITY FILE SPACING FUNCTIONS
	JRST	1,FIND%		; FIND THE NEXT RECORD FOR RANDOM ACCESS
	JRST	1,EXIT%		; TERMINATE THE PROGRAM EXECUTION
	JRST	1,ALCOR%	; DYNAMIC CORE ALLOCATION ROUTINE
	JRST	1,DECOR%	; DEALLOCATE DYNAMIC CORE
	JRST	1,ALCHN%	; ROUTINE TO GET A SOFTWARE CHANNEL
	JRST	1,DECHN%	; ROUTINE TO PUT A SOFTWARE CHANNEL
	JRST	1,TRACE%	; ROUTINE TO TRACE SUBROUTINE CALLS
	JRST	1,FUNCT%	;[232] OVERLAY INTERFACE
>
	FORDIR
	PURGE JRST,JRSTI
	SUPPRESS Q
	OPDEF JRSTI [JRST @]	;MAKE THE DIRECT MACRO WORK
	SUBTTL FORERR MACROS FOR DEFINING ENTRIES TO THE ERROR ROUTINE

	DEFINE RR(A,B)
	<DEFINE B
	<A>>

	DEFINE XWD(B,A)
	<IFNDEF QQ,<QQ==0>
	RR \QQ,A
	QQ==QQ+1>

	DEFINE ERRARG(CLASS)<
	A.==(SIXBIT/CLASS/)
	XWD	A.,ER%'CLASS	;DEFINE THE CLASS ERROR ENTRY
	>

	DEFINE ERRDIR<
	ERRARG	(SYS)		;0;FOROTS SYSTEM ERROR
		;TYPE CODE FOR SYS ERROR CALLS
		;0  FOROTS DETECTED SYSTEM ERROR
		;1  CALL TO EXIT THE PROGRAM (PRINT TIME ETC.)
		;2  ARGUMENT BLOCK IS NOT IN THE CORRECT FORMAT
		;3  MONITOR IS NOT BUILT TO SUPPORT THE FOROTS SYSTEM
		;4  FATAL ERROR RETURN TO MONITOR VIA EXIT
		;5  NO CORE AVAILABLE FOR LOW SEG EXPANSION
	ERRARG	(UUO)		;1;UUO ERRORS UUO DOES NOT EXIST
	ERRARG	(APR)		;2;PROCESSOR TRAPS OVER/UNDER  FLOW
		;TYPE CODES FOR APR ERROR CALLS
		;0  INTEGER OVERFLOW
		;1  INTEGER DIVIDE CHECK
		;2  ILLEGAL TRAP
		;3  ILLEGAL TRAP
		;4  FLOATING OVERFLOW
		;5  FLOATING DIVIDE CHACK
		;6  FLOATING  UNDERFLOW
		;7  ILLEGAL TRAP
	ERRARG	(OPN)		;3;OPEN ROUTINE ERROR
		;TYPE CODES FOR THE OPEN ERROR CALL
		;0  LOOKUP/ENTER ERROR MESSAGE DEFINE IN DD.EXT
		;1  ILLEGAL DATA MODE FOR DEVICE
		;2  ILLEGAL ACCESS FOR DEVICE
		;3  ACCESS ARGUMENT MISSING
		;4  NOT USED
		;5  DEVICE NOT AVAILABLE
		;6  NO SUCH DEVICE
		;7  NOT USED
		;10 TOO MANY DEVICES OPEN MAX=15.
		;11 SWITCH ERROR DURING DIALOG MODE
		;12 LOGICAL RECORD SIZE MISSING (RANDOM ACCESS)
		;13  FORTRN LOGICAL UNIT 0 ILLEGAL
	ERRARG	(DEV)		;4;DEVICE ERROR
	ERRARG	(DAT)		;5;DATA ERROR FORMATED/BINARY
		;TYPE CODES FOR DATA ERROR CALLS
		;0  UNDEFINED ERROR ENTRY
		;1  ILLEGAL CHARACTER IN FORMAT STATEMENT
		;2  ILLEGAL BINARY RECORD OR READING ASCII IN BINARY
		;3  CHECK SUM ERROR WHILE READING BINARY RECORDS
		;4  INPUT/OUTPUT LIST GREATER THAN RECORD SIZE
		;5  FIELD OVER FLOW ASTERICK FILL
		;6  INPUT/OUTPUT LIST WITH OUT DATA CONVERSION
		;7  ILLEGAL CAHARACTER IN DATA
		;10 WRITE OPERATION FOLLOWED BY A READ OR SPACING
	ERRARG	(QUE)		;6;QUEUEING ERROR
	ERRARG	(MSG)		;7;TYPE THE MESSAGE POINTED TO
				;   BY THE RETURN ADDRESS
	ERRARG	(LIB)		;10;LIBRARY CALL
	ERRARG	(SRE)		;11;[250] Array bounds checking
	ERRARG	(UNF)		;12;UNDEFINED
	ERRARG	(UNF)		;13;UNDEFINED
	ERRARG	(UNF)		;14;UNDEFINED
	ERRARG	(US0)		;15;RESERVED FOR THE USERS
	ERRARG	(US1)		;16;RESERVED FOR THE USERS
	ERRARG	(US2)		;17;RESERVED FOR THE USERS
	>
	ERRDIR
	SUPPRESS ZZ.,QQ
	PURGE XWD
	OPDEF ARG [JUMP]	;

	DEFINE ERROR(CLASS,TYPE,SEVER,RETURN)<
	IFNDEF ER%'CLASS,<PRINTX ER%'CLASS IS AN UNDEFINED ENTRY IN FORERR>
	IFL 57-TYPE,<PRINTX THE ERROR TYPE. TYPE FOR ER%'CLASS TOO BIG>
	IFG SEVER-17,<PRINTX THE SEVERITY CODE FOR ER%'CLASS TOO BIG>
IFE CONCEA,<
	XCT	ER%'CLASS,FORER.##	;PROCESS CLASS ERROR
>
IFN CONCEA,<
	XCT	ER%'CLASS,FORER%##	;PROCESS CLASS ERROR
>
	IFLE	TYPE-57,<CODE==JUMP>	;[435] JUMP NO-OP FOR MSGS 40-57
	IFLE	TYPE-37,<CODE==CAM>	;[435] CAM NO-OP FOR MSGS 20-37
	IFLE	TYPE-17,<CODE==CAI>	;[435] CAI NO-OP FOR MSGS 0-17

	CODE	TYPE,RETURN(SEVER)	;[435]
	PURGE	CODE			;[435]
	>

	DEFINE TYPSTR(A)<
	IF2,<IFNDEF TY%STR,<EXTERNAL TY%STR>>
	PUSHJ P,TY%STR
	CAI	A>
	DEFINE SHIFT(ZZ.,CC.)<
	IFN ZZ.&77B5,<ZZ.==ZZ._1
			IFE << ZZ.&760000000000>-740000000000>,<
					ZZ.==ZZ.&017777777777>
			EXP ZZ.!1B35
			ZZ.==0
			IFE CC.,<CC.==36>>
	ZZ.==ZZ._5+CC.>
	DEFINE FIVBIT (C.)<
	ZZ.==0
	CASE.==0
	IRPC C.<
	CC.==0
	IFGE "C."-"A",<IFLE "C."-"Z",<IFN CASE.,<CASE.==0
						SHIFT (ZZ.,37)>
				CC.=="C."&37>>
	IFGE "C."-"A"-40,<IFLE "C."-"Z"-40,<IFE CASE.,<CASE.==1
						SHIFT (ZZ.,37)>
				CC.="C."&37>>
	IFE CC.,<IFN "C."-" ",<PRINTX C. IS ILLEGAL IN FIVE BIT CODE>>
	SHIFT (ZZ.,CC.)>
	IFN ZZ.,<DEFINE FILL<IFE ZZ.&77B5,<ZZ.==ZZ._5
					FILL>
				>
		FILL>
	ZZ.==ZZ._1
	IFE << ZZ.&760000000000>-740000000000>,<
			ZZ.==ZZ.&017777777777>
	EXP	ZZ.
	>



	SUBTTL FORLIB MACROS (USED BY THE LIBRARY ROUTINES)

	DEFINE	FUNCT(A,B)<
	SALL
	C.....=0
	IRP B,<C.....=C.....+1>
	IF2,<IFNDEF A,<EXTERNAL A>>
	IFNB <B>,<
	PUSH	P,L
	MOVEI	L,[XWD -C.....,0
		IRP B,<B>]+1>
	PUSHJ	P,A
	IFNB <B>,<
	POP	P,L>>

	DEFINE HELLO (A,B)<
	SALL
	IFNB <B>,<IFIDN <B>,<.>,<SIXBIT /A/
				 ENTRY A'.
				 A'.:>
		  IFDIF <B>,<.>,<SIXBIT /B/
				 ENTRY A
				 A:>
		 >
	IFB  <B>,<SIXBIT /A/
		  ENTRY	A
		  A:>
IFN F40LIB,<
	CAIA
	PUSH	P,CEXIT.##
>
>	;END OF HELLO MACRO

	DEFINE GOODBY (N)<
	POPJ	P,N>
	END