.
.         DATA DEFINITIONS FOR FANG
.
.
.         (C)  Copyright 1972-1978  John Walker
.
.         This software is in the public domain
.
          DEF
.
.         COMMAND TABLE
.
CTNAME    EQUF      0                   COMMAND NAME (TWO WORDS)
CTPN      EQUF      2,,XH1              NUMBER OF PARAMETERS
CTPTP     EQUF      2,,H2               PARAMETER TABLE POINTER
CTMODE    EQUF      3,,S2               SCANNING MODE BITS
CTIMM     EQUF      3,,S3               IMMEDIATE EXECUTION MODE FLAG
CTAD      EQUF      3,,H2               PROCESS ROUTINE ADDRESS
CMDEL     EQU       4                   COMMAND TABLE ENTRY LENGTH
.
.         SCANNING MODE BIT VALUES
.
IU        EQU       1                   IMPLY 'U' OPTION
UO        EQU       2                   ALLOW 'U' OPTION
VO        EQU       4                   ALLOW 'V' OPTION
OP        EQU       8                   OMITTED REPEAT PARAMETERS OK
CL        EQU       16                  FILE PARAM MAY BE COMMUNICATIONS LINE
.
.         PARAMETER DESCRIPTOR ENTRY
.
PDTYPE    EQUF      0,,S1               PARAMETER TYPE CODE
PDOMIT    EQUF      0,,S2               PARAMETER MAY BE OMITTED FLAG
PDFLAGS   EQUF      0,,S3               READ-ONLY FILE USE FLAG
PDEL      EQU       1                   LENGTH OF ENTRY
.
.         PARAMETER TYPES
.
NUMBER    EQU       0                   INTEGER
FILE      EQU       1                   FILE NAME
STRING    EQU       2                   CHARACTER STRING
DATA      EQU       3                   DATA BUFFER
KEY       EQU       4                   SEARCH KEY BUFFER (LIKE DATA)
BLOCK     EQU       5                   DATA BLOCK BUFFER
CURBLK    EQU       6                   INTERNAL 'CURRENT BLOCK' BUFFER
ELEMENT   EQU       7                   ELEMENT NAME
ELTCLASS  EQU       8                   ELEMENT CLASS (INCLUDES ELEMENT NAME)
EITHER    EQU       9                   EITHER ELEMENT OR FILE
ELTYPE    EQU       10                  ELEMENT TYPE
CODE      EQU       97001               DEFINES CODE AREA
LPAR      EQU       040                 LEFT PARENTHESIS CODE
RPAR      EQU       041                 RIGHT PARENTHESIS CODE
CORCRD    EQU       042                 CORRECTION CARD BUFFER
PBUFR     EQU       043                 PATCH BUFFER TYPE
MBUFR     EQU       044                 MASK BUFFER
.
.         I/O FILE CONTROL TABLE
.
IOPKT     EQUF      0                   I/O PACKET START
IOFN      EQUF      0                   FILE NAME
IOINTNAM  EQUF      2,,S3               INTERRUPT ACTIVITY ID
IOINTAD   EQUF      2,,H2               INTERRUPT ROUTINE START ADDRESS
IOSTATUS  EQUF      3,,S1               I/O STATUS
IOFUNC    EQUF      3,,S2               I/O FUNCTION
IOAFC     EQUF      3,,S3               ABNORMAL FRAME COUNT
IOXFER    EQUF      3,,H2               WORDS TRANSFERRED
IOACW     EQUF      4                   ACCESS WORD
IODRAD    EQUF      5                   DRUM ADDRESS
IOBLKN    EQUF      5                   CURRENT BLOCK NUMBER
IOSENT    EQUF      6                   SEARCH SENTINEL
IOFIND    EQUF      7                   SEARCH FIND ADDRESS
IOFDT     EQUF      8,,H2               FDT POINTER
IOOPT     EQUF      9,,S1               FILE FORMAT OPTION
IOCOUNT   EQUF      9,,XH2              NUMBER OF 'BLOCKS' TO PROCESS
IOBLEN    EQUF      10,,H1              BLOCK LENGTH
IOWAD     EQUF      10,,S4              WORD-ADDRESSABLE FLAG
IOMASS    EQUF      10,,S5              MASS STORAGE FLAG
IOBB      EQUF      11                  START OF BOUNDED BUFFER
IOL       EQU       IOBB+6              LENGTH OF I/O FCT
.
.         I/O STATUS CODES
.
CKSMER    EQU       075                 CHECKSUM ERROR
STERM     EQU       076                 TERMINATE (STOP, BUT NOT AN ERROR)
.
.         IOZOOM CONTROL TABLE (REST LIKE I/O FCT)
.
IZBUFL    EQU       1792                LENGTH OF IOZOOM BUFFER
IZFS      EQU       IOBB                FIRST SECTOR IN CORE
IZLS      EQU       IOBB+1              LAST SECTOR IN CORE
IZDATA    EQU       IOBB+2              START OF DATA BUFFER
IZL       EQU       IZDATA+IZBUFL       LENGTH OF IOZOOM FCT
.
.         BLOCKED OUTPUT FCT ADDITIONAL EQUATES
.
IOBU      EQUF      IOBB,,H2            CURRENT BLOCKED BUFFER ADDRESS
IOWB      EQUF      IOBB,,H1            WORDS LEFT IN BUFFER
.
.         BLOCK BUFFER FORMAT
.
IBQ       EQUF      0                   QUEUE HEADER
IBLAST    EQUF      2,,S1               LAST BLOCK FLAG
IBSTAT    EQUF      2,,S2               STATUS OF OPERATION
IBAFC     EQUF      2,,S3               ABNORMAL FRAME COUNT
IBIOP     EQUF      2,,H2               POINTER TO I/O FCT
IBFDT     EQUF      2,,H2               FDT ADDRESS (STORED BLOCKS ONLY)
IBBLKN    EQUF      4                   BLOCK SEQUENCE NUMBER
IBMSAD    EQUF      4                   MASS STORAGE ADDRESS OF THIS BLOCK
IBLEN     EQUF      3,,H2               WORDS TRANSFERRED
IBDATA    EQUF      5                   START OF DATA IN BUFFER
.
.         @COPY,G file header block
.
cghsentl  equf      ibdata              'COPYG' or 'COPYGD'
cghblks   equf      ibdata+1            'BLKSEQ'
cghqual   equf      ibdata+2            file qualifier
cghfn     equf      ibdata+4            file name
cghafcyc  equf      ibdata+6            absolute f-cycle
cghtd     equf      ibdata+7            time and date of copy (DATE$)
cgheqt    equf      ibdata+9            equipment type of source file
cghitrk   equf      ibdata+10           highest track referenced in file
cghfang   equf      ibdata+11           start of '>FANG<' fill
.
.         COMMAND DESCRIPTOR BUFFER
.
CDBQ      EQUF      0                   QUEUE WORDS
CDBACT    EQUF      2,,H2               FORK-TO ADDRESS
CDBPC     EQUF      2,,H1               HEAD OF PARAMETER CHAIN
CDIMG     EQUF      3,,H1               IMAGE REQUESTING THIS COMMAND
CDRB      EQUF      3,,S4               ROADBLOCKED FLAG
CDCEASE   EQUF      3,,S5               CEASE FLAG
CDOPTS    EQUF      4                   OPTION BITS FOR THIS COMMAND
CDELTQ    EQUF      5                   COMMAND DESCRIPTOR QUEUE HEAD
CDBUFW    EQUF      7                   BUFFER CHAIN WORD
CDPATCH   EQUF      CDBUFW,,H1          PATCH BUFFER POINTER
CDBUFC    EQUF      CDBUFW,,H2          BUFFER CHAIN (BGETL)
CDMASK    EQUF      8,,H1               MASK BUFFER POINTER
.         EQUF      8,,H2               *FREE*
CDL       EQU       9                   COMMAND BUFFER LENGTH
.
.         PARAMETER BUFFER
.
PBLINK    EQUF      QFL                 LINK TO NEXT PARAMETER
PBFLAGS   EQUF      QHEAD,,S2           FLAGS FOR READ-ONLY AND OTHER MODES
PBTYPE    EQUF      QHEAD,,S3           PARAMETER TYPE
.                                         - 0 = INTEGER
.                                         - 1 = FILE
.                                         - 2 = STRING
.
PBVAL     EQUF      2                   VALUE:
.                                         INTEGER:  VALUE OF INTEGER
.                                         STRING:   LENGTH  (TEXT STARTS AT PBS
.                                         FILE:     FDT POINTER
PBSS      EQUF      3                   STRING START
PBL       EQU       3                   PARAMETER BUFFER LENGTH
.
.         PARAMETER BUFFER FLAG BITS
.
PBFRO     EQU       1                   READ-ONLY USE OF FILE BY THIS COMMAND
PBFSEC    EQU       2                   DON'T PRINT THIS PARAMETER IF BATCH
.
.         IMAGE BUFFER
.
IMLN      EQUF      0,,H1               LINE NUMBER
IMRN      EQUF      0,,S4               REPEAT IMAGE NUMBER
IMNS      EQUF      0,,S5               NUMBER OF DO SUBSCRIPTS
IMIMG     EQUF      1                   START OF LINE IMAGE
IMSS      EQUF      15                  SUBSCRIPT START LOCATION
IML       EQU       15                  LENGTH OF IMAGE BUFFER
.
.
.         FILE DESCRIPTOR TABLE
.
FDIN      EQUF      0                   INTERNAL NAME
FDFN      EQUF      2                   FILE NAME
FDQUAL    EQUF      4                   QUALIFIER
FDEQT     EQUF      6,,S1               EQUIPMENT CODE
FDINHBT   EQUF      6,,S2               INHIBIT BITS
FDQWM     EQUF      6,,S2               QUARTER WORD MODE FLAG
FDPOSF    EQUF      6,,S3               POSITION GRANULARITY FLAG
FDOPTS    EQUF      7                   ASSIGN OPTIONS
FDBITPC   EQUF      7,,S1               BITS PER CHARACTER
FDVOL     EQUF      8,,S1               # REELS ASSIGNED
FDCTMSPD  EQUF      8,,S1               CTM SPEED FOR LINE
FDMODES   EQUF      8,,H2               MODE BITS
FDFLW     EQUF      9                   FILE LENGTH IN WORDS (WAD)
.                                       WE USE THE MAXIMUM LENGTH AS THE LENGTH
.                                       SINCE THERE'S NO WAY TO GET THE HIGHEST
.                                       WRITTEN ADDRESS OF A TEMPORARY WORD-
.                                       ADDRESSABLE FILE.
FDHITRK   EQUF      9,,H1               HIGHEST TRACK REFERENCED
FDRINDX   EQUF      10,,S3              REEL INDEX
FDREADC   EQUF      11,,S1              READ IN-PROGRESS COUNT
FDWRITE   EQUF      11,,S2              WRITE LOCK
FDPROT    EQUF      11,,S3              PROTECT MODE FLAG
FDPROP    EQUF      11,,H2              PROPERTIES OF FILE EQUIPMENT
fdfext    equf      12,,h1              files extended
fdbext    equf      12,,xh2             blocks extended
FDFC      EQUF      13,,T1              F-CYCLE (RELATIVE)
FDLOCK    EQUF      13,,S3              IN-USE FLAG
.                                       0 = AVAILABLE FOR USE
.                                       1 = IN USE CURRENTLY
.                                       2 = ROADBLOCKED DUE TO ERROR
FDLINK    EQUF      13,,H2              CHAIN TO NEXT FDT
FDMSAD    EQUF      14                  CURRENT MASS STORAGE ADDRESS / ...
FDBLKN    EQUF      14                  ...OR CURRENT BLOCK NUMBER
FDBLOCK   EQUF      14                  LINK TO CURRENT DATA BUFFER (BLOCK ONLY)
FDTYPE    EQUF      15,,S1              FILE TYPE FLAG
.                                       0 = SINGLE TAPE
.                                       1 = MULTI TAPE
.                                       2 = MASS STORAGE
.                                       3 = WAD STORAGE
FDFRF     EQUF      15,,S2              MUST FREE FLAG
FDFMT     EQUF      15,,S3              FILE FORMAT INDICATOR
FDBLEN    EQUF      15,,H2              BLOCK LENGTH
FDRK      EQUF      16                  READ KEY
FDWK      EQUF      17                  WRITE KEY
FDIPLC    EQUF      18                  IN-PROGRESS ADDRESS
FDLT      EQUF      18,,H2              LINE TABLE POINTER
FDCRYK    EQUF      19                  CRYPTOGRAPHIC PROTECTION KEY (2 WORDS)
fdlablm   equf      21,,s1              tape labeling type flag
. free    equf      21,,s2-s6           * free *
FDL       EQU       22                  FDT LENGTH
.
.         ELEMENT DESCRIPTOR TABLE
.
ELFDT     EQUF      PBVAL,,H1           FDT OF SOURCE FILE
ELALL     EQUF      PBVAL,,S4           TYPE SELECTION BITS
ELCYC     EQUF      PBVAL,,T3           REQUESTED CYCLE
ELTBIT    EQUF      PBSS                TYPE SELECTION BITS
ELPFP     EQUF      PBSS+1              START OF PFP FORMAT PACKET
ELIN      EQUF      ELPFP               INTERNAL FILE NAME FROM FDT
ELELTN    EQUF      ELPFP+2             ELEMENT NAME
ELTTYPE   EQUF      ELPFP+5,,S3         ELEMENT TYPE
ELTVERN   EQUF      ELPFP+6             VERSION NAME
ELTXT     EQUF      ELPFP+10            TEXT ADDRESS
ELTND     EQUF      ELPFP+11            TIME AND DATE
ELL       EQU       ELPFP+12            LENGTH OF PACKET
.
.         DATA ITEM BUFFER
.
DBTYPE    EQUF      QL,,S3              ITEM TYPE
DBLEN     EQUF      QL,,T1              LENGTH OF DATA ENTRY IN WORDS
DBREPC    EQUF      QL,,H2              REPEAT COUNT
DBVAL     EQUF      QL+1                VALUE WORD
DBL       EQU       QL+1                LENGTH OF ENTRY
.
.         PATCH BUFFER
.
PADELC    EQUF      QL,,H1              # WORDS TO DELETE
PACPYC    EQUF      QL,,H2              # WORDS TO COPY
PAADDC    EQUF      QL+1,,H1            # WORDS TO ADD
PAL       EQU       QL+2                LENGTH OF PATCH BUFFER
.
.         SEARCH FIND BUFFER
.
SFFINDW   EQUF      QL                  FIND ADDRESS WITHIN BLOCK
SFL       EQU       QL+1                LENGTH OF SEARCH FIND BUFFER
.
.         CRYPTOGRAPHIC PROTECTION WORK BUFFER
.
PROTL     EQU       4                   WORK BUFFER LENGTH
.
.         FILE TYPE CODES
.
TSINGLE   EQU       0                   SINGLE TAPE
TMULTI    EQU       1                   MULTI-TAPE FILE
FFAST     EQU       2                   FASTRAND FORMAT MASS STORAGE
FWAD      EQU       3                   WORD-ADDRESSABLE MASS STORAGE
.
.         Tape labeling type codes
.
tlunk     equ       0                   tape label type not yet determined
tlunl     equ       1                   unlabeled (or old format labeled)
tllbl     equ       2                   ANSI (8 bit) labeled tape
.
.         FILE TABLE INDEX DEFINITIONS
.
FTIFN     EQUF      0                   FILE NAME
FTIPF     EQUF      6                   '**PF**'
FTIWL     EQUF      7                   NEXT WRITE ADDRESS
FTIET     EQUF      9                   ELEMENT TABLE INFORMATION
FTIAPT    EQUF      12                  ASSEMBLER PROCEDURE TABLE
FTICPT    EQUF      15                  COBOL PROCEDURE TABLE
FTIFPT    EQUF      18                  FORTRAN PROCEDURE TABLE
FTIEPT    EQUF      21                  ENTRY POINT TABLE INFORMATION
FTILABS   EQUF      25                  LAST ABSOLUTE ELEMENT
FTIL      EQU       34+15               LENGTH OF FTI BUFFER
.
.         ELEMENT MAPPING TABLE ITEM
.
EMTYP     EQUF      0,,S3               ELEMENT TYPE
EMLNK     EQUF      0,,H2               LINK TO NEXT ITEM
EMISN     EQUF      1,,H1               INPUT SEQUENCE NUMBER
EMOSN     EQUF      1,,H2               OUTPUT SEQUENCE NUMBER
EMITA     EQUF      2                   INPUT TEXT ADDRESS
EMOTA     EQUF      3                   OUTPUT TEXT ADDRESS
EML       EQUF      4                   LENGTH OF ENTRY
.
.         ELEMENT ITEM DEFINITIONS
.
EIEN      EQUF      0                   ELEMENT NAME
EIVLNK    EQUF      2,,H1               VERSION LINK
EIPLNK    EQUF      2,,H2               POINTER LINK
EISEQ     EQUF      2,,H1               SEQUENCE NUMBER (FILLED BY FILESCAN)
EINSEQ    EQUF      2,,H2               NEW SEQUENCE NUMBER (FOR TRANSFER, PACK)
EIFLGW    EQUF      3                   FLAGS WORD (NEGATIVE IF DELETED)
EIFLG     EQUF      EIFLGW,,T1          FLAG BITS FOR ELEMENT MODES
EITYP     EQUF      EIFLGW,,S3          ELEMENT TYPE
EITLNK    EQUF      3,,H2               TYPE LINK
EITYP     EQUF      3,,S3               ELEMENT TYPE
EIVER     EQUF      4                   VERSION NAME
EICYCW    EQUF      6                   CYCLE WORD
EICLIM    EQUF      EICYCW,,T1          CYCLES TO KEEP
EILATC    EQUF      EICYCW,,T2          LATEST CYCLE
EINOCY    EQUF      EICYCW,,T3          NUMBER OF CYCLES PRESENT
EIPCOD    EQUF      7,,S1               PROCESSOR CODE (SYMBOLIC ONLY)
EITXTL    EQUF      7,,H2               TEXT LENGTH IN SECTORS
EIPREA    EQUF      6                   PREAMBLE ADDRESS (RELOCATABLE ONLY)
EIPREL    EQUF      7,,H1               PREAMBLE LENGTH (RELOCATABLE ONLY)
EITXTA    EQUF      8                   TEXT ADDRESS
EITIME    EQUF      9                   TIME AND DATE (TDATE$ BACKWARDS)
EIL       EQU       10                  LENGTH OF ELEMENT ITEM
.
.         FILESCAN BUFFER EXTENSION
.
EIFQ      EQUF      10                  FILESCAN QUEUE HEAD
EIFL      EQU       12                  FILESCAN ELEMENT ITEM BUFFER LENGTH
.
.         ELEMENT TYPE NAMES
.
TY$SYM    EQU       1                   SYMBOLIC
TY$ASMP   EQU       2                   ASM PROC
TY$COBP   EQU       3                   COBOL PROC
TY$FORP   EQU       4                   FORTRAN PROC (4TRAN ?)
TY$REL    EQU       5                   RELOCATABLE
TY$ABS    EQU       6                   ABSOLUTE
TY$OMN    EQU       7                   OMNIBUS
.
.         FLAG BIT DEFINITIONS
.
FL$ERR    EQU       1                   MARKED IN ERROR
FL$QW     EQU       2                   QUARTER WORD
FL$TW     EQU       4                   THIRD WORD
FL$ASC    EQU       020                 ASCII SOURCE
FL$AFCM   EQU       040                 ARITHMETIC FAULT COMPATIBILITY MODE
FL$AFNI   EQU       0100                ARITHMETIC FAULT NON-INTERRUPT MODE
.
.         TOC COLUMN DEFINITIONS
.
TO$NV     EQU       5                   NAME / VERSION
TO$TY     EQU       35                  TYPE
TO$DAT    EQU       55                  DATE
TO$TI     EQU       TO$DAT+11           TIME
TO$PL     EQU       TO$TI+10            PREAMBLE LENGTH
TO$TL     EQU       TO$PL+5             TEXT LENGTH
TO$CL     EQU       TO$TL+6             OLDEST CYCLE PRESENT
TO$CM     EQU       TO$CL+3             MAX CYCLES TO RETAIN
TO$LOC    EQU       TO$CM+4             STARTING TEXT ADDRESS
TO$FLG    EQU       TO$LOC+9            FLAGS
.
.         SEGMENT LOAD TABLE DEFINITIONS
.
SGINC     EQUF      0,,S1               IN CORE FLAG
SGTYP     EQUF      0,,S2               'R' IF RSEG
SGLNK     EQUF      0,,H2               LINK TO NEXT INCORE SEGMENT
SGLIB     EQUF      1,,H1               LAST IBANK ADDRESS
SGSIB     EQUF      1,,H2               FIRST IBANK ADDRESS
SGLDB     EQUF      2,,H1               LAST DBANK ADDRESS
SGSDB     EQUF      2,,H2               FIRST DBANK ADDRESS
SGDRM     EQUF      3                   RELATIVE DRUM ADDRESS
.
.         SDF I/O FILE CONTROL TABLE
.
SDFIN     EQUF      0                   INTERNAL NAME / I/O PACKET
SDFFUNC   EQUF      3,,T1               FUNCTION AND STATUS FIELD
SDFBLW    EQUF      4,,H1               BUFFER LENGTH IN WORDS
SDFADR    EQUF      5                   FILE ADDRESS
SDFBUFW   EQUF      6                   BUFFER WORD
SDFBLS    EQUF      7,,H1               BUFFER LENGTH IN SECTORS
SDFIMGL   EQUF      7,,H2               IMAGE LENGTH
SDFIMA    EQUF      8                   IMAGE POINTER WORD (1,0)
SDFBPT    EQUF      9                   BUFFER POINTER WORD (1,0)
SDFICW    EQUF      10                  IMAGE CONTROL WORD
SDFIMAGE  EQUF      11                  SDF IMAGE START
SDFBUF1   EQUF      SDFIMAGE+MAXIML     FIRST I/O BUFFER
SDFBUF2   EQUF      SDFBUF1+BUFSDFT     SDF I/O BUFFER 2
SDFL      EQU       SDFBUF2+BUFSDFT     SDF I/O FCT AND BUFFER LENGTH
.
.         EQUIPMENT TYPE PROPERTY TABLE
.
EPTNAME   EQUF      0                   NAME OF EQUIPMENT TYPE
EPTPROP   EQUF      0,,T3               EQUIPMENT TYPE PROPERTY BITS
.
.         EQUIPMENT TYPE PROPERTY BITS
.
EPMASS    EQUF      1                   MASS STORAGE EQUIPMENT
EPTAPE    EQUF      2                   TAPE EQUIPMENT
EPWAD     EQUF      4                   WORD-ADDRESSABLE FILE MODE
EPCOMM    EQUF      010                 COMMUNICATIONS LINE TERMINAL
EP9TRK    EQUF      020                 NINE-TRACK TAPE EQUIPMENT
EPMSA     EQUF      040                 CONNECTED VIA MSA
.
.         COMMUNICATIONS LINE TABLE
.
LTFN      EQUF      0                   INTERNAL FILE NAME
LTOSTAT   EQUF      2,,S1               OUTPUT STATUS
LTQWI     EQUF      2,,S2               QUARTER WORD COMPLETION INDICATOR
LTOUSG    EQUF      2,,S3               OUTPUT USAGE
LTOCRTN   EQUF      2,,H2               OUTPUT COMPLETION ROUTINE
LTOCOUNT  EQUF      3,,H1               OUTPUT CHARACTER COUNT
LTOBUF    EQUF      3,,H2               OUTPUT BUFFER
LTOFCNT   EQUF      5,,H1               OUTPUT FINAL COUNT
LTOBTIM   EQUF      5,,H2               OUTPUT BUFFER TIME
LTISTAT   EQUF      6,,S1               INPUT STATUS
LTIEND    EQUF      6,,S2               END OF INPUT ACTION
LTIUSG    EQUF      6,,S3               INPUT USAGE
LTICRTN   EQUF      6,,H2               INPUT COMPLETION ROUTINE
LTICOUNT  EQUF      7,,H1               INPUT CHARACTER COUNT
LTIBUF    EQUF      7,,H2               INPUT BUFFER ADDRESS
LTIFCNT   EQUF      9,,H1               INPUT FINAL COUNT
LTIBTIM   EQUF      9,,H2               INPUT BUFFER TIME
LTDSTAT   EQUF      10,,S1              DIAL STATUS
LTDUSG    EQUF      10,,S3              DIAL USAGE
LTDCRTN   EQUF      10,,H2              DIAL COMPLETION ROUTINE
LTDCOUNT  EQUF      11,,H1              DIAL CHARACTER COUNT
LTDBUF    EQUF      11,,H2              DIAL BUFFER ADDRESS
.
.         LINE TABLE EXTENSION FOR INTERCHANGE PROCESSING
.
LTSYNC    EQUF      12,,Q1              SYNC CHARACTER FOR LINE (0=ASYNC)
LTSCN     EQUF      12,,Q2              NEXT SUBCHANNEL FOR LINE
LTQWM     EQUF      12,,S4              QUARTER WORD MODE FLAG
LTBITPC   EQUF      12,,S5              BITS PER CHARACTER
LTCLOSE   EQUF      12,,S6              LINE TERMINATION FLAG
LTCMSK    EQUF      13,,Q1              CHARACTER MASK (LTBITPC 1 BITS)
LTBLW     EQUF      13,,Q2              COMMUNICATIONS BUFFER LENGTH
LTTIME    EQUF      13,,Q3              OUTPUT TIMER FOR THIS LINE
.         EQUF      13,,Q4              *FREE*
LTINAME   EQUF      14                  INPUT ACTIVITY NAME
LTONAME   EQUF      15                  OUTPUT ACTIVITY NAME
LTOPTMX   EQUF      16                  LARGEST WORD WORTH OPTIMISING
LTSCQ     EQUF      17                  SUBCHANNEL QUEUE
LTOQ      EQUF      LTSCQ+QL            OUTPUT BUFFER QUEUE
LTOAQ     EQUF      LTOQ+QL             OUTPUT AVAILABLE QUEUE
LTL       EQU       LTOAQ+QL            LENGTH OF LINE TABLE
.
.         SUBCHANNEL CONTROL TABLE
.
STQ       EQUF      0                   LINK WORDS
STSCN     EQUF      QL,,Q1              SUBCHANNEL NUMBER
STTIME    EQUF      QL,,Q2              TIMER VALUE
STIALT    EQUF      QL,,S4              INPUT ALTERNATION BIT
STOALT    EQUF      QL,,S5              OUTPUT ALTERNATION BIT
STBITL    EQUF      QL,,S6              BITS ACCRUED IN INPUT WORD
STLT      EQUF      QL+1,,H1            LINE TABLE BACKPOINTER
STRETRANS EQUF      QL+1,,H2            LAST TEXT MESSAGE SENT
.                                       ZERO IF MESSAGE ACKNOWLEDGED
STIB      EQUF      QL+2,,H1            CURRENT INPUT BUFFER
STIBP     EQUF      QL+2,,H2            INPUT BUFFER POINTER
STIWA     EQUF      QL+3                INPUT WORD ACCUMULATOR
STIRTN    EQUF      QL+4,,H1            GETCHAR RETURN ADDRESS
STORTNP   EQUF      QL+4,,H2            OUTWORD RETURN ADDRESS
STOWA     EQUF      5                   OUTPUT WORD ACCUMULATOR
STBITLO   EQUF      QL+6,,S1            BITS LEFT IN OUTPUT WORD
STOPTWF   EQUF      QL+6,,S2            CURRENT OUTPUT WORD BEING OPTIMISED
.         EQUF      QL+6,,S3            *FREE*
STOCRTNP  EQUF      QL+6,,H2            OUTCHAR RETURN POINT
STOWLB    EQUF      QL+7,,H1            WORDS LEFT IN BUFFER
STCDB     EQUF      QL+7,,H2            COMMAND BUFFER FOR INTERCHANGE
STOB      EQUF      QL+8,,H1            CURRENT OUTPUT BUFFER
STOBP     EQUF      QL+8,,H2            OUTPUT BUFFER POINTER
STFCT     EQUF      QL+9,,H1            I/O FCT FOR INPUT/OUTPUT FILE
STDMFCT   EQUF      QL+9,,H2            DRIVE FCT FOR FILE OUTPUT
.                                       (ZERO FOR FILE SOURCE INTERCHANGE)
STOSUPP   EQUF      QL+10               SUPPRESSION SAVE
STILEN    EQUF      QL+12               LENGTH OF INPUT BLOCK
STMSAD    EQUF      QL+13               ADDRESS OF LAST BLOCK SENT
STL       EQU       QL+14               LENGTH OF SUBCHANNEL TABLE
.
.         INTERCHANGE TRANSACTION QUEUE ITEM
.
ITQ       EQUF      0                   LINK WORDS
ITTYPE    EQUF      QL,,S1              TYPE OF TRANSACTION
ITRELF    EQUF      QL,,S2              RELEASE ON CHANNEL RESUME FLAG
.         EQUF      QL,,S3              *FREE*
ITLT      EQUF      QL,,H2              LINE TABLE POINTER
ITST      EQUF      QL+1,,H1            SUBCHANNEL TABLE POINTER
.         EQUF      QL+1,,H2            *FREE*
ITTEXT    EQUF      QL+2                TEXT START ADDRESS
.
.         TRANSACTION QUEUE ITEM TYPES
.
ITYIN     EQU       1                   INPUT COMPLETION
ITYTIME   EQU       2                   TIMEOUT ON OUTPUT
ITYSTOUT  EQU       3                   START INTERCHANGE OUTPUT
.
.         INTERCHANGE PREFIX BLOCK
.
IPBH      EQUF      0                   '*INTR*'
IPBFL     EQUF      1                   FANG LEVEL (FIELDATA)
IPBSITE   EQUF      2                   SITEID SENDING
IPBQUAL   EQUF      3                   QUALIFIER OF FILE BEING SENT
IPBFNAME  EQUF      5                   FILE NAME BEING SENT
IPBEQTW   EQUF      7                   EQUIPMENT TYPE, F-CYCLE, ETC.
IPBPROP   EQUF      8,,H1               FILE PROPERTIES
IPBIOOP   EQUF      8,,S4               I/O OPTIONS ON FILE
IPBL      EQU       9                   LENGTH OF PREFIX BLOCK
.
.         INTERCHANGE BUFFER LENGTH PARAMETERS
.
ICHTXTL   EQU       80                  TEXT LENGTH IN CHARACTERS
ICHPREL   EQU       4                   PREAMBLE:  SOH <SBC> <TYP> STX
ICHPOST   EQU       1                   POSTAMBLE:  EOT
ICHNSYN   EQU       4                   NUMBER OF SYNCS TO SEND
.
STRUCTURES* PROC    0,0                 DEFINE DATA STRUCTURES
          END
.
.         MASTER DEFINITION PROC, INVOKES CONFIG AND STRUCTURES
.
FANG*     PROC      0
insert*   delete
          CONFIG    .                   DEFINE CONFIGURATION PARAMETERS
          SCHDEF    .                   DEFINE SCHEDULER DATA STRUCTURES
          STRUCTURES .                  DEFINE DATA STRUCTURES
.
litc      equ       1                   set literal counter for reentrant code
$(LITC)   LIT
ctl$bnk*(0) equ     litc                define counter for packets
          END
.
.
.         PROC to define names of PROC processing routines
.
P         PROC      *0
PROCROUTINES* NAME  0
XPTNL*    EQUF      PRCTB1,,H1          LOOK UP BY SEQUENCE NUMBER
RPFXPT*   EQUF      PRCTB1,,H2          READ PROC TABLE
WPFXPT*   EQUF      PRCTB2,,H1          WRITE PROC TABLE
XPTID*    EQUF      PRCTB2,,H2          PROC ITEM DELETE
XPTIS*    EQUF      PRCTB3,,H1          ITEM SEARCH
XPTIA*    EQUF      PRCTB3,,H2          PROC ITEM ADD
          END
.
P         PROC      1,2
JDEM*     NAME      0
JNDEM*    NAME      1
          DO        P(0,0)=0 , TZ DEMAND
          DO        P(0,0)=1 , TNZ DEMAND
          J         P(1,1),P(1,2)
          END
.
P         PROC      *1
BGET*     NAME      0
          DO        P(1)>0 , LA,U A0,P(1,1)
          LMJ       X11,BGET
          END
.
P         PROC      *1
BRELP*    NAME      0
     DO    (P(1)>0)**(1-((P(1)=1)**(P(1,1)=12))) , LA 12,P(1,1),P(1,2),P(1,3)
          LMJ       X11,BREL
          END
.
P         PROC      0,1
BRELC*    NAME      0
          LMJ       X11,BRELC
          END
.
P         PROC      *1
BGETL*    NAME      0
          DO        P(1)>0 , LA,14 12,P(1,1)
          LMJ       5,BGETL
          END
.
P         PROC      *0
BRELA*    NAME      0
          LMJ       5,BRELA
          END
.
P         PROC      *1
BRELR*    NAME      0
          DO  (P(1)>0)**(1-((P(1)=1)**(P(1,1)=12))) , LA 12,P(1,1),P(1,2),P(1,3)
          LMJ       5,BRELR
          END
.
.         FAST SCANNER PROCS
.
P         PROC      *1
SCAN*     NAME      0
          LA,U      A0,P(1,1)           LOAD IMAGE ADDRESS
          LR,U      R1,P(1,2)-1         LOAD IMAGE LENGTH - 1
          LMJ       X11,SCAN1           SET UP SCANNER
          END
.
P         PROC      0,1
STCHR*    NAME      0
          EX        STCHR,*X6
          END
.
P         PROC      1,1
CTS*      NAME      0
          SZ,13     P(1,1),P(1,2)
          END
.
P         PROC      1,1
snonz*    name      0
          I$        4,P(0,1)++P(1,3),15,P(1,2),2*P(1,*2)+P(1,*1),P(1,1)
          END
.
.
P        PROC      1
JOL*     NAME      0
JNOL*    NAME      1
L        EQU       P(1,1)
K        EQU       +((L='C')*6)+((L='I')*3)+((L='O')*5)
         DO        1-(K=0) , DO P(0,0) , TN,K PARTBL
         DO        1-(K=0) , DO 1-P(0,0) , TP,K PARTBL
         DO        K=0 , L,12-((L-2)/6) 12,PARTBL
         DO        (K=0)*(L='Z')*P(0,0) , JNB 12,P(1,2),P(1,3)
         DO        (K=0)*(L='Z')*(1-P(0,0)) , JB 12,P(1,2),P(1,3)
         DO        (K=0)*(L<'Z')*P(0,0) , TOP,14 12,1*/('Z'-L-6*(('Z'-L)/6))
         DO        (K=0)*(L<'Z')*(1-P(0,0)) , ;
                                       TEP,14 12,1*/('Z'-L-6*(('Z'-L)/6))
         DO        L<'Z' , J P(1,2),P(1,3)
         END
.
P        PROC      1,2
JE*      NAME      0
JNE*     NAME      1
         DO        P(0,0) , TE,14 P(1,1),P(1,2)
         DO        1-P(0,0) , TNE,14   P(1,1),P(1,2)
         J         P(1,3),P(1,4)
         END
.
P        PROC      1
JNNUM*   NAME      +'09'+1
JNUM*    NAME      *+'09'+1
JNA*     NAME      +'AZ'+1
JA*      NAME      *+'AZ'+1
         TG,14     P(1,1),+(P(0,0))/64
         TG,14     P(1,1),+(P(0,0))**077
         DO        P(0,*0) , J $+2
         J         P(1,2),P(1,3)
         END
.
.         PROC TO GENERATE JUMPS BASED UPON CHARACTER CLASS
.
.         JCL,<REG1>,<REG2>  <TABLE>  <CLASS>,<ADDRESS>,<X> ...
.
.         <REG1>        IS THE X REGISTER CONTAINING THE CHARACTER.  A0 IS
.                       ASSUMED IF OMITTED.
.
.         <REG2>        IS AN X REGISTER USED TO LOAD THE CHARACTER CLASS.
.                       X11 IS ASSUMED IF OMITTED.
.
.         <CLASS>       IS THE NUMERIC CLASS FOR THIS JUMP ADDRESS.
.
.         <TABLE>       IS THE CHARACTER CLASS TABLE TO BE USED.  THIS
.                       MAY BE AN EQUF.
.
.         <ADDRESS>     IS THE JUMP ADDRESS FOR THIS CLASS.
.
.         <X>           IS THE OPTIONAL JUMP ADDRESS FOR THE ADDRESS.
.
.         UNSPECIFIED CLASSES WILL GENERATE:
.
.         J         CL$UNDF(0),CL$UNDF(1)
.
.         WHERE CL$UNDF(0) AND CL$UNDF(1) MAY BE DEFINED BY THE PROGRAMMER
.         IN THE ROUTINE USING THE JCL PROC.
.
P         PROC      *2047
JCL*      NAME      0
A1        EQU       12*(P(0)<2)+P(0,1)
A2        EQU       11*(P(0)<3)+P(0,2)
          L         A2,P(1,1),A1
          J         $+1,A2
.         FIND LARGEST CLASS SPECIFIED
Y(0)      EQU       0
JPB*      PROC      *0
          DO        P(I+1,1)>Y(0) ,Y*(0) EQU P(I+1,1)
YA*(P(I+1,1),1)     EQU P(I+1,2)
YA*(P(I+1,1),2)     EQU P(I+1,3)
          END
JPJ*      PROC      *0
          DO        YA(I-1)>0 , J YA(I-1,1),YA(I-1,2)
          DO        YA(I-1)=0 , J CL$UNDF(0),CL$UNDF(1)
          END
I         DO        P-2 , JPB
I         DO        Y(0)+1 , JPJ
          END
.
P         PROC      *1                  DO TYPE AND READ
TREAD*    NAME      0
ATREAD*   NAME      1
          SNZ       TYPOUTST            FLAG TYPE AND READ OUTSTANDING
          DO        P(0,0)=0 , TREAD$P P(1,1),P(1,2)
          DO        P(0,0)=1 , ATREAD$P P(1,1),P(1,2)
          SZ        TYPOUTST            MARK NO TYPE AND READ OUTSTANDING
          END       .
.
P         PROC      *0
R$DIT*    NAME      0
          LMJ       A1,RDIT$
          END
.
P         PROC      *1
R$PRTX*   NAME      0
          DO        P(1)>0 , LA,14 12,P(1,1)
          LMJ       13,RPRTX$
          END
.
P         PROC      *0
R$DITX*   NAME      0
          LMJ       13,RDITX$
          END
.
P         PROC      *1
R$PRT*    NAME      0
          DO        P(1)>0 , LA,14 12,P(1,1)
          LMJ       11,RPRT$
          END
.
P         PROC      *0
R$DITA*   NAME      0
          LMJ       13,RDITA$
          END
.
P         PROC      *1
R$PRTXA*  NAME      0
          DO        P(1)>0 , LA,14 12,P(1,1)
          LMJ       13,RPRTXA$
          END
.
P         PROC      *0
R$DITXA*  NAME      0
          LMJ       13,RDITXA$
          END
.
P         PROC      *1
R$PRTA*   NAME      0
          DO        P(1)>0 , LA,14 12,P(1,1)
          LMJ       X11,RPRTA$
          END
.
p         proc      *0                  generate processor interface routine cal
rfti*     name      'RFTI'
rpfet*    name      'RPFET'
rpfapt*   name      'RPFAPT'
rpfcpt*   name      'RPFCPT'
rpffpt*   name      'RPFFPT'
rpfept*   name      'RPFEPT'
etis*     name      'ETIS'
aptis*    name      'APTIS'
cptis*    name      'CPTIS'
fptis*    name      'FPTIS'
eptis*    name      'EPTIS'
etid*     name      'ETID'
aptid*    name      'APTID'
cptid*    name      'CPTID'
fptid*    name      'FPTID'
eptid*    name      'EPTID'
etnl*     name      'ETNL'
aptnl*    name      'APTNL'
cptnl*    name      'CPTNL'
fptnl*    name      'FPTNL'
eptnl*    name      'EPTNL'
etia*     name      'ETIA'
aptia*    name      'APTIA'
cptia*    name      'CPTIA'
fptia*    name      'FPTIA'
eptia*    name      'EPTIA'
ptewt*    name      'PTEWT'
ptatwt*   name      'PTATWT'
ptctwt*   name      'PTCTWT'
ptftwt*   name      'PTFTWT'
ptetwt*   name      'PTETWT'
wpfet*    name      'WPFET'
wpfapt*   name      'WPFAPT'
wpfcpt*   name      'WPFCPT'
wpffpt*   name      'WPFFPT'
wpfept*   name      'WPFEPT'
wfti*     name      'WFTI'
sdfio*    name      'SDFIO'
sdfioa*   name      'SDFIOA'
sdfi*     name      'SDFI'
sdfic*    name      'SDFIC'
sdfoo*    name      'SDFOO'
sdfo*     name      'SDFO'
sdfoc*    name      'SDFOC'
ascfd*    name      'ASCFD'
fdasc*    name      'FDASC'
          if        pircb               using PIRCB$ ?
          if        u1110               dual psr machine ?
          lmj       x11,B[p(0,0)]$-1    link to utility-based bank
          else
          lxi,u     x11,pircb$          load bank descriptor index
          lij       x11,B[p(0,0)]$      enter bank to service request
          endf
          else
          lmj       x11,[p(0,0)]$       call as subroutine
          endf
          end       .
.
.         This PROC generates a calling sequence for the proper BSP routine
.         for processing procedure table entries of a given type.  Assuming
.         the element type being processed has been loaded in a register
.         <reg>, the statement:
.
.         PIRCALL   <generic name>,<reg>
.
.         will generate the proper calling sequence to the specific routine.
.         <generic name> is the BSP entry point shorn of the leading B for
.         bank and the trailing dollar sign, with the 'A', 'C', or 'F'
.         which indicates the Assembler, COBOL, or FORTRAN procedure table
.         changed into an 'X'.  (For example, the generic of RFPAPT, RPFCPT,
.         and RPFFPT is RPFXPT.
.
p         proc      *1
pircall*  name      0
          if        pircb**(u1110=0)
          lx        x11,p(1,1),p(1,2)   load proper entry tag
          lxi,u     x11,pircb$          load BDI to invoke bank
          lij       x11,,x11            enter the service bank
          else
          lx        x11,p(1,1),p(1,2)   load the routine address
          lmj       x11,,x11            call the proper routine
          endf
          end       .
.
P         PROC      1,2
DSZ*      NAME      0
          SZ        P(1,1),P(1,2)
          SZ        P(1,1)+1,P(1,2)
          END
.
P         PROC      0
IERR*     NAME      0
          SLJ       IERR
          END
.
P         PROC      0,1
COMPLETE* NAME      0
          LMJ       9,COMPLETE
          END
.
P         PROC      0,1
ZAP*      NAME      0
          SZ        CDBACT,X8           MARK OPERATION FAILED
          END
.
P         PROC      *1
JTAPE*    NAME      1
JNTAPE*   NAME      2
          TE,U      P(1,1),TSINGLE
          TNE,U     P(1,1),TMULTI
          DO        P(0,0)=2 , J $+2
          J         P(1,2),P(1,3)
          END
.
P         PROC      1,2
JTERM*    NAME      0
          TZ        CDCEASE,X8          IS CEASE FLAG SET ?
          J         P(1,1),P(1,2)       YES.  GO TO TERMINATE ROUTINE
          END
.
P         PROC      1
PURE*     NAME      1
IMPURE*   NAME      2
A(0)      EQU       1*(P(1,1)=CODE)
A(0)      EQU       2*(P(1,1)=DATA)
$(p(0,0)).                               Set for reentrant code
          END
.
P         PROC      2
HEADING*  NAME      0
HD*       PROC      0
          E$COL     P(2,I).             TAB TO PROPER COLUMN
          E$MSGR    .                   COPY TEXT FROM SOURCE LINE
          END
          E$MSG     P(1,1).             SET UP MESSAGE
I         DO        P(2) , HD
          DO        P(1)>1 , R$PRT P(1,2). PRINT THE MESSAGE
          END
.
.         CHANGE PSR BITS FOR THIRD / QUARTER WORD ADDRESSING
.
P         PROC      0
thirdword* name     0
quarterword* name   1
          lpd       (0140*(u1110=0))+(010*p(0,0)) Set PSR designators
          END