Trailing-Edge
-
PDP-10 Archives
-
decuslib10-10
-
43,50521/forprm.ka
There is 1 other file named forprm.ka in the archive. Click here to see a list.
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