*DECK SNOBOL
IDENT SNOBOL,101B,SNOBOL
ABS
SPACE 14
****************************************
* *
* *
* *
* *
* *
* *
* *
* *
* *
* CAL-6000 SNOBOL4 COMPILER *
* DEVELOPED BY *
* CHARLES SIMONYI AND PAUL MCJONES *
* BERKELEY, 1968 - 1969 *
* *
* *
* *
* *
* *
* *
* *
* *
* *
****************************************
TITLE CAL-6000 S N O B O L
TITLE ASSEMBLY PARAMETERS, WORKING STORAGE
ORG 101B
*
*
* ASSEMBLY PARAMETERS
*
*
TSS EQU 0
TRCFLG EQU 0
*
BUFF1 EQU 10 . BUFFER SIZE BETWEEN DYNAMIC
. STORAGE AREA AND THE STACK
BUFF2 EQU 40 . MINIMUM NUMBER OF WORDS ON THE
. FREE CHAIN IN GRBCOLL
BUFF3 EQU 20 . EXPECTED LENGTH OF A PATTERN
BUFF4 EQU 40 . STATIC STORAGE INCREMENT
*
FLDINCR EQU 1000B . FIELD LENGTH INCREMENT
*
IFNE TSS,0,2
STAKSP EQU 81 . SPACE FOR COMPILER STACKS AND ALSO
, TELETYPE INPUT PROCEDURE
IFNE ,,1
STAKSP EQU 70 . SPACE ALLOCATED FOR P2-P3 STACKS
BGP3STK EQU 2
BSSZ STAKSP-101B+BGP3STK
BGP2STK EQU *
*
HASHLWD DATA 57.0 . LENGTH OF THE HASH-TABLE
HASHLN EQU 57 . LENGTH OF THE HASH-TABLE
HASHTBL EQU * .
BSSZ HASHLN . HASH-TABLE
*
* OTHER EQU-S
*
MARK EQU 377777B . USED IN PM.YSTAR
BUFFSIZE DATA 129
LINES EQU 56 LINES AVAILABLE / PAGE
*
* PASS 2 STATE-MACHINE STATES
*
ST1 EQU 0
ST2 EQU 4
ST3 EQU 8
ST4 EQU 12
ST5 EQU 16
ST6 EQU 20
ST7 EQU 24
ST8 EQU 28
ST9 EQU 32
ST10 EQU 36
ST11 EQU 40
ST12 EQU 44
ST13 EQU 48
ST14 EQU 52
ST15 EQU 56
*
* PASS 2 OPERAND SITUATIONS
*
OPSVAR EQU -1 . IDENTIFIER OPERAND
OPSLIT EQU -2 . LITERAL STRING
OPSINT EQU -3 . INTEGER CONSTANT
OPSREAL EQU -4 . REAL CONSTANT
OPSEXP EQU -5 . EXPRESSION AS OPERAND
OPSSPEC EQU -6 . ARRAY OR FUNCTION OPERAND
*
* PASS 3 OPERATOR PRIORITIES
*
PRIORA EQU 10 . UNDOL,UNPRD,UNSTAR,DOL,PRD
PRIORB EQU 9 . **
PRIORC EQU 8 . *,/
PRIORD EQU 7 . +,-,UNPL,UNMIN
PRIORE EQU 6 . CAT
PRIORF EQU 5 . ALT,COMMA,),RGTBR
PRIORG EQU 4 . (,LFTBR,PM,END GO TO
PRIORH EQU 3 . =,ASGNPM,GO TO
PRIORI EQU 2 . COLON,SEMICOLON
PRIORJ EQU 1 . STACK BASE
*
* SOPME PASS 2 INPUT VALUES
*
P2VAR EQU OPSVAR . IDENTIFIER
P2LIT EQU OPSLIT . LITERAL STRING
P2INT EQU OPSINT . INTEGER CONSTANT
P2REAL EQU OPSREAL . REAL CONSTANT
*
* SIMPLE VARIABLE TYPES
*
SFTY EQU 0 . TEMPORARY STRING IN LIST FORM
STY EQU 1 . STRING IN CHARACTER FORM
SSTY EQU 2 . STRING IN LIST FORM
SITY EQU 3 . INTEGER CONSTANTS
PSTY EQU 4 . SIMPLE PATTERN
PATY EQU 5 . ALTERNATED PATTERNS
PETY EQU 6 . CONCATENATED PATTERNS
ITY EQU 7 . BINARY INTEGER
RTY EQU 8 . REAL VALUE
ATY EQU 9 . ARRAY REFERENCE
DTY EQU 10 . DATA REFERENCE
NTY EQU 11 . NAME
CTY EQU 12 . CODE REFERENCE
INTY EQU 13 . INPUT ASSOCIATED
OUTTY EQU 14 . OUTPUT ASSOCIATED
SPECTY EQU 14 . LEFT OPERAND IN STACK
SKIPTY EQU 0 . EMPTY WORD IN STATIC
*
* STATIC RECORD TYPES
*
VARTYP EQU 37B-1 . SIMPLE VARIABLE
CALLTYP EQU 37B-2 . FUNCTION
LBLTYP EQU 37B-3 . LABEL
LITTYP EQU 37B-4 . LITERAL STRING
SPCTYP EQU 37B-5 . ANYTHING WHATSOEVER
INTTYP EQU 37B-6 . INTEGER CONSTANS
REALTYP EQU 37B-7 . REAL CONSTANS
*
* FUNCTION TYPES
*
PROCTYP EQU 0 . PROCEDURE
DATATYP EQU 1 . DATA FUNCTION
FLDTYP EQU 2 . FIELD FUNCTION
UNDFTYP EQU 3 . UNDEFINED FUNCTION
*
* WORKING STORAGE USED BOTH DURING COMPILATION AND EXECUTION
*
FIELDLN DATA 0 . FIELDLENGTH
MAXSTAT DATA 0 . LIMITS OF THE STATIC STORAGE
MINSTAT VFD 60/STTBASE .
MAXSTAK DATA 0 . LIMITS FOR THE STACK
MINSTAK DATA 0 .
NXTWRD DATA -1 . COMPILER SOURCE MEDIUM DESCR.
FRSTWRD DATA 0 .
INFAIL DATA 0 . SIGN BIT - SIGNAL ERROR ON FAILURE
STAKTOP DATA 0 . STACK TOP AFTER LAST PROCEDURE
. CALL
CODELINK DATA 0 . CHAIN OF TRANSLATED CODE PIECES
*
* SOME KEYWORDS
*
FLDLM DATA 30000B . LIMIT FOR FIELDLN
MXLNGTH VFD 60/MARK-1 . MAXIMUM STRING LENGTH
STCOUNT DATA 1
STLIM DATA 100000000 LIMIT FOR STATEMENT(RULE) COUNT
ANCHOR DATA 0 . NOTZERO INDICATES ANCHORED SEARCH
*
* WORKING STORAGE USED ONLY DURING COMPILATION
*
TEMPBASE EQU *
ARROWD DATA 0 . ERROR FLAG FOR CURRENT LINE
LBLLINK DATA 0 . CHAIN OF LABELS
VARLINK DATA 0 . CHAIN OF VARIABLES
TESTCND DATA 0 . USED IN P3
TSTPMOP DATA 0 . USED IN P2
PRGBASE DATA 0 .
CHAR BSSZ 12 . CHARACTER BUFFER FOR PASS1
COMPB7 DATA 0
P1ERFLG DATA -1
CHARLEN DATA 0
COLS DATA 0
CPERW DATA 0
LC DATA 0
PAGENO DATA 1
P1MAX DATA 0
P1SVX3 DATA 0
P1SVX5 DATA 0
RULENO DATA 1
P1SVTAB DATA 0
P4SVX4 EQU P1SVX3
P4SVB5 EQU P1MAX
TRCSVX7 EQU P1SVX5
FETHEAD VFD 60/OUTFET-1
INFET VFD 60/5LINPUT
BSSZ 4
VFD 60/0
OUTFET VFD 60/6LOUTPUT
BSSZ 4
TITLE MACRO DEFINITIONS
RECALL MACRO FILE GENERATE PERIODIC OR AUTO RECALL CALL
IFC EQ,$FILE$$
SX0 B0
ELSE
SX0 1
ENDIF
RJ RCL
ENDM
*
WAIT MACRO . WAIT FOR FILE QUIET
LOCAL NEXT
SA1 B2
LX1 59
NG X1,NEXT . IT IS ALREADY QUIET
RECALL B2
NEXT BSS 0
ENDM
*
MACRO =,ACTION,CODE GENERATE FILE ACTION MACROS
* ACTION IS NAME OF FILE ACTION
* MACRO, CODE IS FUNCTION CODE TO
* INSERT IN FET BEFORE CIO CALL.
ACTION MACRO RECALL
IFC EQ,$RECALL$$
SX0 B0
ELSE
SX0 1
ENDIF
SX7 CODE
RJ CIO
ENDM
ENDM
READ = 10B BUFFERED READ
WRITE = 14B BUFFERED WRITE
WRITER = 24B WRITE END OF LOGICAL RECORD
REWIND = 50B REWIND FILE
BWRITER = 26B
CLOSE = 150B CLOSE A FILE
UNLOAD = 60B
*
*
*
*
MACRO HEAD,X,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O
X EQU *-P2TBL
VFD 4/O,4/N,4/M,4/L,4/K,4/J,4/I,4/H
VFD 4/G,4/F,4/E,4/D,4/C,4/B,4/A
ENDM
*
TAIL MACRO A,B,C,D,E
VFD 8/A,8/B,8/C,18/D,18/E
ENDM
*
MACRO TABLE,A,B,C,D,E,F
A EQU *-P3TBL
VFD 6/B,12/C,6/D,18/E,18/F
ENDM
*
MACRO MICOP,A,B,C,D,E
A EQU *-MCOPTBL
IFC EQ,$E$$,2
+ EQ B
IFNE ,,1
+ VFD 30/-1
- VFD 7/C,5/D,18/B
ENDM
*
SWITCH MACRO Q,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O
+ VFD 4/O,4/N,4/M,4/L,4/K,4/J,4/I,4/H
VFD 4/G,4/F,4/E,4/D,4/C,4/B,4/A
Q EQU *
ENDM
*
MACRO TEMP,PARAM
IF -DEF,CCXXCC,1
CCXXCC SET -1
CCXXCC SET CCXXCC+1
PARAM EQU TEMPBASE+CCXXCC
ENDM
*
ERROR MACRO NUMBER
SB5 NUMBER
EQ RTERROR
ENDM
*
TITLE TEMPORARY LOCATIONS USED ONLY DURING RUN - TIME
*
PIX TEMP
SIX TEMP
PIB TEMP
LENFAIL TEMP
SBASE TEMP
TEMPDOL TEMP
TEMPDOL1 TEMP . REFERRED TO AS TEMPDOL+1
SLENGTH TEMP
PCHAIN TEMP
PMASX6 TEMP
PMASX0 TEMP
PMASX3 TEMP
PMASX2 TEMP
PMASX4 TEMP
PMASB1 TEMP
PMASB2 TEMP
PMASB4 TEMP
CALLB5P TEMP . USED IN CALL
DATAWD TEMP . USED IN DATA
PMA5 TEMP
SPOS TEMP
DTYPWD TEMP
UA TEMP . RETURN - PM CHEK INFO
PMSTX3 EQU PMASX3
PMSTB1 EQU PMASB1
PMSTB3 EQU PMASB2
PMSTB4 EQU PMASB4
PMFA0 EQU PMASX3
PMFX4 EQU PMASB1
PMFA4 EQU PMASB2
QARSV EQU PMASX3
QIOSV EQU PMASX3
QDEFSV1 EQU PMASX3
QDEFSV2 EQU PMASB1
QDEFSV3 EQU PMASB2
QFRZSV EQU PMASX3
QEQSV EQU PMASX3
QDATSV1 EQU PMASX3
TITLE KLOOJE KLOOJE KLOOJE
TRACE1 BSS 0
TRACE2 BSS 0
ERR32 ERROR 32
ADDS1 EQU ERR32
ADDS2 EQU ERR32
SUBTRS EQU ERR32
MULTS EQU ERR32
DIVS EQU ERR32
EXPS EQU ERR32
TITLE ERROR CALLS
*
*
ERRORG BSS 0 . ORIGIN FOR THE ERROR OVERLAY
*
NOEND ERROR 0
ERR1 ERROR 1
ERR2 ERROR 2
ERR3 ERROR 3
ERR4 ERROR 4
ERR5 ERROR 5
ERR6 ERROR 6
ERR7 ERROR 7
ERR8 ERROR 8
ERR9 ERROR 9
ERR10 ERROR 10
ERR11 ERROR 11
ERR13 ERROR 13
ERR14 ERROR 14
ERR15 ERROR 15
ERR16 ERROR 16
ERR17 ERROR -17
ERR19 ERROR 19
ERR20 ERROR 20
ERR21 ERROR 21
ERR22 ERROR 22
ERR23 ERROR 23
ERR24 ERROR 24
ERR25 ERROR 25
ERR26 ERROR 26
ERR27 ERROR 27
ERR28 ERROR 28
ERR29 ERROR 29
ERR30 ERROR 30
ERR31 ERROR 31
ERR35 ERROR 35
ERR36 ERROR 36
ERR37 ERROR 37
ERR38 ERROR 38
ERR39 ERROR 39
ERR40 ERROR 40
ERR41 ERROR 41
ERR42 ERROR 42
ERR43 ERROR 43
ERR44 ERROR 44
ERR48 ERROR 48
ERR49 ERROR 49
ERR50 ERROR 50
ERR52 ERROR 52
ERR53 ERROR 53
ERR55 ERROR 55
ERR56 ERROR 56
FATBUMP SB2 OUTFET
SX6 0
SB5 -54
RJ PB
EQ RTERROR
TITLE TABLE OF MICRO-OPERATIONS
MCOPTBL BSS 0
XNOOP MICOP NOOP,0,2
*
XCATCHK MICOP CATCHEK,0,0
XALTCHK MICOP ALTCHEK,0,0
XPMCHK MICOP PMCHEK,0,0
XASCHK MICOP ASCHEK,0,0
XMCHEK MICOP MCHEK,0,0
XDCHEK MICOP DCHEK,0,0
XEXPCHK MICOP EXPCHK,0,0
XCONCAT MICOP CONCAT,0,0
XALT MICOP ALTER,0,0
XAND MICOP ZAND,0,0
XNOT MICOP ZNOT,0,0
XEOR MICOP ZEOR,0,0
XOR MICOP ZOR,0,0
XLEFT MICOP ZLEFT,0,0
XRITE MICOP ZRITE,0,0
XADD MICOP ADD,0,0
XSUBTR MICOP SUBTR,0,0
XUNADD MICOP UNADD,0,0
XUNSUB MICOP UNSUB,0,0
XMULT MICOP MULT,0,0
XDIV MICOP DIV,0,0
XEXP MICOP EXP,0,0
XPM MICOP PM,0,0
XPRD MICOP PRD,0,6
XDOL MICOP DOL,0,6
XSTAR MICOP STAR,0,6
XASGN MICOP ASGN,0,4
XASGNPM MICOP ASGNPM,0,4
XSUBCM MICOP SUBCOM,0,0
XPARAM MICOP PARAM,0,0
XSKIP MICOP SKIP,0,0
XINDRCN MICOP INDRCN,0,0
XINDRCV MICOP INDRCV,XINDRCN,2
XEND MICOP END,0,0
XNOEND MICOP NOEND,0,0
XZERO MICOP ZERO,0,2
XNULL MICOP NULL,0,2
XARRAY MICOP ARRAY,0,1
XARRAYN MICOP ARRAYN,0,2
XARRAYV MICOP ARRAYV,XARRAYN,3
XCALL MICOP CALL,0,12B,SPEC
XNAME MICOP NAME,0,1
XOPRND MICOP OPRND,XNAME,23B
XGOX EQU *-MCOPTBL-1
XGOS MICOP GOS,0,2,SPEC
XGOF MICOP GOF,0,2,SPEC
XGOTO MICOP GOTO,0,2,SPEC
XGOTOT MICOP GOTOT,0,2
XGOTOC MICOP GOTOC,0,2
XNOFAIL MICOP NOFAIL,0,2
TITLE MICRO PROCESSOR: MAIN LOOP
*
NEXTMIC SA5 A5-1 . NEXT MICRO-OPERATION
SB1 X5 . OPERATION PART
AX5 18 . ADDRESS PART
NG X5,NEWRULE . BRANCH IF END OF RULE
JP B1+0 . BRANCH TO THE CODE FOR THE MICOP
*
NOOP EQU NEXTMIC
*
NEWRULE SA1 STCOUNT . BUMP STCOUNT
SA2 STLIM . AND CHECK AGAINST STLIM
SX7 1
IX7 X7+X1
IX2 X1-X2
SA7 A1
PL X2,ERR19
JP B1
*
GOTO NG X5,GOTO1 . GO TO TERMINATES THE RULE
SB1 GOTO1
EQ NEWRULE
GOTO1 SX5 X5
NG X5,RETUN . BRANCH IF RETURN OR UNDEFINED
SA5 X5 . FETCH MICOP ADDRESSED
SB1 X5
AX5 18
NG X5,NEWRULE
SSKIP1 JP B1
*
GOS EQ GOTO . SLIGHTLY DIFFERENT THAN GOTO
*
SNDMIC SA5 A5 . HIGH ORDER MICRO-INSTRUCTION
MX0 55
LX5 6
BX1 -X0*X5 . MASK OFF OPERATION CODE
AX5 42 . ADDRESS PART OF X5
SB1 X1 . MCOPTBL CONTAINS EQ JUMPS TO THE
JP B1+MCOPTBL . COPE FOR THE PARTICULAR MICOP
*
SKIP SB1 NEXTMIC
SSKIP SA1 STAKTOP . SKIP OPERANDS IN STACK
SB2 X1
SSKIP2 EQ B6,B2,SSKIP1
SA1 B6
SB3 X1
SB6 B6-B3
AX1 55
NZ X1,SSKIP2 . IF OPERAND IS OF SF TYPE
SA1 A1-1 . RELEASE IT
SX7 B7
SB7 X1
AX1 18
SA7 X1
EQ SSKIP2
*
FAIL SA1 INFAIL . FAILURE IN CURRENT RULE
NG X1,ERR9 . ERROR IF IN GO TO PART
SB1 FAIL1
EQ SSKIP . SKIP OPERANDS IN THE STACK
FAIL1 SB2 GOF
SB4 GOTO
SA5 A5+1
FAIL2 SA5 A5-1 . SKIP MICOPS UNTIL END OF THE RULE
SB3 X5+0 . OR A GOF JUMP IS FOUND.
EQ B2,B3,FAIL3
EQ B3,B4,FAIL3 . UNCONDITIONAL JUMP
PL X5,FAIL2
GOF EQ NEXTMIC . GOF IS IGNORED OT8ERWISE
FAIL3 AX5 18
EQ GOTO1 . BUT NOW IT IS EXECUTED
*
*
NOFAIL MX7 1 . MICRO OPERATION
SA7 INFAIL . SET VARIABLE TO SIGNAL ERRO
EQ SNDMIC . ON FAILURE (IN GO TO PART)
*
GOTOC SA1 B6 . MICRO OPERATION
AX1 55 . TRANSFER CONTROL TO TRANSLATED
SB1 X1-CTY . CODE
NE B1,B0,ERR34 . TOP OPERAND HAS TO BE OF CODE TYPE
SA5 B6-1
GOTOC1 SB6 B6-2 . REMOVE TOP OPERAND
BX7 X7-X7
SA7 INFAIL . CLEAR INFAIL
EQ GOTO
*
GOTOT SA2 GTTWD . MICRO OPERATION
SB3 GTTSW . GO TO THE LABEL DESCRIBED AT THE
EQ CHEK . TOP OF THE STACK
*
GTTWD SWITCH GTTSW,2,1,3,3,0,0,0,0,0,0,0,0,0,0,0
ERR34 ERROR 34 . 0, P,I,R,A,D,N,C
+ RJ SCATS . 1, S
+ SA4 B6-1 . 2, SF
EQ GOTOT1
+ SA4 B6-1 . 3, SS,SI
SA4 X4+0
GOTOT1 SX0 LBLTYP . SEARCH FOR LABEL TYPE
BX1 X4 . FIRST TO B5
SB5 X4
AX1 36
LX0 55
SB3 X1 . LENGTH TO B3
RJ SEARCH . PERFORM SEARCH
ZR X1,ERR10 . ERROR IF NOT FOUND
SA5 X1 . LABEL DESCRIPTION TO X5
SX7 B7
SX5 X5
NE B4,B0,GOTOC1
SB7 X4 . RELEASE OPERAND IF SF
AX4 18
SA7 X4
EQ GOTOC1 . COMPLETE GO TO
TITLE PROGRAM TERMINATION
END RJ CLOSEOUT . TERMINATE ALL OUTPUT - TYPE FILES
.END. SX7 3LEND . MONITOR REQUEST TO QUIT
LX7 42
SA7 1
+ EQ * . WAIT FOR MONITOR
TITLE MICRO PROCESSOR: ACTIONS
CATCHEK SB3 CATCSW . MICRO OPERATION
SA2 CATCWD . CHECK LEFT OPERAND FOR CONCAT
*
* CHECK TOP OPERAND X0,X1,X2,B1,B3,B4,
*
CHEK SA1 B6+0 . FETCH TOP OPERAND
AX1 55 . TYPE PART TO X1
LX1 2
SB4 X1+0 . GO TO STORE(X2(X1)+B3)
AX2 B4,X2 .
MX0 56 . X2 IS TREATED HERE AS A LINEAR
BX2 -X0*X2 . ARRAY OF 4 BIT INTEGERS
SB3 X2+B3
JP B3
*
CATCWD SWITCH CATCSW,2,1,3,3,2,2,2,0,2,2,2,2,2,0,0
*
+ SB1 NEXTMIC . 0, I
EQ ITOSFTP
+ RJ SCATS . 1, S
+ EQ NEXTMIC . 2, SF,P,R,A,D,N,C
CATCSS SA1 B6-1 . 3, SS,SI
SX7 2
SA2 X1
SA7 B6 . STORE SF TYPE HEADING
RJ SSTOSF . COPY THE STRING
SA6 B6-1 . STORE THE SVD OF THE COPY
EQ NEXTMIC
*
SCATS NO
+ SA1 B6
SB4 X1-1 . STRING LENGTH TO B4
SB2 B6-B4 . FIRST
SB3 B6-1 . LAST
NZ B4,SCATS1 . IF NULL STRING THEN ONE
SA0 1 . MORE WORD HAS TO BE RESERVED
RJ RESERVE . IN THE STACK
SCATS1 SB6 B2+1 . NEW SF TYPE STACK ENTRY CONSISTS
RJ STOSFX6 . OF TWO WORDS
SX7 2
SA6 B6-1 . THE SVD
SA7 B6 . AND THE HEADING
SB4 B0 . ZERO IN B4 SIGNALS SF TYPE USUALLY
EQ SCATS
*
ALTCHEK SB3 ALTCSW . MICRO OPERATION CHECK LEFT
SA2 ALTCWD . OPERAND FOR ALTERATION
EQ CHEK
*
ALTCWD SWITCH ALTCSW,2,8,1,1,5,3,4,7,0,0,0,0,0,0,0
+ ERROR 12 . 0, R,A,D,N,C
+ SA4 B6-1
EQ ALTCSS . 1, SS
+ SX4 B6-1
EQ ALTCSF . 2, SF
+ SA1 B6
SB4 X1
EQ ALTCPA . 3, PA
+ MX0 60
EQ ALTCS1 . 4, PE
+ SB1 1
SX0 B0-B1
SA2 B6
+ SB4 X2
EQ ALTCS2 . 5, PS
+ RJ ITOS . 7, I
+ SX0 0 . 8, S
ALTCS1 SB1 2
SA2 B6
SB4 X2
ALTCS2 SB2 B6
SA0 B1 . RESERVE LOCATIONS FOR ALT AND
RJ RESERVE . PERHAPS LIT
SB3 B4+B1
SB3 B6-B3
ALTCS3 SB2 B2-1 . PUSH TOP OPERAND DOWN B1 WORDS
EQ B2,B3,ALTCS4
SA1 B2
BX7 X1
SA7 A1+B1
EQ ALTCS3
ALTCS4 PL X0,ALTCSS2 . BRANCH IF S OR I
SX6 ALTPM
LX6 48
ZR X0,ALTCPE1 . BRANCH IF PE
SA6 B6-B4 . PS
EQ ALTCSS3
ALTCPE1 SX7 EXPPM
LX7 48
SX1 B4+1
BX7 X1+X7 . PUT EXP AND ENDEX BRACKETS
SA7 B6-B4 . AROUND THE PATTERN EXPRESSION
SA6 A7-1
SX7 ENDEXPM
LX7 48
SA7 B6
SA0 1
RJ RESERVE
SB1 3
EQ ALTCSS3
*
ALTCSS BSS 0
ALTCSF SA1 X4 . FETCH DESCRIPTOR
AX1 36
SB1 2
SB5 X1 . LENGTH TO B5
SA0 X1+1
RJ RESERVE
SA1 X4
BX4 X1
RJ SSTOS . CONVERT THE LIST INTO S FORMAT
SB3 B4
SB4 A0
NE B3,B0,ALTCSS2 . RELEASE IF SF
SX7 B7
SB7 X4
AX4 18
SA7 X4
ALTCSS2 SX6 ALTPM
SX7 LITPM
LX7 48 . COMMON PROGRAM TO PLACE THE
SX1 B4 . ALT AND LIT PM OPERATIONS
LX6 48
BX7 X7+X1
SA7 B6-B4
SA6 A7-1
ALTCSS3 SX7 SPECTY . PUT THE HEADER WORD INTO THE STACK
LX7 55 . SPEC TYPE DOES NOT MATTER
SX4 B4+B1
BX7 X4+X7
SA7 B6
EQ NEXTMIC
*
ALTCPA AX1 18 . UNPACK PA PARAMETER
SB3 B6
SB1 X1 . INTO B1
SB2 B6-B1
ALTCPA1 SA1 B3-1
BX7 X1
SA7 B3
SB3 B3-1
NE B3,B2,ALTCPA1
SX7 ALTPM . PUT ALT OPERATION IN THE FRONT
LX7 48 . OF THE LAST ELEMENT (B1 POINTS
SA7 B2 . TO THE BEGINNING OF IT RELATIVE
SA0 1 . TO THE END OF THE PATTERN )
RJ RESERVE
SB3 EXPPM-1777B
SB5 ARBNOPM-1777B
SB1 B6-B4
MX0 12
SA2 B1
BX2 X0*X2
ALTCPA2 SB1 B1+1 . LINK ALL ALT OPERATIONS ON THE
ALTCPA3 EQ B1,B6,ALTCPA6 . ZERO LEVEL TOGETHER
SA1 B1
UX7 B2,X1
ID X1,ALTCPA2 . PRDPM OR DOLPM
GE B0,B2,ALTCPA5
ALTCPA4 SB1 X1+B1 . ANY, SPAN OR THE LIKE
EQ ALTCPA3
ALTCPA5 EQ B2,B3,ALTCPA4
EQ B2,B5,ALTCPA4 . EXP OR ARBNO
SB2 B2-ALTPM+1777B
NE B2,B0,ALTCPA2 . ANYTHING ELSE
SB2 A2
SX3 B1-B2 . A2 HOLDS THE LINK
BX7 X2+X3
SA7 A2
SA2 A1
BX2 X0*X2
EQ ALTCPA2
ALTCPA6 SB1 1 . END OF SCAN
. MARK END OF LINK WITH ZERO
BX7 X2
SA7 A2
EQ ALTCSS3
*
PMCHEK SB3 PMCSW . MICRO INSTRUCTION
SA2 PMCWD . CHECK LEFT OPERAND FOR PATTERN
EQ CHEK . MATCH
*
* SWITCH FOR PMCHECK,IN GENERAL EVERYTHING IS PUT INTO S FORMAT
PMCWD SWITCH PMCSW,3,2,4,4,0,0,0,1,0,0,0,0,0,0,0
+ ERROR 15 . 0, P,R,A,D,N,C
+ RJ ITOS . 1, I
+ SA1 B6 . 2, S
BX6 X1
EQ PMC1
+ SX4 B6-1
EQ PMCSF . 3, SF
+ SA4 B6-1 . 4, SS,SI
PMCSF SA1 X4
AX1 36
SB5 X1
SA0 X1-1 . B6 MAY BE DECREASED IN FACT
RJ RESERVE
SA1 X4
BX4 X1
RJ SSTOS . CONVERT TO S FORMAT
SX2 A0+2
NE B4,B0,PMCSF1 . RELEASE IF SF
SX7 B7 . RELEASE IS DONE BY CHAINING THE
SB7 X4 . END OF LIST TO THE FREE CHAIN
AX4 18 . AND SETTING B7 TO THE BEGINNING
SA7 X4 . OF THE LIST.
PMCSF1 SX6 STY . STRING HEADER WORD INTO X6
LX6 55
BX6 X2+X6
PMC1 SX5 X5 . PACK ADDRESS OF OPERAND
SA1 UA . OR UA IF IT IS ZERO INTO
LX5 18 . THE HEADING
LX1 18
NZ X5,PMC2
BX5 X1
PMC2 BX6 X6+X5
SA6 B6
EQ NEXTMIC
* THE FOLLOWING PROCEDURE CHECKS THE OPERANDS FOR ARITHMETIC
* OPERATIONS (EXCEPT **). NUMBERS WITH ABS VALUE LESS THAN
* X0 WILL BE REPRESENTED AS BINARY INTEGERS WHILE LARGE
* NUMBERS WILL BE HANDLED IN STRING FORM. A0 CONTAINS LOG(X0)
* -
*
SACHEK1 SX0 2 . RETURN INTEGER TYPE
BX7 X7+X0
SACHEK NO . ENTRY
+ SA3 B6
SA2 ARITWD . SWITCH ON TYPE OF TOP OPERAND
AX3 55
LX3 2
SB4 X3
AX2 B4,X2
MX3 56
BX2 -X3*X2
SB3 X2
JP B3+ARITSW
*
ARITWD SWITCH ARITSW,3,5,2,4,0,0,0,6,1,0,0,0,0,0
ERR47 ERROR 47 . 0, P,A,D,N,C
+ SX7 B0 . 1, R
EQ SACHEK
+ SA4 B6-1 . 2, SS
EQ ACHEKSF
+ SX4 B6-1 . 3, SF
EQ ACHEKSF
+ SA4 B6-1 . 4, SI
EQ ACHEKSI
+ SA1 B6 . 5, S
SB5 X1
EQ ACHEKS
+ SA1 B6-1 . 6, I
PL X1,ACHEKI1
BX1 -X1 . ABS VALUE
ACHEKI1 IX0 X1-X0
SX7 ITY
LX7 55
NG X0,SACHEK1 . LESS THAN X0, RETURN INTEGER TYPE
RJ ITOS . ELSE CONVERT TO STRING.
EQ SACHEK
ACHEKSI SA2 X4 . SI FORMAT
SA1 X2-1 . TEST INTEGER PART FIRST
IX0 X1-X0
PL X0,ACSI1 . IF TOO BIG, GO GET THE STRING PART
BX6 X1
SA6 A4
ACHKSI1 SX7 ITY . ELSE PUT THE INTEGER TO THE
SX0 2 . TOP OF THE STACK
LX7 55
BX7 X0+X7
SA7 B6+0
EQ SACHEK . RETURN
ACSI1 BX4 X2
AX4 36 . LENGTH OF THE STRING TO X4
SB5 X4+0
SA0 X4-1 . RESERVE SPACE
RJ RESERVE . (AO MAY BE NEGATIVE)
BX1 X2
RJ SSTOS . CONVERT SI TO S
SX1 X4+1
EQ ACHEKS5 . GO TO FORM AN S TYPE HEADING
*
ACHEKS SB1 0 . PROCESS A NUMBER GIVEN IN S FORM
SB2 0 . SET STATE AND COUNT TO ZERO
SB3 B6-B5 . NORMALIZED STRING WILL BE STORED
SX2 B0 . FROM B0. X2 IS BINARY VALUE
SB4 ACHEKSR . RETURN ADDRESS
ACHEKSR SB5 B5-1
EQ B5,B0,ACHEKS1
SA1 B6-B5 . EXAMINE ALL CHARACTERS
EQ DIGIT
*
ACHEKSF SA1 X4 . RESERVE SPACE IN STACK FOR
AX1 36 . LONGEST POSSIBLE RESULT
SB5 A0 . SAVE A0
SA0 X1
RJ RESERVE
SA4 X4
BX0 X4
SB3 A0+0
BX6 X4
SA0 B5
SB5 B4 . B5 IS 0 IFF SF
SB3 B6-B3
SB3 B3-2
SB1 B0 . INITIALIZE DIGIT COUNT
SB4 ACHKSFR . RETURN ADDRESS
SB2 B0 . STATE
SX2 B0 . BINARY VALUE
ACHKSF2 ZR X0,ACHKSF3
SA4 X0+0 . NEXT WORD FROM THE LIST
SX0 X4
BX4 X4-X0
ACHKSFR MX3 54 . UNPACK CHARACTERS AND CALL DIGIT
LX4 6
BX1 -X3*X4
NZ X1,DIGIT
EQ ACHKSF2
ACHKSF3 NE B5,B0,ACHEKS1 . RELEASE LIST IF SF
SX7 B7
SB7 X6
AX6 18
SA7 X6
EQ ACHEKS1
*
DIGIT SX7 X1+0 . OPEN SUBROUTINE TO CONVERT
SX1 X1-1R+ . STRINGS TO INTEGERS
PL X1,DIGIT2 . BRANCH IF NOT DIGIT
SX1 X1+10
NG X1,ERR2 . ERROR IF LETTER
NZ X1,DIGIT4 . IGNORE LEADING BLANKS
GE B0,B2,DIGIT3
DIGIT4 BX3 X2
SB2 B4
LX2 2 . MULTIPLY ACCUMULATED VALUE BY 10
IX2 X2+X3 . AND ADD NEW DIGIT
LX2 1
IX2 X2+X1
DIGIT1 SB1 B1+1 . BUMP DIGIT COUNT
SA7 B1+B3 . STORE NEXT DIGIT
DIGIT6 JP B4 . RETURN
DIGIT2 NE B2,B0,ERR2 . ERROR IF AFTER SIGN
SX3 X1-1
DIGIT3 SB2 -1 . SET STATE TO AFTER SIGN
ZR X1,DIGIT6 . IGNORE +
ZR X3,DIGIT1 . BRANCH IF -
EQ ERR2
*
ACHEKS1 SB6 B3+B1 . AFTER CONVERSION
EQ B1,B0,ACHEKS3 . BRANCH IF NULL STRING
SA1 B3+1 . PICK UP FIRST CHARACTER
SX1 X1-1R-
NZ X1,ACHEKS2 . BYPASS IF NOT -
BX0 X0-X0
SB1 B1-1
IX2 X0-X2 . CHANGE THE SIGN OF THE BINARY VALUE
ACHEKS2 SX0 A0-B1
NG X0,ACHEKS4 . TOO LONG, PRODUCE S TYPE RESULT
ACHEKS3 SB6 B3+2
BX6 X2
SA6 B6-1 . I TYPE RESULT OT8ERWISE
EQ ACHKSI1
ACHEKS4 SX1 B1+1
ACHEKS5 SX7 STY . S TYPE HEADING TO X7 USING X1
SB6 B6+1
LX7 55
BX7 X7+X1
SA7 B6
EQ SACHEK
*
ALTER SB3 ALTSW . MICRO OPERATION
SA2 ALTWD . ALTERNATION
EQ CHEK
*
ALTWD SWITCH ALTSW,7,5,8,8,0,1,2,4,3,3,3,3,3,3,3
+ SB3 0 . 0, PS
+ SA4 B6
SB2 X4
EQ ALTPA1 . 1, PA
+ SA1 B6
SB2 X1
EQ ALTPE1 . 2, PE
+ ERROR 12 . 3, R,A,D,N,C
+ RJ ITOS . 4, I
+ SA1 B6 . 5, S
SB2 X1
SA2 B6-B2
SB1 X2
EQ ALTS2
+ SX4 B6-1
EQ ALTSS1 . 6, SF
+ SA4 B6-1
SB3 0 . 7, SS,SI
ALTSS1 SA1 B6-2
SA2 X4
SB1 X1 . CONVERT THE LIST STRUCTURE INTO
SB2 A1 . A LIT OPERATION
AX2 36
SB5 X2
SA0 X2-1
RJ RESERVE
SA1 X4
BX4 X1
RJ SSTOS
SB2 B6-B2
EQ B3,B0,ALTS2 . RELEASE LIST IF SF
SX7 B7
SB7 X4
AX4 18
SA7 X4
ALTS2 SX7 LITPM
LX7 48
SX1 B2+0
BX7 X1+X7
SA7 B6-B2
ALTS3 SX6 PATY . INSERT PA TYPE HEADING
SX0 B2
LX6 55
ALTS4 LX0 18
SX1 B2+B1
BX6 X0+X6
BX6 X1+X6
SB1 B2+B1 . UPDATE THE CHAIN OF ALT
SB1 B6-B1 . OPERATIONS. ALL ALT-S WILL POINT
SA6 B6+0 . TO THE END OF THE PATTERN+1
SB1 B1+1
MX0 12
ALTS5 SA1 B1
SB2 X1
SX2 B6-B1
BX7 X0*X1
BX7 X2+X7
SA7 A1+0
SB1 A1+B2
NE B2,B0,ALTS5
EQ NEXTMIC
*
ALTPA1 SA3 B6-B2
SB4 B6-B2
SB1 X3
SB2 B2-1
SB6 B6-1
ALTPA2 SB4 B4+1 . POP THE PATTERNONE WORD UP
SA1 B4
BX7 X1
SA7 A1-1
NE B4,B6,ALTPA2
EQ B0,B3,ALTS3 . BRANCH IF SIMPLE PATTERN
SX6 PATY
AX4 18 . THE RESULT PARAMETER IS THE PARA
LX6 55 . METER OF THE SECOND OPERAND IN
SX0 X4 . THIS CASE.
EQ ALTS4
*
ALTPE1 SA3 B6-B2
SB3 B6-B2
SB1 X3 . PUT EXP AND ENDEX BRACKETS
SA0 1 . AROUND THE PATTERN EXPRESSION
RJ RESERVE
SX7 EXPPM
SB2 B2+1
LX7 48
SX0 B2
SX6 ENDEXPM
BX7 X0+X7
LX6 48
SA7 B3
SA6 B6-1
EQ ALTS3
*
ASCHEK SA1 TENTO15 ALLOW 48 BIT NUMBERS FOR DICK ROTH
SA0 15 HERE IS THE LOG OF TEN TO THE 15TH
ACHEK1 BX0 X1 . SUBTRACTION
RJ SACHEK
EQ NEXTMIC
*
MCHEK EQU ASCHEK
DCHEK EQU ASCHEK
EXPCHK EQU ASCHEK
*
TENTO9 DATA 1000000000
TENTO10 DATA 10000000000
TENTO15 DATA 1000000000000000
*
*
UNSUB SB1 SUBTR . MICRO OPERATION UNARY MINUS
EQ UNX
UNADD SB1 ADD . MICRO OPERATION UNARY PLUS
UNX SA1 B6+0 . TEST FOR REAL OPERAND
BX7 X1
AX1 55
SX1 X1-RTY
NZ X1,SSKIP1
SA7 B6-2 . CHANGE LEFTOPERAND TO REAL
JP B1 . TYPE
*
*
ZAND RJ BOOLPCK
BX7 X1*X2
BOOLXIT SA7 A2
MX1 3
SX7 -2
LX1 60+3-5 SHIFT THE DESCRIPTOR PROPERLY
SB6 X7+B6
IX7 X1-X7
SA7 B6+B0
EQ NEXTMIC
ZEOR RJ BOOLPCK
BX7 X1-X2
EQ BOOLXIT
ZOR RJ BOOLPCK
BX7 X1+X2
EQ BOOLXIT
ZNOT SB1 ZXNOT
EQ UNX
ZXNOT RJ BOOLPCK
BX7 -X1-X2
EQ BOOLXIT
ZLEFT RJ BOOLPCK
SX0 B6
SB6 X1
LX7 B6,X2
SB6 X0
EQ BOOLXIT
ZRITE RJ BOOLPCK
SX0 B6
SB6 X1
AX7 B6,X2
SB6 X0
EQ BOOLXIT
BOOLPCK BSSZ 1
SA1 TENTO15
SA0 15
BX0 X1
RJ SACHEK
SA1 B6-1
SA2 B6-3
EQ BOOLPCK
*
*
ADD SA1 TENTO15
SA0 15
BX0 X1
RJ SACHEK . CHECK RIGHT OPERAND
SA1 B6-2
LX7 3
LX1 3
PL X7,ADDSR1 . BRANCH IF ANY OF THE OPERANDS
PL X1,ADDSR1
SA1 B6-1
SA2 B6-3
IX7 X1+X2 . ADD THE INTEGERS
ADDEXIT BX1 X1-X1
IX7 X1+X7 . ENSURE NO MINUS ZERO
SA7 A2+0
SB6 B6-2
EQ NEXTMIC
*
SUBTR SA1 TENTO15
SA0 15
BX0 X1
RJ SACHEK . CHECK RIGHT OPERAND
SB2 SUBTR1
EQ ARITH
+ EQ SUBTRS . BRANCH IF STRING SUBTRACTION
+ FX7 X2-X1 . REAL OPERANDS
EQ ARITH4
SUBTR1 IX7 X2-X1
EQ ADDEXIT
*
MULT SA1 TENTO15
SA0 15
BX0 X1
RJ SACHEK . OPERAND CHECK AS ABOVE
SB2 MULT1
EQ ARITH
+ EQ MULTS . BRANCH IF STRING MULTIPLICATION
+ FX7 X2*X1 . REAL OPERANDS
EQ ARITH4
MULT1 PX1 X1 . PERFORM INTEGER MULTIPLICATION
PX2 X2
DX7 X1*X2
UX7 X7
FX3 X1*X2
BX1 X7
NX3 X3
AX1 48 48 BITS INTEGERS IN STAR
NZ X3,ERR32
NZ X1,ERR32
EQ ADDEXIT
*
DIV SA1 TENTO15
SA0 15
BX0 X1
RJ SACHEK . OPERAND CHECK AS ABOVE
SB2 DIV1
EQ ARITH
+ EQ DIVS . BRANCH IF STRING DIVISION
+ FX7 X2/X1 . REAL OPERANDS
EQ ARITH4
DIV1 ZR X1,ERR3 . ERROR - DIVISION BY ZERO
PX1 X1 . INTEGER DIVISION
PX2 X2
NX1 X1
FX7 X2/X1
UX7 B3,X7
LX7 B3,X7
EQ ADDEXIT
*
EXP SA1 TENTO15
SA0 15
BX0 X1
RJ SACHEK
SB2 EXP1
EQ ARITH
+ EQ EXPS
+ EQ EXPS
EXP1 NG X1,EXP4
SX1 X1-1
NG X1,EXP2 SOMETHING TO THE ZEROTH IS ONE
ZR X1,EXP8 SOMETHING TO THE FIRST IS THE SOMETHING
SB2 X1 B2 IS THE EXPONENTIATION COUNT
BX1 X2
PX2 X2 THIS IS THE UNIVERSAL MULTIPLIER
EXP3 PX1 X1 THIS IS THE BASE OF THE MULTIPLY LOOP
DX7 X1*X2 GET THE LOWER 48 BITS
FX3 X1*X2 GET THE HIGH ORDER BITS
UX7 X7 UNPACK NICELY
BX1 X7 COPY THE PARTIAL RESULT BACK INTO X1
NX3 X3 NORMALIZE THE HIGH BIT RESULT
AX1 48 A ZERO EXPONENT WOULD BE NICE
NZ X3,ERR32 FOR SHAME THERE IS SOMETHING IN THE TOP 48
NZ X1,ERR32 AN OVERFLOW IN THE BOTTOM 48 PERCHANCE
BX1 X7 RELOAD X1 WITH THE PARTIAL RESULT
SB2 B2-1 DECREMENT THE REPEAT FACTOR
NE B2,B0,EXP3 IF NON-ZERO DO IT ALL AGAIN
EQ ADDEXIT
EXP4 SX7 B0
EQ ADDEXIT A MIN US POWER GIVES ZERO RIGHT NOW...
EXP2 SX7 1 N**0
EQ ADDEXIT
EXP8 BX7 X2 N**1
EQ ADDEXIT
* USED ONLY BY SUBTR,MULT AND DIV
*
ARITH SA1 B6-2 . SAME AS IN ADD
LX1 3
LX7 3
PL X7,ARITH1
PL X1,ARITH1 . OF THE OPERANDS IS AN INTEGER
SA1 B6-1
SA2 B6-3
JP B2
ARITH1 LX1 59
NZ X7,ARITH3
NG X1,ERR38
SA1 B6-1
SA2 B6-3
JP B2-1
ARITH3 JP B2-2
*
*
ADDSR1 LX1 59
NZ X7,ADDS1
NG X1,ERR38
SA1 B6-1
SA2 B6-3
FX7 X1+X2 . PERFORM REAL ADDITION
ARITH4 OR X7,ERR37
ID X7,ERR37
NX7 X7 . NORMALIZE IN CASE OP WAS + OR -
JP ADDEXIT
*
*
CONCAT SA4 B6 . RIGHT OPERAND HEADING
SB5 X4
AX4 55
SA3 B6-B5 . LEFT OPERAND HEADING
AX3 55
LX3 2 . UNPACK TYPES
LX4 2
SB2 X3
SA1 CATWD
MX0 56
AX1 B2,X1
BX1 -X0*X1 . SELECT SWITCH WORD DEPENDING ON
SA2 X1+CATSW1 . LEFT OPERAND TYPE
SB3 X4
AX1 B3,X2
BX1 -X0*X1 . SWITCH ON RIGHT OPERAND TYPE
SB2 X1
JP B2+CATSW2
*
CATWD SWITCH CATSW1,1,0,0,0,2,2,2,0,0,0,0,0,0,0,0 LEFT OP
SWITCH DUMMY1,7,8,7,7,0,0,0,0,0,0,0,0,0,0,0 R,A,D,N,C
SWITCH DUMMY2,14,12,14,14,1,1,1,10,6,6,6,6,6,6,6 SF
SWITCH CATSW2,5,4,5,5,2,2,2,3,0,0,0,0,0,0,0 PS,PA,PE
*
* TYPE X HERE DENOTES R,A,D,N,C P IS AS USUAL
*
+ ERROR 1 . 0, XX,XP,PX,XI,XSI
+ SA4 A3-1 . 1, SFP
EQ CATSFP
CATPP2 SB1 B6-B5 . 2, PP
SA2 B6-B5
EQ CATPP
+ RJ ITOS . 3, PI
+ SA4 B6 . 4, PS
SB1 X4
EQ CATPS
SX4 B6-1 . 5, PSF, PSS, PSI
EQ CATPSF
+ SA1 B6-3 . 6, SFX
EQ CATSFR
+ SA1 B6-1 . 7, XSF,XSS
EQ CATSFR1
+ SA1 B6+0 . 8, XS
SX1 X1-1
SB6 B6-1
EQ CATSFR2
+ SA1 B6-1 . 10, SFI
RJ ITOSF
SA6 B6-1
EQ *+2
+ RJ SCATS . 12, SFS
+ SB3 0
+ SA4 B6-3 . 14, SFSS,SFSI,SFSF
AX4 18
SA4 X4 . FETCH LAST WORD OF LEFTOPERAND
MX0 6
BX7 X4
SB1 60
CTSFSS1 BX2 X4*X0 . COUNT THE NUMBER OF CHARACTERS
ZR X2,CTSFSS2 . IN THE LAST WORD
LX4 6
SB1 B1-6
EQ CTSFSS1 . RIGHT SHIFT TO B1
CTSFSS2 SA2 B6-1 . SVD OF RIGTH OPERAND TO X2
SB2 B1-18 . LEFT SHIFT TO B2
SX3 A4 . NOTE HOW X3 IS USED
EQ B3,B0,CTSFSS3 . SKIP IF SF ON THE RIGHT
SA2 X2
CTSFSS3 SB5 CTSFSSR . RETURN ADDRESS
*
CATSF SB4 B1-6
AX6 X0,B4 . MASK FOR RIGHT SHIFT
BX5 X6
LX5 18 . MASK FOR LEFT SHIFT
SX4 B7
MX0 42 . MASK FOR ADDRESS FIELD
CATSF4 SX2 X2 . TAKE NEXT WORD FROM RIGHT OPERAND
ZR X2,CATSF5
SA2 X2
CATSF5 BX1 X2*X6 . PREPARE FOR RIGHT SHIFT
LX1 B1,X1 . RIGHT SHIFT
BX7 X7+X1 . ADD TO REST OF PREVIOUS WORD
BX1 -X0*X1
BX7 X0*X7
ZR X1,CATSF8 . READY IF LAST 18 BITS ARE ZERO
SB7 X4
SA1 X4 . GET NEXT FREE WORD
BX7 X7+X4 . ADD LINK TO LAST WORD
ZR X1,CATSF7
CATSF6 BX4 -X0*X1
SA7 X3 . AND STORE
SX3 A1
BX1 -X5*X2 . PREPARE FOR LEFT SHIFT
LX7 B2,X1 . LEFT SHIFT
EQ CATSF4 . LOOP
CATSF7 RJ MORFREE
EQ CATSF6
CATSF8 SB7 X4
JP B5 . RETURN FROM CATSF
CTSFSSR SA7 X3 . STORE LAST WORD
SA1 B6-1
SA2 X1
NE B3,B0,CTSFSS9 . RELEASE RIGHT OPERAND IF SF
BX2 X1
SX7 B7
SB7 X1
AX1 18
SA7 X1
CTSFSS9 SA4 B6-3 . LEFT OPERAND SVD
SB6 B6-2
AX2 36 . LENGTH OF RIGHT OPERAND
BX2 -X0*X2
LX3 18
LX0 18
LX2 36
BX6 X0*X4 . MASK LAST OFF
IX6 X6+X2 . TOTAL LENGTH
BX6 X6+X3 . ADD LAST TO SVD
SA6 A4 . STORE RESULT SVD
SA1 MXLNGTH
AX6 36 . CHECK LENGTH AGAINST LIMIT
IX1 X1-X6
PL X1,NEXTMIC
ERR18 ERROR 18
*
CATSFR SA2 A1+B5 . RELEASE LEFT OPERAND
SA4 B6 . RESULT EQUALS TO RIGHT
BX6 X2 . OPERAND
BX7 X4 . NOTE - B5 HAPPENS TO CONTAIN 2
SA6 A1
SA7 A3
SX4 -1 . MAKE X4 NEGATIVE
CATSFR1 SA1 X1 . ERROR IF SF DOES NOT CONTAIN ZERO
SB6 B6-B5 . REMOVE RIGHT OPERAND
NE B3,B0,CATSFR2 . RELEASE RIGHT OPERAND IF SF
SX7 B7
SX4 B0-B6 . MAKE X4 NEGATIVE
SB7 A1
SA7 A1
CATSFR2 NG X4,CATSFR3
SA1 X1+0 . VALUE TO X1 IF SS OR SI
CATSFR3 ZR X1,NEXTMIC . ERROR IF X1 NOT ZERO
EQ ERR13
*
CATPP SB1 B1+1
SA1 B1+0
EQ B1,B6,CATPP1 . PUSH RIGHT OPERAND ONE WORD UP
BX6 X1 . IN THE STACK
SA6 B1-1
EQ CATPP
CATPP1 SX0 PETY . RESULT IS OF PE TYPE
SB1 X2-1
SB6 B6-1
LX0 55
SX6 X1+B1 . CALCULATE BYPASS
BX6 X6+X0
SA6 B6 . FORM AND STORE HEADING
EQ NEXTMIC
*
CATPS SA3 B6-B1
SX0 LITPM . CONVERT STRING TO A LITPM OPERATION
SX6 B1 . OVERWRITING THE HEADING
LX0 48 . OF THE LEFT OPERAND PATTERN
BX6 X6+X0
SA6 A3
SX6 X3+B1 . CALCULATE BYPASS
CATPS1 SX0 PETY
LX0 55
BX6 X6+X0
SA6 B6
EQ NEXTMIC
*
CATPSF EQ B3,B0,CATPSF2
SA4 X4+0
CATPSF2 SA1 X4
AX1 36
SA0 X1-1
SA3 A3 . LEFT OPERAND HEADING
SB1 X1+1 . LENGTH + 1
SB5 X1 . LENGTH FOR SSTOS
SB4 X3 . BYPASS OF LEFT OPERAND
RJ RESERVE . RESERVE LENGTH - 1 WORDS
SA1 X4 . TAKE SVD AFRESH
BX4 X1
RJ SSTOS . BREAK DOWN THE STRING
SX6 LITPM . ONE CHARACTER PER WORD
NE B3,B0,CATPSF1 . RELEASE RIGHT OPERAND IF SF
SX7 B7
SB7 X4
AX4 18
SA7 X4
CATPSF1 SX0 B1
LX6 48
BX7 X0+X6
SX6 B4+B1 . NEW BYPASS FOR HEADING
SA7 B6-B1 . STORE LITPM
EQ CATPS1
CATSFP AX4 36
SB5 X4
SB2 A4+0
SB4 A3+1
EQ B5,B0,CATSFP2 . BRANCH IF SF IS OF ZERO LENGTH
SA0 X4-1
SB1 B6
SB3 A0
RJ RESERVE . RESERVE SPACE FOR LITPM
CATSFP1 SB1 B1-1 . DISPLACE THE PATTERN B3 WORDS
SA1 B1 . TOWARD THE HIGH CORE
BX6 X1
SA6 A1+B3
NE B1,B4,CATSFP1
SA1 B2 . FETCH THE SVD AFRESH
SB4 B6 . SAVE B6
BX4 X1
SB6 A6
SX6 B7
RJ SSTOS . BREAK DOWN THE STRING
SB7 X4 . RELEASE LEFT OPERAND
AX4 18
SA6 X4
SB6 B4 . RESTORE B6
SX0 LITPM . FORM AND STORE LITPM
LX0 48
SX7 B3+2
BX7 X7+X0
SA7 B2
SB2 B6-B2
SX6 B2+1 . AND THE HEADING
EQ CATPS1
*
CATSFP2 SA1 A4 . USE CATPP TO DISPLACE THE
SX7 B7 . PATTERN TOWARDS LOW CORE
SB7 X1
SA7 X1
SX6 LITPM
LX6 48
SX0 1
BX6 X0+X6
SA1 B6
SA6 A4
SB5 X1
EQ CATPP2
PM SB3 PMSW . MICRO OPERATION
SA2 PMWD . PATTERN MATCH
SB1 PM1 . RETURN FOR STOP
EQ CHEK . SWITCH ON RIGHT OPERAND TYPE
*
* SWITCH FOR PATTERN MATCH RIGHT OPERAND
*
PMWD SWITCH PMSW,0,5,1,1,3,3,3,4,2,2,2,2,2,2,2
+ SX4 B6-1
EQ PMSF . 0, SF
+ SA4 B6-1
EQ PMSSSI . 1, SS,SI
+ ERROR 16 . 2, R,A,D,N,C
+ EQ PM1 . 3, PS,PE,PA
+ RJ ITOS . 4, I
SB1 PM1 . 5, S
STOP SA0 1
*
* THE FOLLOWING CODE FORMS A SIMPLE PATTERN USING THE TOP
* OPERAND STRING. ACTUALLY A LIT PM OPERATION IS CREATED
*
RJ RESERVE . PUSH THE STRING DOWN ONE WORD
SA1 B6-1 . (TOWARDS HIGH CORE)
SB4 X1 . TOP OF HEADER BYPASS PART TO B4
SB2 B0
SB5 X1-1
EQ B2,B5,STOP2
STOP1 SA1 A1-1 . LOOP B4-1 TIMES
SB2 B2+1
BX7 X1
SA7 B6-B2
NE B2,B5,STOP1
STOP2 SX1 LITPM
LX1 48 . LIT OPERATION WITH PROPER
SX7 B4 . BYPASS PART TO X7
BX7 X1+X7
SX1 PSTY
SA7 B6-B4 . PUT IT TO THE FRONT OF THE STRING
LX1 55
SX6 B4+1
BX6 X1+X6 . PS HEADER WORD
SA6 B6
JP B1 . RETURN
*
* SS,SI AND SF TYPES HAVE TO BE CONVERTED INTO S FORM. AN EXTRA
* WORD IN THE FRONT OF THE STRING WILL BE ALLOWED FOR THE
* LIT OPERATION. THE LIST HOLDING SF WILL BE RELEASED
*
PMSSSI BSS 0
*
PMSF SA1 X4 . X4 IS THE ADDRESS WHERE THE SVD
AX1 36 . CAN BE FOUND
SA0 X1 .
RJ RESERVE
SA1 X4 . SVD MIGHT HAVE CHANGED
BX4 X1
SB5 A0
RJ SSTOS . CONVERT TO S FORMAT
NE B4,B0,PMSF1 . RELEASE LIST IF SF
SX7 B7
SB7 X4
AX4 18
SA7 X4
PMSF1 SB4 A0+1
EQ STOP2 . GO TREAT LIKE S
*
PM1 SA1 B6 . PREPARE THE RIGHT OPERAND
SB2 X1
SX7 B6+1 . INITI AL VALUE FOR PCHAIN
SB5 B6-B2 . FIRST ELEMENT IN THE PATTERN-1
SB4 B6-B2
SA7 PCHAIN
SA0 2 . THE HEADING OF THE RIGHT OPERAND
RJ RESERVE . WILL BE OVERWRITTEN
PM1F SX1 ENDEXPM . THIS ENDEX TERMINATES THE PATTERN
BX6 X6-X6
LX1 48
SA6 B6-1 . STORE END OF PCHAIN
SX2 PSTY
BX7 X7+X1
SX6 B6-B5
LX2 55
SA7 B6-2
BX6 X6+X2
SA6 B6 . STORE A TEMPORARY HEADING
PM1A SB4 B4+1
PM1B EQ B4,B6,PM2 . FETCH ELEMENTS ONE BY ONE
SA1 B4
ID X1,PM1A . SKIP $ AND .
UX5 X1,B3
GE B0,B3,PM1C . BRANCH IF NOT STRING ARGUMENTED
SB4 B4+X1 . ELEMENT (LIT,ANY ETC.)
EQ PM1B
PM1C NE B3,B0,PM1A . BRANCH IF NOT STAR (*)
SA1 X5+0 . OPERAND OF STAR
BX3 X1
AX3 55 . TYPE OF OPERAND
SX3 X3-4
NG X3,PM1A . BRANCH IF SS,SI
SX3 X3-3
NG X3,PM1D . BRANCH IF PS,PE,PA
NZ X3,PM1A . BRANCH IF I
MX0 6
BX1 -X0*X1 . REPLACE I TYPE VALUE WITH SS
RJ ITOSF
SX1 SSTY
LX1 55
BX6 X1+X6
SA6 X5
EQ PM1A
PM1D SA2 PCHAIN . SEARCH PCHAIN FOR THE SAME PATTERN
PM1E SA3 X2
SX2 X3
AX3 18
BX0 X3-X5
ZR X0,PM1A . BRANCH IF FOUND
NZ X2,PM1E
SB1 A3 . ADDRESS OF LAST LINK TO B1
SX4 X5
RJ PTOPX4 . LOAD THE PATTERN TO THE STACK
SA0 B6-B5 . RESERVE 3 MORE LOCATIONS
SA0 A0+3 . (NOTE THAT B6-A0 WILL POINT TO
SB6 B5 . B5 IN GETSTAK)
SX6 MARK
RJ RESERVE
SX7 B6-1 . LINK THE PATTERN TO PCHAIN
LX5 18
BX7 X7+X5
SA7 B1
SA6 B1+1 . INITIALIZE HOPE
BX7 X7-X7 . SET ADDRESS OF TERMINATING ENDEX
EQ PM1F . TO ZERO
*
*
PM2 SX7 A5 . SAVE A5
SA7 PMA5
SA1 B5
SB2 X1
SX6 B5-B2
SA6 SBASE . INITIALIZE STRING BASE
SB4 B5+1 . INDEX
SB3 B5-1 . STRING LENGTH
SX7 B3
SA7 SLENGTH
BX3 X3-X3 . SIX
SB1 B0 . SIB
BX7 X7-X7
SA7 PIB . PIX
SA7 PIX . PIB
SA2 MAXSTAK
SB5 X2 . B5 IS MAXSTAK
SA4 ANCHOR
BX5 X5-X5 . LOCP, LOCS ARE ZERO
SA0 X6+1
PM2A SX7 A0
SA7 SPOS . STORE POS IN FIRST LEVEL
SX0 B4
LX0 18
BX7 X7+X0
RJ ENTER . TRY TO MATCH THE PATTERN
NZ X4,PMABT . FAILURE IF PATTERN FAILS IN
SB2 A0+0 . ANCHORED MODE
SA1 LENFAIL
SA0 B2+1
LT B3,B2,PMABT
ZR X1,PMABT . TEST ON LENGTH FAILURE
SX7 PM2A . RESET P AND S STACKS
EQ SETSIPI
PMABT SX5 0 . GET RID OF P AND S STACKS
SX7 PM2B
EQ SETSIPI
PM2B SB6 B3+1 . RESET B6
SA1 PMA5
SA5 X1 . RESTORE A5
EQ FAIL . SIGNAL FAILURE
PMFOUND SB6 B3+2 . RESET B6 (PROVIDE 1 WORD FOR
SX7 A0-1 . THE RESULT)
SA4 PIX
SA7 PMFA0
PMF1 ZR X4,PMF2 . GO THROUGH THE P CHAIN AND
SA4 X4 . PERFORM (.) TYPE ASSIGNMENTS
SA3 X4 . ADDRESS OF VARIABLE TO X3
AX4 18
SB2 X4 . FIRST
AX4 18
SB3 X4 . LAST
BX7 X3
SX6 A3
SA7 PMFX4
SA6 PMFA4
RJ STOSFX6 . CONVERT INTO SF FORMAT
SA6 TEMPDOL
SB2 A6+1
SA6 B2
AX3 18 . PREPARE ADDRESS OF VARIABLE
RJ SASSIGN . AND ASSIGN
SA4 PMFX4
SX4 X4
SX7 B7
NZ X4,PMF1 . GO BACK IF NOT END OF CHAIN
SA1 PIX
SA2 PMFA4
SB7 X1
SA7 X2
PMF2 SA1 PMFA0
SA4 SBASE . PACK THE RELATIVE FWA AND LWA OF
SA2 SPOS . SUBSTRING MATCHED INTO THE
SA3 PMFHD . HEADING
IX1 X1-X4
IX2 X2-X4
LX1 18
BX1 X1+X2
SA5 PMA5
LX1 18
SA5 X5
BX7 X1+X3
SA7 B6 . STORE THE HEADING
EQ NEXTMIC
*
PMFHD VFD 5/SPECTY,55/1
STAR SX7 STARPM . MICRO OPERATION STAR
EQ PRD1
*
DOL SX7 DOLPM MICRO OPERATION DOL
EQ PRD1
*
PRD SX7 PRDPM MICRO OPERATION PERIOD
PRD1 SX5 X5
LX7 48
SB1 PRD4 RETURN ADDRESS OF STOP
NZ X5,PRD2 BRANCH IF ADDRESS IS GIVEN
SB6 B6-2
SA1 B6+1 IF NOT, USE TOPOPERAND NAME
SX5 X1+0 INSTEAD
PRD2 BX7 X7+X5
DF X7,STAR1 . BRANCH IF STAR
SB3 PRDSW
SA2 PRDWD
BX5 X7 . PACK PM OP. INTO X5
EQ CHEK SWITCH ON OPERAND TYPE
*
PRDWD SWITCH PRDSW,3,2,4,4,5,6,6,1,0,0,0,0,0,0,0
*
+ ERROR 45 . 0, R,A,D,N,C
+ RJ ITOS . 1, I
+ SB1 PRD4 . 2, S
EQ STOP
+ SX4 B6-1 3, SF
EQ PMSF
+ SA4 B6-1 4, SS,SI
EQ PMSSSI
+ EQ PRD4 5, PS
+ SA2 B6 6, PE,PA
SB1 X2 EXPPM BRACKETS HAVE TO BE
SB2 B6-B1 INSERTED AROUND THE PATTERN
SB3 B6
SA0 2 RESERVE TWO WORDS FOR THE BRACKETS
RJ RESERVE
SB4 1
SX0 EXPPM
PRD3 SB3 B3-B4 PUSH PATTERN ONE WORD TOWARDS
SA1 B3 HIGH CORE
EQ B2,B3,PRD5
BX7 X1
SA7 B3+B4
EQ PRD3
PRD5 SX7 ENDEXPM
SX2 PSTY
LX0 48
LX7 48
LX2 55
SA7 B6-B4 STORE ENDEXPM
SX6 B1+B4
SX7 X6+B4
BX6 X6+X0
BX7 X7+X2
SA6 B2+B4 STORE EXPPM
SA7 B6+0 STORE HEADING
PRD4 SA0 1 COMMON PART
RJ RESERVE RESERVE ONE WORD FOR PRD OR DOL
SA1 B6-1
BX7 X5
SX0 A0
SA7 A1 STORE PRD OR DOL
IX6 X1+X0 BUMP BYPASS
SA6 B6+0
EQ SNDMIC
*
STAR1 SA0 2 STAR CREATES A PS TYPE ENTRY
RJ RESERVE IN THE STACK
SX6 PETY
SX1 A0
LX6 55
BX6 X1+X6
SA7 B6-1
SA6 B6
EQ SNDMIC
*
*
NULL SB1 SNDMIC
RJ ZROX7
MX0 5
BX2 X2-X2 . PUT AN SF TYPE ENTRY
BX7 -X0*X7 . TO THE TOP OF THE STACK
NULL1 SA0 2 . POINTING TO A NULL STRING
RJ RESERVE
SX6 2
SA7 B6-1
BX6 X6+X2
SA6 B6 . NOTE,THIS IS A LEFT-PART ONLY
JP B1 . OPERATION
* . MICRO OPERATION ZERO
ZERO SX2 ITY . SAME WITH A 0 VALUED INTEGER
SX7 B0
LX2 55
SB1 SNDMIC
EQ NULL1
* . MICRO OPERATION NAME
NAME SX1 X5 . SAME WITH A NAME IN X5
SB1 SNDMIC
*
X1NAME BX7 X1 . SAME WITH A NAME IN X1
SX2 NTY
LX2 55
BX7 X7+X2
EQ NULL1
*
*
*
ARRAY SA0 3 . MICRO OPERATION
RJ RESERVE . ARRAY LEFT BRACKET
SA1 X5
BX7 X1
AX1 55
BX6 X6-X6
SX1 X1-ATY . ERROR, LEFT OPERAND
NZ X1,ERR4
SA7 B6-1 . INITIALIZE DOPE POINTER
SA6 B6-2 . INITIALIZE VECTOR SUM
SX1 3
SX7 SPECTY . SPECIAL TYPE WILL BE REMOVED
LX7 55 . BY RIGHT BRACKET
BX7 X7+X1
SA7 B6
EQ NEXTMIC
*
SUBCOM RJ SARRAY . MICRO OPERATION SUBSCRIPTCOMMA
NG X4,ERR6 . ERROR, TOO MANY SUBSCRIPTS
SA4 A4+1 . FETCH MULTIPLYER
SA7 A3 . STORE INCREASED DOPE INDEX
PX6 X6 . OLD VECTOR SUM + X - L
AX4 36
SX1 X4 . U-L+1
PX1 X1
DX6 X1*X6
UX6 X6
SA6 A2 . STORE NEW VECTOR SUM
EQ NEXTMIC
*
ARRAYN SX5 X1NAME . MICRO OPERATION ARRAY NAME
EQ ARRAYV1 .
*
ARRAYV SX5 X1VALUE . MICRO OPERATION ARRAY VALUE
ARRAYV1 RJ SARRAY
PL X4,ERR7 . ERROR, TOO FEW SUBSCRIPTS
SB6 A2-B1
AX7 18
SX1 X7 . FINAL ADDRESS IS THE BASE
IX1 X1+X6 . PLUS THE VECTOR SUM
SB1 SNDMIC
JP B2
*
* THIS SUBROUTINE IS USED ONLY BY SUBCOM AND ARRAYV
*
SARRAY NO
+ SA1 TENTO9 . CHECK VALUE OF INDEX EXPRESSION
SA0 9
BX0 X1
RJ SACHEK
LX7 3
PL X7,FAIL . BRANCH IF NOT INTEGER TYPE
SB2 X5
SB1 1
SA1 B6-B1 . INDEX VALUE X
SB6 A1-B1
SA3 B6-B1
SX7 B1
SA2 A3-B1
IX7 X7+X3 . NEXT DOPE INDEX
SA4 X7
SX5 X4 . UPPER LIMIT
AX4 18
SX3 X4 . LOWER LIMIT
IX5 X5-X1
IX0 X1-X3
IX6 X2+X0 . ADD X - L TO VECTORSUM
NG X5,FAIL . FAIL IF OUT OF BOUNDS
PL X0,SARRAY . RETURN
EQ FAIL
*
*
*
INDRCN RJ INDRCT
SB1 SNDMIC
EQ X1NAME
*
INDRCV RJ INDRCT
EQ X1VALUE
*
OPRND SX1 X5
EQ X1VALUE
*
ASGN SX3 X5+0
ZR X3,ASGN1
SB2 B6
RJ SASSIGN
SA1 B6 . SKIP ASSIGNED VALUE
SB1 X1+0
SB6 B6-B1
EQ NEXTMIC
SB2 X1+1
ASGN1 SA1 B6 . FETCH LEFTOPERAND NAME
SB2 X1
SB2 B2+1
SA3 B6-B2
SB2 B6
RJ SASSIGN . PERFORM ASSIGNMENT
SA1 B6 . SKIP BOTH OPERANDS
SB2 X1
SA1 B6-B2
SB2 X1
SB6 A1-B2
EQ NEXTMIC
*
ASGNPM SB3 ASPMSW . MICRO OPERATION
SA2 ASPMWD . ASSIGNMENT WITH A PATTERN MATCH
EQ CHEK . LEFT OPERAND
*
ASPMWD SWITCH ASPMSW,3,2,4,4,0,0,0,1,0,0,0,0,0,0,0
*
+ ERROR 46 . 0, P,R,A,N,D,C
+ SB1 *+2 . 1, I
EQ ITOSFTP
+ RJ SCATS . 2, S
+ SX4 B6-1 . 3, SF
EQ ASPM0
+ SA4 B6-1 . 4, SS,SI
ASPM0 SA2 B6-3
SA3 B6-2
SB3 X2
SB5 A2-B3 . STRING BASE
AX3 18
SB2 X3+B5 . FIRST CHARACTER MATCHED
SB3 B7 . FIRST OF RESULT STRING
BX7 X7-X7 . OUTPUT WORD
SB4 48 . OUTPUT POSITION COUNT
ASPM1 SA0 X3-1 . LENGTH IS BEING ACCUMULATED IN A0
ASPM2 SB5 B5+1
GE B5,B2,ASPM5 . END PACK
SA2 B5+0 . NEXT CHAR
SB4 B4-6
NE B4,B0,ASPM4 . BYPASS IF WORD IS NOT FULL
SA1 B7+0
NZ X1,ASPM3 . GET A FREE WORD
RJ MORFREE
ASPM3 SX1 X1
SB7 X1
LX7 18
BX6 X7+X1 . ADD LINK
BX7 X7-X7
SA6 A1 . STORE OUTPUT WORD
SB4 42
ASPM4 LX7 6 . PACK CHAR INTO OUTPUT WORD
BX7 X7+X2
EQ ASPM2
ASPM5 LX7 12
LX7 X7,B4 . LEFT JUSTIFY LAST WORD
SA1 B7+0
NZ X1,ASPM6 . GET A FREE WORD
RJ MORFREE
ASPM6 SB7 X1
EQ B3,B0,ASPM8 . EXIT IF FLAG IS SET
MX0 6 . OTHERWISE PREPARE FOR CONCATENA-
SA2 X4 . TION
SX3 A1
SB5 ASPMR . RETURN TO B5
BX4 X2
AX4 36
SB2 X4
SA0 A0+B2 . SUM LENGTHS IN A0
SB2 B4-6 . SET SHIFTS FOR CONCAT
SB1 B2+18
EQ CATSF . PERFORM CONCATENATION
ASPMR SX6 B7 . UPON RETURN AN EXTRA WORD HAS
SB7 X3 . BEEN RESERVED, RELEASE IT
SA6 X3
MX0 6
SX5 B3 . FIRST TO X5
SB3 B0 . SET FLAG TO EXIT
SA1 B6-2
SA2 B6-3
AX1 36 . LAST CHARACTER MATCHED TO B5
SB5 X2
SB2 A2
SB5 A2-B5
SB5 B5+X1
SB1 B2-B5
SX3 A0+B1 . FINAL LENGTH + 1
SB4 48
ASPM7 BX1 X0*X7 . RIGHT JUSTIFY LAST WORD
ZR X1,ASPM1
LX7 6
SB4 B4-6
EQ ASPM7
ASPM8 SA7 A1+0
SA3 B6-3
SX1 A1 . LAST
SX2 A0 . LENGTH
LX1 18
LX2 36
BX6 X5+X2
BX6 X6+X1 . FORM SVD IN B6
SA6 TEMPDOL
SB2 TEMPDOL+1
SA6 B2
AX3 18
SX3 X3+0
ZR X3,ERR25 . LEFT OPERAND NOT VARIABLE
RJ SASSIGN . PERFORM ASSIGNMENT
EQ SKIP . SKIP ENTRIES IN THE STACK
*
*
PARAM RJ SPARAM . MICRO OPERATION
EQ NEXTMIC . PARAMETER COMMA
*
SPARAM NO
+ SA2 PRMWD . SWITCH ON TYPE OF TOPOPERAND
SB3 PRMSW
EQ CHEK
*
PRMWD SWITCH PRMSW,1,0,2,3,1,1,1,1,1,1,1,1,1,1,1
+ RJ SCATS . 0, S
+ EQ SPARAM . 1, SF,PS,PA,PE,I,R,A,D,N,C
+ SA1 B6-1 . 2, SS
EQ PRMSS
+ SA1 B6-1 . 3, SI
SA3 ITYWD . REPLACE SI BY I
SA2 X1+1 . HEADING TO X3, INTEGER TO X2
BX7 X3
BX6 X2
SA7 B6
SA6 A1
EQ SPARAM
PRMSS SX7 2 . MAKE A COPY OF SS
SA2 X1
SA7 B6 . SF TYPE HEADING
RJ SSTOSF
SA6 B6-1
EQ SPARAM
*
SSTYWD VFD 5/SSTY,55/2 . SS TYPE HEADING
ITYWD VFD 5/ITY,55/2 . I TYPE HEADING
CALL RJ SPARAM . MICRO OPERATION - CALL
SA5 A5
AX5 18
SA4 X5
NG X4,CALLSTD
AX5 18
SB1 X5 . ACTUAL PARAMETERS TO B1
BX1 X4
AX1 18 . FORMAL PARAMETERS
SB2 X1
LT B2,B1,ERR8 . ERROR, TOO MANY ACTUAL PARAMS.
SB5 B6
SA3 B5
CALL1 SB4 X3 . LINK ACTUAL PARAMETERS
SX7 B4 . TOGETHER IN REVERSE ORDER.
SX6 B5
SB5 B5-B4
SB1 B1-1
EQ B1,B0,CALL2
LX7 36
SA3 B5
BX7 X3+X7
SA7 A3
EQ CALL1
CALL2 AX1 18
SB1 X1 . APPETITE TO B1
AX1 19
SB1 B1+B5
NZ X1,DORF . BRANCH IF NOT FUNCTION CALL
. MAKE SURE THAT THERE WILL BE
GE B6,B1,CALL3 . ENOUGH SPACE FOR THE FORMALS
SA0 B1-B6
RJ RESERVE
CALL3 SA4 A4 . PROCEDURE DESCRIPTION MIGHT HAVE
SB1 X4 . CHANGED
SB2 X6
SX6 B5
SA6 CALLB5P
CALL4 SA3 B1 . THIS LOOP TAKES THE ACTUAL
AX3 18 . PARAMETERS AND ASSIGNS THEM TO
SA1 X3 . THE FORMAL VARIABLES FROM THE
SX7 B0 . LEFT TO THE RIGHT. THE ORIGINAL
BX5 X1 . DESCRIPTORS AS WELL AS THEIR
SA7 A1 . ADDRESSES ARE SAVED IN THE STACK
RJ SASSIGN
SA2 B2
AX2 36 . LINK TO NEXT ACTUAL PARAM
SB2 X2+B2
BX7 X5
SB5 B5+2
SA7 B5-1 . STORE ORIGINAL DESCRIPTOR
SB3 X2
SA2 B1
SB1 X2 . FORMAL ADDRESSES ARE TAKEN FROM
AX2 18 . THIS LIST
BX7 X2
SA7 B5 . STORE FORMAL ADDRESS
NE B3,B0,CALL4 . ZERO MARKS END OF PARAM-LINK
CALL5 SA2 B1 . IF THERE ARE LESS ACTUALS THAN
NG X2,CALL6 . FORMALS,NULL VALUE IS SIMULATED
SB1 X2 . FOR THE REST
SB5 B5+2
AX2 18
SA3 X2
BX7 X3
SA7 B5-1
SX7 X2
SA7 B5
RJ ZROX7
SA7 X2
EQ CALL5
CALL6 SA3 STAKTOP . SYSTEM VARIABLES HAS TO BE
SA1 INFAIL . STACKED AS WELL
SA4 MINSTAK
SX7 A5
IX3 X3-X4
SX6 0
SA6 INFAIL . CLEAR INFAIL
LX3 18
BX7 X1+X7
AX2 18 . ENTRY LABEL IN X2
BX7 X3+X7
SA4 X2
SB6 B5+2 . NEW B6
MX0 1 . PROCEDURE CALL TYPE
SA1 CALLB5P
SA7 B5+1
SB5 X1
SX6 B6
SX1 B6-B5 BYPASS VALUE
SA6 A3 . STORE NEW STAKTOP
BX7 X0+X1
SA7 B6+0
SX5 X4 . DO NOT TOUCH A5 YET
SB1 GOTO1
EQ NEWRULE
*
CALLSTD SB1 X4 . CALL STANDARD PROCEDURE
AX5 18
JP B1
*
*
*
DORF SX1 X1-1
NZ X1,FIELD . BRANCH IF NOT DATA FUNCTION
LX5 37 . ERROR , DATA CANNOT GIVE NAME
NG X5,ERR28 . RESULT
SB4 X6
SA3 MINSTAK
SA2 MAXSTAT . RESERVE SPACE IN STATIC
SX6 X2+1
SX6 X6+B2
SX5 B2
SA6 A2
SB3 X3
SB1 X6+0
LT B1,B3,DATA2 . THERE IS ENOUGH ROOM
SB3 B2+BUFF4 . ROUND UP
SB4 B4+B3
SB5 B5+B3
RJ PUSHSTK . THE STACK HAS TO BE PUSHED TO MAKE
DATA2 SX6 X4 . SPACE
SB1 X5
SA6 X2 . POINTER TO DATA DESCRIPTION
SX6 A4-1 . POINTER FOR DATATYPE FUNCTION
SX5 X2
LX6 18
BX7 X2+X6
SB2 B4
SA7 DATAWD
DATA3 SB1 B1-1 . MUCH LIKE TO A PROCEDURE CALL
SX5 X5+1 . THE PARAMETERS ARE ASSIGNED TO
SX6 B0 . NEW VARIABLES
BX3 X5
SA6 X5
RJ SASSIGN
SA2 B2 . LINK TO THE NEXT PARAMETER
AX2 36
SB2 X2+B2
SB3 X2
NE B3,B0,DATA3
EQ B1,B0,DATA5
DATA4 SX5 X5+1 . NULL STRINGS WILL BE SUBSTITUTED
RJ ZROX7 . FOR MISSING PARAMETERS
SA7 X5
SB1 B1-1
NE B1,B0,DATA4
DATA5 SX0 DTY . PUT A REFERENCE TO THE NEW DATA
SB6 B5+2 . TO THE TOP OF THE STACK
SX1 2
LX0 55
SA2 DATAWD
BX6 X0+X1
BX7 X0+X2
SA6 B6
SA7 B6-1
EQ NEXTMIC
*
FIELD SX1 X1-1
NZ X1,ERR14 . ERROR,THE FUNCTION IS UNDEFINED
SA1 B6 . FIELD FUNCTION
AX1 55
SB6 B6-2
SX1 X1-DTY
SB1 1 . TOP OPERAND MUST BE OF DATA TYPE
NZ X1,ERR21 . ERROR IF IT IS NOT
SA1 B6+1
SB2 A4
SA2 X1
FIELD1 SA3 X2+B1 . SCAN DATA DOPE VECTOR FOR
. THE FIELD ,FIELD ID IS IN B2)
SB3 X3
EQ B2,B3,FIELD2
SB1 B1+1
PL X3,FIELD1
EQ ERR22 . ERROR-NO SUCH FIELD IN THIS DATA
FIELD2 SX1 A2+B1 . THE RELATIVE ADDRESS OF THE FIELD
LX5 37 . IN THE DOPE IS THE SAME AS THE
SX6 X1+0
SX4 X1+0
SB1 NEXTMIC
SA6 UA . SAVE ADDRESS FOR PMCHEK
PL X5,SOPERND . ADDRESS OF THE DESIGNATED
EQ X1NAME . VARIABLE AMONG THE DATA
*
RETUN SX5 X5+MARK-3
PL X5,ERR10 . JUMP TO UNDEFINED LABEL
XRETURN SA2 B6
SB5 X2
PL X2,ERR23 . ERROR, RETURN FROM ZERO LEVEL
SB5 B6-B5
SB6 B6-2
SB1 B5
XRET1 SB1 B1+2 . LOOP FOR RELEASING FORMAL
GE B1,B6,XRET3 . PARAMETERS, AND FOR RESTORING
XRET4 SA3 B1 . THEIR DESCRIPTORS FROM THE STACK
RJ FREESVD
GE B4,B0,XRET2
SA4 X3 . I/O TYPE NEEDS EXTRA TREATMENT
SX7 B7
SB7 X4
SA7 X4
XRET2 SA2 B1-1
BX6 X2
SA6 X3
EQ XRET1
XRET3 SB3 X5+2 . RELEASE PROCEDURE VALUE
NE B3,B0,XRET5 . IF FRETURN
SX5 B0
EQ XRET4
XRET5 SB2 1
SA3 B6+B2 . SYSTEM VARIABLES
SA2 B6-B2 . SVD OF PROCEDURE VALUE
SA1 B6 . ADDRESS OF PROCEDURE VALUE
SA5 X3 . MICRO P COUNTER
SA4 MINSTAK
MX0 1
AX3 18
BX7 X0*X3
MX0 59
SX6 X3
IX6 X6+X4
SA7 UA . CLEAR UA
SA4 STCOUNT . DECREASE STCOUNT
SA7 INFAIL
SB6 B5
IX7 X0+X4
SA7 A4
BX7 X2 . SVD TO X7
SA6 STAKTOP
LT B2,B3,FAIL . FINISHED IF FRETURN
SA2 MINSTAT
SA3 X1
SA7 X1 . RESTORE ORIGINAL VALUE OF PRO-
SX4 X2+XWDREL . CEDURE NAME
BX6 X3
LX5 1 . CHECK NAME BIT
GE B3,B0,XRET6 . BRANCH IF NOT NRETURN
AX3 55
BX5 -X5
SX3 X3-NTY
NZ X3,ERR26 . ERROR,NRETURN ETC.
NG X5,XRET9 . BRANCH IF VALUE IS NEEDED
XRET6 NG X5,ERR25 . ERROR, NO NRETURN WHEN NAME IS
AX3 55 . NEEDED
SX3 X3-SSTY . BRANCH IF VALUE IS NOT A STRING
NZ X3,XRET8
SX7 2
SB6 X7+B6 . STACK SF TYPE ENTRY
LX6 6 . CLEAR SS TYPE BITS
SA7 B6
AX6 6
SA6 B6-1
EQ NEXTMIC
XRET8 SA6 X4+0 . PUT PROCEDURE VALUE TO THE TOP OF
SB1 XRETR . THE STACK. NOTE THAT THE SVD IS
EQ SOPERND . STORED IN STATIC WHERE AN EVENTUAL
XRETR BX3 X4 . GARBAGE COLLECTION CAN FIND IT
RJ FREESVD . RELEASE PROCEDURE VALUE
BX7 X7-X7
SA7 X3 . CLEAR XWRD
GE B4,B0,NEXTMIC . I/O TYPE NEEDS EXTRA TREATMENT
SA4 X3
SX7 B7
SB7 X4
SA7 X4
EQ NEXTMIC
XRET9 SX4 X6+0 . VALUE OF NRETURN
SB1 NEXTMIC
SA6 UA . NOTE NRETURN FOR PMCHECK
EQ SOPERND
*
TITLE STORAGE MANAGEMENT ROUTINES
* X1,X7,B1,B2,B3,A0
PUSHSTK NO
+ SA0 B3
RJ RESERVE . RESERVE ENOUGH SPACE
SA1 MINSTAK . BUMP MINSTAK
SB2 X1
SX7 X1+B3
SB1 B6-B3
SA7 A1
PSHSTK1 SA1 B1
SB1 B1-1
BX7 X1
SA7 A1+B3
GE B1,B2,PSHSTK1
PSHSTK2 SA1 STAKTOP . BUMP STACKTOP
SX7 X1+B3
SA7 A1
EQ PUSHSTK
*
* THIS PROCEDURE RESERVES X1 WORDS IN THE STACK. B6 IS UPDATED
* X1,A0
*
RESERVE NO
+ SA1 MAXSTAK
SB6 A0+B6 . CHECK IF NEW B6 NOT GREATER
BX1 -X1 . THAN MAXSTAK
SX1 X1+B6
NG X1,RESERVE
RJ GETSTAK . GET STACK SPACE IF IT IS
EQ RESERVE
*
*
* SUBROUTINE MOREFREE HAS TO BE CALLED WHENEVER THE END OF THE
* FREE CHAIN IS MET.( A ZERO WORD ) HALF OF THE SPACE BETWEEN
* THE STACK AND DYNAMIC WILL BE RESERVED, OR IF IT IS TOO SHORT
* ADDITIONAL FIELDLENGTH WILL BE REQUESTED.
* X1
*
MORFREE NO
+ SA7 MFX7 . SAVE SOME REGISTERS
SA6 MFX6
BX7 X2
SA7 MFX2
SA1 MAXSTAK
SX2 B6
IX6 X1-X2
SX2 X6-BUFF1 . STORAGE
NG X2,MFLEN . TOO SHORT
AX6 1
IX7 X1-X6 . RESERVE HALF OF IT
SA7 A1
MFCHN BX6 X1 . FILL UP STORE WITH A FREE CHAIN
SA6 B7+0 . FROM X1 TO X7 TOWARD LOW CORE
MFCHN1 SX6 X1-1
SA6 X1
SX1 X6
BX2 X1-X7
NZ X2,MFCHN1
SX7 B0 . END OF CHAIN WORD
SA7 A6
SA1 MFX6 . RESTORE REGISTERS
SA2 MFX7
BX6 X1
BX7 X2
SA1 B7 . TO ASSIST CALLING SIDE
SA2 MFX2
EQ MORFREE . RETURN
MFLEN SX6 FLDINCR
MFLEN1 SA1 FIELDLN
IX7 X1+X6
SA2 FLDLM
IX2 X2-X7
NG X2,ERR17 . ERROR.MAX FIELDLENGTH HAS BEEN
SA7 A1 . EXCEEDED
LX7 30
IFNE TRCFLG,0,1
SA7 FL . *************
SA7 FLDSTAT
SA2 FLDCALL
BX7 X2
SA7 1 . CALL MEM WITH RECALL
SX1 X1-1
+ SA2 1
NZ X2,* . WAIT UNTIL COMPLETE
IX1 X1+X6
IX7 X1-X6 . GO TO FILL UP VIRGIN STORAGE
EQ MFCHN . WITH FREE CHAIN
*
FLDCALL VFD 18/3LMEM,2/1,40/FLDSTAT
FLDSTAT DATA 0 . STATUS WORD
*
MFX2 DATA 0 . REGISTER SAVE WORDS
MFX6 DATA 0
MFX7 DATA 0
*
*
* GETSTAK PRODUCES SPACE FOR THE STACK UP TO B6. B6-A0 MUST
* CONTAIN THE LAST SENSIBLE STACK ENTRY. A GARBAGE COLLECTION
* WILL BE PERFORMED IF NECESSARY
* A0,X1
*
GETSTAK NO
+ SA6 GSX6 . SAVE REGISTERS USED IN GETSTAK
SA7 GSX7
SX6 B3
SX7 B4
SA6 GSB3
SA7 GSB4
BX6 X2
SA6 GSX2
SX2 B7
SX1 B0+0
GS1 SX1 X1+1 . NUMBER OF FREE WORDS TO X1
SA2 X2
NZ X2,GS1
SX1 X1-1
SB3 B7
SB7 A2
SX6 B6
SA2 MAXSTAK
IX2 X2-X6
IX1 X1+X2
NG X1,GS2 . IF FREE SPACE NOT ENOUGH OR
SX1 X1-BUFF2 . GARBAGE COLLECTION WOULD NOT BE
PL X1,GS3 . EFFICIENT, REQUEST MORE FIELDLENGTH
GS2 BX6 -X1
SX6 X6+100B
AX6 6 . ROUND THE AMOUNT OF FIELDLENGTH
LX6 6 . NEEDED UP TO THE NEXT OCTAL
SA1 GSRET . HUNDRED
BX7 X1
SA7 MORFREE . GO TO REQUEST FIELDLENGTH
EQ MFLEN1
GSRET EQ GS3
GS3 SX6 B1 . SAVE REGISTERS USED IN GRBCOLL
SX7 B2
SA6 GSB1
SA7 GSB2
SB7 B3
SB1 A0
SB6 B6-B1 . RESET D6 TO A REASONABLE VALUE
RJ GRBCOLL . COLLECT GARBAGE
SB6 B6+A0 . RESTORE B6
SA1 GSX6
SA2 GSX7 . RESTORE ALL REGISTERS USED
BX6 X1
BX7 X2
SA1 GSB1
SA2 GSB2
SB1 X1
SB2 X2
SA1 GSB3
SA2 GSB4
SB3 X1
SB4 X2
SA2 GSX2
EQ GETSTAK . RETURN
*
GSX2 EQU MFX2
GSX6 EQU MFX6
GSX7 EQU MFX7
GSB1 DATA 0
GSB2 DATA 0
GSB3 DATA 0
GSB4 DATA 0
TITLE GARBAGE COLLECTION
* GARBAGE COLLECTION BEGINS WITH COUNTING THE NUMBER OF WORDS
* ON THE FREE CHAIN. OUR AIM IS TO GATHER ALL FREE WORDS TO
* THE LOWER PART OF THE DYNAMIC AREA THAT WE CAN DELETE THEM.
* THIS CAN BE OBTAINED BY SCANNING ALL EXISTING CHAINS AND
* MOVE THOSE LINKS IN THE LOWER PART TO A FREE LINK IN THE
* UPPER.
* X1,X2,X6,X7,B1,B2,B3,B4
GRBCOLL NO
+ SX2 B7
SX6 B0
SA1 MAXSTAK
GRB1 SX6 X6+1 . COUNT THE NUMBER OF FREE WORDS
SX7 A2
SA2 X2
NZ X2,GRB1
IX6 X1+X6
SB1 X6 . B1 IS THE LIMIT BETWEEN THE LOWER
SX6 X6-1
SA6 A1
SB4 B6
RJ GRBFW . AND THE UUPER PART
SB2 A2 . IF THE END OF FREE CHAIN IS IN
GE B2,B1,GRB3 . THE LOWER PART, RELOCATE
SX6 A1
SA6 X7 . UPDATE THE LINK LEADING TO THE
SX7 B0+0 . END WORD
SA7 A1
RJ GRBFW
GRB3 SA2 B4 . CRIPTIONS OF THE MISSING LINKS
SB3 X2 . NOTE THAT THERE IS NO LIMIT ON
ZR X2,GRB2
NG X2,GRB4 . THE LOOP, RETURN OCCURS IN GRBFW
SB4 B4-B3
AX2 55
NZ X2,GRB3
SA2 B4+1 . SF TYPE FOUND IN STACK
RJ GRBLINK
GE B3,B0,GRB3 . LAST WAS NOT CHANGED
MX1 42
SA2 B4+1
SX7 A1
LX1 18 . UPDATE LAST IF CHANGED
LX7 18
BX2 X1*X2
BX7 X2+X7
SA7 A2
RJ GRBFW
EQ GRB3
GRB4 SB4 B4-1 . PROCEDURE CALL FOUND IN STACK
SB2 B4-B3 . SCAN STACKED FORMAL PARAMETERS
SB2 B2+2 . NOTE THAT STACKED ADDRESSES WILL
RJ GRBSCAN . BE SKIPPED OVER IN CRBSCAN
SA2 B4+1
SB3 X2
SB4 A2-B3
EQ GRB3
GRB2 SA2 MINSTAT . SCAN STATIC TO UPDATE
SB2 X2 . LIST DESCRIPTORS
SB4 B0-B2
RJ GRBSCAN . NO RETURN
*
* GRBFW SUPPLIES THE NEXT FREE LINK WHICH IS IN THE UPPER
* PART. GARBAGE COLLECTION ENDS WHEN THE END WORD IS MET.
* (I.E. THERE ARE NO MORE FREE WORDS IN UPPER Q.E.D.)
* LOCAL TO GRBCOLL
GRB5 SB7 X1+0 . NO, THIS IS NOT THE ENTRY
GRBFW NO
GRB6 SA1 B7 . NEXT FREE LINK
ZR X1,GRBCOLL . BRANCH IF ENDWORD
GE B7,B1,GRB5 . BRANCH IF IN UPPER
SB7 X1
EQ GRB6 . LOOP IF IN POWER
*
* THIS SUBROUTINE FOLLOWS A LIST STRUCTURE. IF A LINK IS
* IN LOWER, IT WILL BE RELOCATED.
* LOCAL TO GRBCOLL
GRBLINK NO
GRBL1 SB3 X2 . POINTER TO NEXT WORD
EQ B0,B3,GRBLINK . BRANCH IF END LIST
GRBL2 GE B3,B1,GRBL4 . BRANCH IF IN UPPER
SX7 A1
MX1 42
BX1 X1*X2 . UPDATE LINK AND RELOCATE
BX7 X1+X7
SA7 A2
SA2 B3
BX7 X2
SA7 A1
SA2 A7
SB3 X2
NE B0,B3,GRBL3 . IF END LIST THEN
SB3 -1 . SIGNAL LAST IS RELOCATED
EQ GRBLINK . AND RETURN
GRBL3 RJ GRBFW
EQ GRBL2
GRBL4 SA2 X2 . IN UPPER, GET NEXT WORD
EQ GRBL1
* LOCAL TO GRBCOLL
*
GRBSCAN NO
GRBS1 EQ B2,B4,GRBSCAN . END OF AREA
SA2 B2
PL X2,GRBS3 . BRANCH IF SVD
AX2 18
SX6 B2+1
SB2 X2+B2 . X2 IS BYPASS
AX2 37
SX2 X2+2 . BRANCH IF NOT VARIABLE OR
NG X2,GRBS1 . FUNCTION NAME
NZ X2,GRBS2
SA2 X6
BX1 X2
AX1 55
NZ X1,GRBS1 . IF PROCEDURE
RJ GRBLINK . UPDATE PROCEDURE DOPE
LT B3,B0,GRBS4
EQ GRBS1
GRBS2 SA2 X6 . IF VARIABLE
SB2 B2-1 . FETCH SVD
GRBS3 SB2 B2+1
BX1 X2 . SWITCH ON TYPE OF SVD
AX1 55
SX1 X1-2
ZR X1,GRBSS . SS TYPE
SX1 X1-2
NG X1,GRBS1 . SKIP OR SI TYPE
SX1 X1-3
NG X1,GRBSS . PS,PA OR PE
SX1 X1-1
ZR X1,GRBR . R TYPE
SX1 X1-5
NG X1,GRBS1 . A,D,N OR C
GRBIO RJ GRBSNGL . IN OR OUT, SVD IS IN DYNAMIC
. STORAGE TOO
GRBSS SX6 A2
RJ GRBLINK . UPDATE LIST
GE B3,B0,GRBS1
MX1 42 . CHANGE LAST IF CHANGED
SA2 X6
SX7 A1
LX1 18
LX7 18
BX2 X1*X2
BX7 X2+X7
SA7 A2
GRBS4 RJ GRBFW . GRBFW HAS TO BE CALLED WHENEVER
EQ GRBS1 . GRBLINK RETURNS A LAST CHANGED
. SIGNAL
GRBR RJ GRBSNGL . ACTION ON R TYPE
EQ GRBS1
*
* LOCAL TO GRBCOLL
*
GRBSNGL NO
+ SB3 X2
GE B3,B1,GRBSNGL . RETURN IF IN UPPER
SX7 A1
MX1 42
BX1 X1*X2 . RELOCATE AND UPDATE LINK
BX7 X1+X7
SA7 A2
SA2 B3
BX7 X2
SA7 A1
SA2 A1
RJ GRBFW
EQ GRBSNGL
TITLE MISCELLANEOUS SUBROUTINES
* ROUTINE MUST BE CALLED WITH AN INTEGER TOP OPERAND. IT
* WILL BE REMOVED AND REPLACED WITH A NORMALIZED STRING (S)
* X1,X2,X3,X4,X6,X7,B1
*
ITOS NO
+ SA0 10 . RESERVE FOR WORST CASE, TEN
RJ RESERVE . DIGITS AND A SIGN
SA1 B6-11 . B6 HAS BEEN INCREASED
RJ ICX1X6 . CONVERT INTEGER TO STRING
MX2 54 . MASK 1 CHAR LONG
SB1 A1
NG X7,ITOS1 . IF THE NUMBER WAS NEGATIVE
SB6 B6-1 . FIRST CHAR IS A -
EQ ITOS3 .
ITOS1 SX7 1R-
ITOS2 SA7 B1 . LOOP, STORE NEXT CHAR
SB1 B1+1
ITOS3 LX6 6 . UNPACK NEXT CHAR
BX7 -X2*X6 . LOOP IF NOT ZERO
ZR X7,ITOS4 . OR ELEVENTH DIGIT
NE B1,B6,ITOS2
ITOS4 SX1 A1-B1 . -(BYPASS LENGTH-1) TO X1
SB6 B1 . STACK TOP
SX1 X1-1
SX7 STY
LX7 55
BX1 -X1
BX7 X1+X7
SA7 B6 . S TYPE HEADING
EQ ITOS
* THIS ROUTINE BREAKS DOWN A STRING OF LENGTH B5 INTO
* CHARACTERS. THE LAST CHARACTER, IF ANY, WILL BE STORED AT B6-1
* XT IS THE ADDRESS OF THE FIRST WORD ON ENTRY.
* X0,X1,X2,X3,X7,B5
*
SSTOS1 SA2 X1 .NO,THIS IS NOT THE ENTRY
SX1 X2 . LINK TO NEXT WORD
BX2 X0*X2 . MASK LINK OFF, THIS WILL PRODUCE
SSTOS2 LX2 6 . A ZERO CHARACTER AT THE
BX7 -X3*X2 . END OF THE WORD
ZR X7,SSTOS1
SA7 B6-B5
SB5 B5-1 . DECREASE LENGTH
SSTOS3 NE B5,B0,SSTOS2 . GO BACK IF NOT ZERO
*
SSTOS NO .ENTER HERE
+ MX0 42 . SET UP MASKS
MX3 54
NE B5,B0,SSTOS1
EQ SSTOS
* THE FOLLOWING SUBROUTINE ASSIGNS A STRING TO A LIST
* STRUCTURE. B2 POINTS TO THE FIRST, B3 TO THE LAST CHARACTER
* UPON ENTRY. THE SVD OF THE CREATED STRUCTURE WILL BE PUT
* INTO XG
* X0,X1,X2,X6,B2,B3,B1
*
STOSFX6 NO
+ SB2 B2-1
SX1 B7 . FIRST IN LIST
LX1 24
SX6 B3-B2 . STRING LENGTH
BX0 X1+X6
EQ STOSF3
STOSF1 SX6 B0+0
SB1 42
STOSF2 EQ B2,B3,STOSF5 . ASSEMBLE SEVEN CHARACTERS
SB2 B2+1 . LEFT JUSTIFIED ZERO FILL
LX6 6
SA2 B2
BX6 X6+X2
SB1 B1-6
NE B1,B0,STOSF2
EQ B2,B3,STOSF5
LX6 18
BX6 X1+X6 . ADD A POINTER TO THE WORD
SA6 B7 . AND STORE IT
SB7 X1
STOSF3 SA1 B7+0 . GET NEXT FREE WORD
NZ X1,STOSF4
RJ MORFREE . END OF FREE CHAIN HAS BEEN MET
STOSF4 SX1 X1
EQ STOSF1
STOSF5 LX6 18
LX6 B1,X6 . LEFT JUSTIFY LAST WORD
SA6 B7
SB7 X1
LX0 36
SX6 A6
LX6 18
BX6 X0+X6 . FORM SVD IN X6
EQ STOSFX6 . AND RETURN
* WHEN CALLING THIS SUBROUTINE, X4 MUST POINT TO A CELL WHERE
* A P TYPE SVD CAN BE FOUND. THE PATTERN WILL BE LOADED TO THE
* STACK FROM B6 TOWARD THE HIGH CORE. B6 WILL BE INCREASED
* TO POINT TO THE END WHILE THE ORIGINAL VALUE IS SAVED IN B3
* X1,X2,X4,X7,B3,B2,A0
*
PTOPX4 NO
PTOP1 SA1 X4 . TAKE SVD AFRESH
SB3 B6
SA2 MAXSTAK
SB2 X2
MX0 12
PTOP2 SA2 X1 . NEXT WORD IN LIST
SX1 X2
SB6 B6+1
LT B2,B6,PTOP3 . OUT OF SPACE, WE ARE IN TROUBLE
BX7 X2
AX2 18
BX7 X7*X0
SX2 X2 . CONVERT PATTERN WORD INTO
BX7 X7+X2 . PM OPERATION FORMAT (UNPACKABLE)
SA7 B6
NZ X1,PTOP2 . LOOP IF NOT END OF LIST
EQ PTOPX4
PTOP3 SB6 B6+BUFF3 . WE DO NOT HAVE ANY INFORMATION
SA0 B6-B3
RJ GETSTAK . HOW LONG THE PATTERN WILL BE, SO
SB6 B3 . WE REQUEST A REASONABLE AMOUNT
EQ PTOP1 . AND TRY AGAIN. NOTE THAT THE LIST
. STRUCTURE MIGHT HAVE CHANGED.
*
*
*
* ROUTINE TO CONVERT AN INTEGER IN X1 INTO A DISPLAY CODED
* STRING IN X6. THE RESULT IS THE ABS VALUE LEFT JUSTIFIED
* WITH ZERO FILL.
* X1,X2,X3,X6,X7,B1
*
ICX1X6 NO
+ BX7 X1 . SAVE OLD SIGN
PL X1,IC1 .
BX1 -X1 . ABS VALUE
IC1 BX6 X6-X6 . INITIALIZE RESULT
SA2 TEN
PX1 X1
IC2 FX3 X1/X2 . LOOP, X3 IS THE NUMBER
UX3 B3,X3 . LESS THE LAST DIGIT
LX3 B3,X3
PX4 X3
NX4 X4
FX4 X4*X2
FX4 X1-X4
UX4 B3,X4
LX4 B3,X4
SX4 X4+1R0
BX6 X6+X4
LX6 54
PX1 X3
SX0 X0+1 . COUNT NUMBER OF DIGITS
NZ X3,IC2 . LOOP IF THERE ARE MORE DIGITS
EQ ICX1X6
TEN DATA 10.0
*
* X1,X2
ZROX7 NO
+ SA1 B7
BX7 X7-X7
NZ X1,ZROX7A
RJ MORFREE
ZROX7A SA7 A1 . CREATE A NULL STRING VALUE
SB7 X1 . AND RETURN ITS SVD IN X7
SX1 A1
SX7 A1
LX1 18
BX1 X1+X7
SX7 SSTY
LX7 55
BX7 X1+X7
EQ ZROX7
* X0,X1,X2,X6,X7
*
SSTOSF NO
+ MX0 18
SX6 B7
LX0 54
BX0 X2*X0 . LENGTH AND FIRST TO X6
BX6 X0+X6
MX0 42
EQ SSTOSF2
SSTOSF1 SA2 X2 . NEXT WORD IN SS
BX7 X0*X2
SX2 X2
SB7 X1
ZR X2,SSTOSF3 . BRANCH IF END LIST
BX7 X7+X1
SA7 A1
SSTOSF2 SA1 B7 . NEXT FREE WORD TO X1
ZR X1,SSTOSF4 . BRANCH IF
SX1 X1
EQ SSTOSF1
SSTOSF3 SX1 A1
SA7 A1
LX1 18
BX6 X6+X1
EQ SSTOSF
SSTOSF4 RJ MORFREE
SX1 X1
EQ SSTOSF1
*
ITOSF4 SX4 A1
SA6 A1 . STORE LAST WORD
LX4 18
BX6 X7+X4 . ADD LWA TO THE SVD
ITOSF DATA 0 . ENTRY POINT
BX0 X0-X0 . INITIALIZE CHARACTER COUNT
RJ ICX1X6 . CONVERT INTEGER INTO DISPLAY
BX3 X3-X3 . INITIALIZE SIGN TO POSITIVE
MX2 54
SX1 B7+0 . FIRST FOR SVD
PL X7,ITOSF1 . BRANCH IF POSITIVE
SX4 1R-
BX3 -X2*X6 . 10TH DIGIT MAY OVERFLOW TO X3
BX6 X6*X2
LX4 54
LX6 54
LX3 36
BX6 X6+X4 . INSERT - SIGN
SX0 X0+1 . BUMP CHARACTER COUNT
ITOSF1 SB3 X0-7
LX0 36 . ADD NUMBER OF CHARACTERS TO SVD
BX7 X1+X0 .
ITOSF2 SA1 B7+0 . GET A FREE WORD
NZ X1,ITOSF3
RJ MORFREE
ITOSF3 SB7 X1
SX1 X1
GE B0,B3,ITOSF4 . BRANCH IF THE NUMBER FITS INTO A
MX0 42 . SINGLE WORD
BX2 -X0*X6 . OTHERWISE STORE THE FIRST SEVEN
BX6 X0*X6 . CHARACTERS
BX6 X6+X1 . AND REPEAT THE LOOP WITH THE
SA6 A1 . REMAINING ONES
LX2 42
BX6 X2+X3
SB3 B0-B3 . MAKE B3 NEGATIVE (ZERO IS OK)
EQ ITOSF2
ITOSFTP SA1 B6-1 . CONVERT TOP ENTRY IN
RJ ITOSF . STACK FROM I TO SF
SX7 2
SA6 B6-1
SA7 B6
JP B1
*
HALF DATA 0.5
ONE DATA 1.0
TENTO13 DATA 1.0E13
*
RTOSF0 ZR B5,RTOSF02 . STORE WORD
SB5 B5-6
RTOSF01 LX6 6
BX6 X0+X6
SA0 A0+1 . CHARACTER COUNT
JP B4
RTOSF02 LX6 18
SB5 36
SA1 B7
NZ X1,RTOSF03
RJ MORFREE
RTOSF03 SX1 X1
SB7 X1
BX6 X1+X6
SA6 A1
BX6 X6-X6
EQ RTOSF01
RTOSF DATA 0 . REAL IN X1 TO SVD IN X6
SX7 B7 . START OF FREE CHAIN
SA2 MINSTAT
BX6 X6-X6 . X6 WILL BE CHARACTER BUFFER
SA7 X2+XWDREL
SB5 42 . BIT COUNT FOR XHARACTER BUFFER
SA0 B0 . CHARACTER COUNT
SB2 B0 . SCALE FACTOR
NX4 X1
SB3 13 . SIGNIFICANT DIGIT COUNT
ZR X4,RTOSF6 . ZERO IS ALREADY NORMALIZED.
PL X1,RTOSF1
SX0 1R-
BX4 -X4
SB4 RTOSF1
EQ RTOSF0 . OUTPUT MINUS SIGN
RTOSF1 SA2 ONE
SA1 ONETENTH
SA3 TEN
RTOSF2 FX0 X4-X2
NG X0,RTOSF3 . R < 1.0
RX4 X4/X3
SB2 B2+1
EQ RTOSF2
RTOSF3 FX0 X4-X1
PL X0,RTOSF4
RX4 X3*X4
SB2 B2-1
EQ RTOSF3
RTOSF4 SA1 TENTO13
RX5 X4*X1
SA4 HALF
FX4 X4+X5
UX4 B1,X4
LX4 B1,X4
PX4 X4
NX4 X4
RX4 X4/X1
FX1 X4-X2
NG X1,RTOSF45
RX4 X4/X3
SB2 B2+1
RTOSF45 LE B2,B0,RTOSF6 . R WAS < 1.0
SB4 RTOSF5
RTOSF5 ZR B2,RTOSF8 . INTEGER PART CONVERTED
SB2 B2-1
SB3 B3-1
NG B3,RTOSF7 . OUTPUT A ZERO
FX5 X4*X3 . R*10.0
UX0 X5,B1
LX0 X0,B1
PX7 X0
SX0 X0+1R0
NX7 X7
FX4 X5-X7
NX4 X4
EQ RTOSF0 . OUTPUT DIGIT
RTOSF6 SB4 RTOSF8
RTOSF7 SX0 1R0
EQ RTOSF0
RTOSF8 SX0 1R.
SB4 RTOSF9
EQ RTOSF0
RTOSF9 SB2 B2+1
LE B2,B0,RTOSF7 . OUTPUT A ZERO
LE B3,B0,RTOSF10 . FINISHED
SB3 B3-1
FX5 X4*X3 . R*10.0
UX0 X5,B1
LX0 X0,B1
PX7 X0
SX0 X0+1R0
NX7 X7
FX4 X5-X7
NX4 X4
NZ X4,RTOSF0 . FINISHED
SB4 RTOSF10
EQ RTOSF0
RTOSF10 SA2 MINSTAT
ZR X6,RTOSF12 . NO CHARS TO STORE
SB5 B5+18
LX6 B5,X6
SA1 B7
NZ X1,RTOSF11
RJ MORFREE
RTOSF11 SA6 A1+0
SB7 X1+0
RTOSF12 SA1 X2+XWDREL . FWA
SX6 A6 . LWA
LX6 18
BX6 X1+X6
SX5 A0 . CHAR COUNT
LX5 36
BX6 X5+X6
BX7 X7-X7
SA7 A1 . ZERO XWDREL
EQ RTOSF . RETURN
TITLE OPERAND TO THE TOP OF THE STACK
X1VALUE SX4 X1+0
SX6 X1+0
SB1 SNDMIC
SA6 UA . SAVE ADDRESS FOR PMCHEK
* RETURN IS IN B1
SOPERND SA1 X4 . SVD OF OPERAND TO X1
SA2 OPRNDWD . SWITCH ON TYPE (CF. CHEK)
BX3 X1
AX1 55
LX1 2
SB4 X1
MX0 56
AX2 B4,X2
BX2 -X0*X2
SB3 X2+0
JP B3+OPRNDSW
*
OPRNDWD SWITCH OPRNDSW,0,0,1,1,4,4,4,2,7,0,0,0,0,5,6
*
+ MX0 5 . 0, A,D,N,C
BX6 X3
EQ OPRNDR1
+ MX0 5 . 1, SS,SI
BX6 X4
EQ OPRNDR1
+ MX0 5 . 2, I
BX6 X3
LX6 6 . EXTEND THE SIGN
AX6 6
EQ OPRNDR1
+ MX0 5 . 4, PS,PE,PA
BX6 X0*X3
EQ OPRNDP
+ SA0 B1 . 5, IN
BX5 X4
EQ OPRNDIN
+ EQ OPRNDOT . 6, OUT
+ SA1 X3+0 . 7, R
MX0 5
BX6 X1
OPRNDR1 SA0 2 . RESERVE 2 LOCATIONS IN THE STACK
RJ RESERVE
OPRNDR2 SX2 A0
BX7 X0*X3 . HEADING TO X7
SA6 B6-1 . STORE SECONDARY WORD FROM X6
BX7 X7+X2
SA7 B6
JP B1+0 . RETURN
*
OPRNDP AX3 36 . PATTERN TYPE OPERAND
SX3 X3 . PARAMETER TO X3
RJ PTOPX4 . LOAD PATTERN TO THE STACK
LX3 18
SA0 1 . RESERVE ONE WORD FOR HEADING
BX6 X6+X3 . FORM HEADING IN X6 AND X3
SB3 A0-B3 . B3 GOT ITS VALUE IN PTOPX4
SX3 B6+B3
RJ RESERVE
BX6 X6+X3
SA6 B6 . STORE HEADING
JP B1+0 . RETURN
*
OPRNDIN RJ FREESVD . OPERAND INPUT ASSOCIATED
SB3 X5
RJ INPUT . CALL INPUT
SX4 X5+0
SB1 A0+0 . RESTORE REGISTERS
OPRNDOT SA0 2 . ALSO FOR OUTPUT
RJ RESERVE
SA1 X4 . MAKE A COPY OF THE RESULTING
SA2 X1 . STRING AND USE ITS SF TYPE
RJ SSTOSF . DESCRIPTION INSTEAD
BX3 X3-X3
EQ OPRNDR2
TITLE ASSIGNMENT TO A SIMPLE VARIABLE
* X0,X1,X2,X3,X4,X7,B3,B4,X6 IF IO
*
FREESVD NO
+ SA1 X3 . SVD TO BE FREED TO X1
SA2 FSVDWD
MX0 56
ZR X1,FREESVD . RETURN IF EMPTY
BX4 X1 . SWITCH ON TYPE (CF. CHEK)
AX1 55
LX1 2
SB4 X1
AX2 B4,X2
BX2 -X0*X2
SB3 X2
JP B3+FSVDSW
*
FSVDWD SWITCH FSVDSW,0,0,3,0,3,3,3,1,0,1,1,1,1,2,2
*
+ SX7 B7 . 0, R
SB7 X4
SA7 X4+0
+ EQ FREESVD . 1, N,A,D,C
+ SB4 B0-B4 . 2, IN,OUT
SA4 X4+0
+ SX7 B7 . 3, SS,PS,PE,PA
SB7 X4
AX4 18
SA7 X4
EQ FREESVD
*
*
SASSIGN NO
+ MX0 56
SA1 B2 . FETCH HEADING OF THE VALUE
SA2 SASGNWD . TO BE ASSIGNED
BX4 X1 . SWITCH ON ITS TYPE
AX1 55
LX1 2
SB3 X1
AX2 B3,X2
BX2 -X0*X2
SB3 X2
JP B3+SASGNSW
*
SASGNWD SWITCH SASGNSW,4,0,1,12,11,11,11,6,14,9,9,9,9,0,0
*
+ SB3 X4 . 0, S
SB3 B2-B3
EQ SASGNS
SA4 B2-1 . 1, SS
SA2 X4+0
RJ SSTOSF
SA1 MXLNGTH
EQ SASGNSF
+ SA2 B2-1 . 4, SF
SA1 MXLNGTH
BX6 X2
EQ SASGNSF
+ SX2 ITY . 6, I
SA1 B2-1
SASGNI1 LX2 55
MX0 6
BX1 -X0*X1
BX6 X1+X2
EQ SASGN2
+ SA1 B2-1 . 9, A,D,N,C
BX6 X1
EQ SASGN2
+ EQ SASGNP . 11, P
+ SA4 B2-1 12, SI
SA1 X4+1
SX2 ITY
EQ SASGNI1
+ SA2 B2-1 14, R
SA1 B7
BX6 X2
NZ X1,SASGNR1 . GET A FREE WORD AND STORE
RJ MORFREE . THE REAL VALUE THERE
SASGNR1 SB7 X1+0
SA6 A1+0
SX7 A1-2
IX6 X7+X4
SASGN2 RJ FREESVD . COMMON PART, NEW DESCR. IS IN X6
LT B4,B0,SASGNIO . BRANCH IF IO ASSOCIATED
*
* TRACER CODE MAY BE INSERTED HERE
*
SA6 X3+0 . PERFORM ACTUAL ASSIGNMENT
EQ SASSIGN . AND RETURN
*
SASGNIO SA1 X3 . I/O ASSOCIATED
SB4 B4+INTY*4
SA6 X1 . PERFORM ASSIGNMENT
*
* TRACER CODE HERE TOO
*
TRACER2 EQ B0,B4,SASSIGN . READY IF INPUT
BX1 X6 . TEST TYPE TO BE OUTPUT
AX6 55
SX6 X6-SSTY . CHECK FOR STRING TYPE
NZ X6,SASGNO1
SASGNO2 SB3 X3
RJ OUTPUT . CALL OUTPUT
EQ SASSIGN . AND RETURN
*
SASGNO1 SB4 X3 . TEST TYPE TO BE OUTPUT
LX1 6 . MASK VALUE PART OFF
SX7 X6-ITY+SSTY
NZ X7,ERR52 . ERROR IF NOT INTEGER
SB2 A6 . SAVE X3,A6
AX1 6 . EXTEND THE SIGN
RJ ITOSF . CONVERT IT INTO STRING
SX0 SSTY
LX0 55
SX3 B4
BX6 X6+X0 . STORE SS TYPE RESULT
SA6 B2
EQ SASGNO2 . GO AND OUTPUT IT
*
SASGNS SB2 B2-1 . PROCESS S TYPE
SB3 B3+1 . BY CONVERTING IT INTO SF FORM
RJ STOSFX6
SASGNSF BX7 X6 . PROCESS SF TYPE
AX6 36 . LENGTH OF STRING TO X6
SX0 SSTY
IX1 X1-X6
LX0 55
BX6 X0+X7 . ADD SS TYPE TO DESCRIPTION
PL X1,SASGN2 . GO TO ASSIGN IT
EQ ERR18 . ERROR IF STRING IS TOO LONG
*
SASGNP MX0 5 . PROCESS P TYPE
SB3 X4
SX1 B7 . FIRST
BX7 X0*X4
MX0 42
AX4 18 . PARAMETER OF PA
SB3 B2-B3
BX7 X7+X1 . PACK FIRST AND TYPE TO X7
BX4 -X0*X4
SB3 B3+1
LX4 36
SASGNP1 SA1 B7+0 . GET NEXT FREE WORD
NZ X1,SASGNP2
RJ MORFREE
SASGNP2 SA2 B3 . FETCH PATTER WORD
BX6 X2
LX2 18
BX6 X6+X2 . SHIFT ADDRESS 18 BITS TO THE LEFT
BX6 X6*X0 . TO MAKE SPACE FOR LINK
SB3 B3+1
EQ B2,B3,SASGNP3 . END LOOP
SX1 X1
SB7 X1
BX6 X6+X1 . ADD LINK TO THE WORD
SA6 A1 . AND STORE
EQ SASGNP1
SASGNP3 SA6 A1 . STORE LAST WORD WITH 0 LINK
SB7 X1
SX1 A1
BX7 X7+X4
LX1 18 . PACK PA PARAMETER AND LAST
BX6 X7+X1 . INTO THE DESCRIPTOR
EQ SASGN2 . GO TO ASSIGN IT
*
TITLE INDIRECT SEARCH
*
INDRCT NO
+ SA2 INDCWD . SWITCH ON THE TYPE OF TOPOPERAND
SB3 INDCSW
EQ CHEK
*
INDCWD SWITCH INDCSW,5,4,6,6,0,0,0,3,0,0,0,1,0,0,0
*
+ ERROR 33 . 0, P,A,D,C,R
+ SA1 B6-1 . 1, N
SB6 B6-2 . RETURN NAME AND REMOVE TOPOPERAND
SX1 X1
EQ INDRCT
+ RJ ITOS . 3, I
+ RJ SCATS . 4, S
+ SA4 B6-1 . 5, SF
EQ INDR1
+ SA4 B6-1 . 6, SS,SI
SA4 X4+0
INDR1 SX0 VARTYP . SET UP SEARCH CALL FOR A VARIABLE
RJ INDRX
NE B3,B0,INDR8
RJ ZROX7 . ASSIGN NULL VALUE
SX1 X3+1 . IF NEW VARIABLE
SA7 X3+1
INDR8 SB6 B6-2
NE B4,B0,INDRCT . END IF NOT SF
SX7 B7
SB7 X4
AX4 18
SA7 X4
EQ INDRCT
*
*
INDRX NO
+ BX1 X4
SB5 X4
AX1 36
LX0 55
SB3 X1+0 . LENGTH TO B3
EQ B3,B0,ERR27 . ERROR IF NULL STRING
RJ SEARCH
NZ X1,INDRX . BRANCH IF FOUND
SA3 FLSIX . (NO. OF CHARACTERS/WORD) - 1, =6.0
SX5 B3
PX1 X5
FX1 X1+X3
SA3 SEVEN . =7.0
FX1 X1/X3
UX6 X1,B2
SA3 MAXSTAT
LX6 X6,B2
BX7 X3+X2 . NUMBER OF TEXT WORDS+MAXSTAT TO X7
SA7 A2
IX7 X6+X3
INDR2 SA4 MINSTAK
SX7 X7+2 . ALLOW FOR BYPASS WORD AND SVD
IX4 X7-X4
SA7 A3 . STORE NEW MAXSTAT
NG X4,INDR3 . BRANCH IF THERE IS ENOUGH ROOM
SB3 X4+BUFF4 . ROUND UP APPETITE
RJ PUSHSTK . MAKE ROOM IN STATIC
INDR3 SA4 B6-1 . FETCH OPERAND AFRESH
EQ B4,B0,INDR5 . BYPASS IF SF
SA4 X4
INDR5 SX1 X3+3
SX6 X4
LX5 36 . SHIFT STRING LENGT8 FOR HEADING
INDR6 SA2 X6 . NEXT WORD
SX6 X2+0
BX7 X2-X6
ZR X6,INDR7 . END OF LIST
BX7 X7+X1
SA7 X1-1 . STORE WORD IN STATIC
SX1 X1+1
EQ INDR6
INDR7 BX6 X0+X5 . HEADING FOR VARIABLE-TYPE RECORD
SA7 X1-1 . STORE LAST WORD
IX7 X1-X3
LX7 18
BX6 X6+X7
SX1 X3+1
SA6 X3 . STORE HEADING
SB3 B0 . INDICATE NEW RECORD IN B3
EQ INDRX
*
SEVEN DATA 7.0 . NUMBER OF CHARACTERS IN A WORD
FLSIX DATA 6.0
TITLE SEARCH ROUTINE
* X0,X1,X2,X3,X6,X7,B2,B3,B5
*
SEARCH NO
+ MX7 42 . X7 IS A MASK AND A FLAG
BX2 X2-X2
SB2 B5
MX6 2
LX6 58
BX6 X0*X6 . BYPASS IF TYPE IS NOT INTEGER
NZ X6,SEARCH1 . OR REAL CONSTANT
SA2 B5
MX7 12
BX2 -X7*X2 . MASK 48 BITS OFF
BX7 X7-X7 . SET FLAG
EQ SEARCH2
SEARCH1 SA1 B2 . OTHERWISE EXOR THE WORDS IN
SB2 X1+0 . THE NAME TOGETHER
BX2 X2-X1
NE B2,B0,SEARCH1
BX2 X2*X7 . AND MASK 42 BITS OFF
LX2 42
SEARCH2 SA3 HASHLWD . THE HASH FUNCTION IS A SIMPLE
PX2 X2 . INTEGER DIVISION
FX1 X2/X3
UX1 X1,B2
LX1 X1,B2
PX1 X1
NX1 X1
FX3 X1*X3
FX2 X2-X3
UX2 X2,B2
LX2 X2,B2 . HASHTABLE INDEX IS IN X2
MX6 5 . START OF THE CHAIN OF NAMES WITH
SA2 X2+HASHTBL . THIS HASHCODE TO X1
SEARCH3 SX1 X2 . SEARCH LOOP
ZR X1,SEARCH . END OF THE CHAIN RETURN NOT FOUND
SA2 X1
BX3 X2
AX3 36
SB2 X3 . CHECK LENGTH OF NAME
NE B2,B3,SEARCH3
BX3 X0-X2
BX3 X3*X6 . CHECK TYPE
NZ X3,SEARCH3
SB2 A2+2
PL X7,SEARCH5 . BYPASS IF INTEGER OR REAL CONST.
SX1 B5
SEARCH4 SX1 X1
ZR X1,SEARCH3 . END OF THE NAME
SA3 B2
SA1 X1 . NEXT WORD IN NAME
SB2 X3
BX3 X1-X3
BX3 X3*X7 . COMPARE THE CHARACTERS ONLY
NZ X3,SEARCH3
NE B0,B2,SEARCH4 . THERE ARE MORE WORDS
SX1 X1
NZ X1,SEARCH3
SEARCH6 SX1 A2+1 . RETURN FOUND
EQ SEARCH
SEARCH5 SA1 B5 . FOR CONSTANTS COMPARE VALUES
SA3 B2
BX3 X1-X3
NZ X3,SEARCH3
EQ SEARCH6
TITLE PATTERN MATCHING
ENTERA NO
+ SX0 X5+0 . THE NEXT ELEMENT IS THE ELEMENT
SA2 ENTERA . AFTER THE ALTERNATIVE
NG X0,ENTER1
SB4 X0+0
EQ ENTER1
*
ENTER NO . RECURSIVE CALL
+ NO
SA2 ENTER
ENTER1 SB6 B6+4
LT B5,B6,PMBUMP . BRANCH IF THERE IS NO SPACE
PMBUMPR BX6 X2 . STORE X5,X4,THE RETURN JUMP
SA7 B6-1 . AND X7 IN THE STACK
SA6 B6
BX6 X4
BX7 X5
SA6 B6-3
SA7 B6-2
SA5 PIB
SX2 B1+0
LX5 18
BX5 X2+X5
MX0 1
LX5 18
BX5 X5+X0
*
NEXT SX0 1 . SET NO ALTERNATIVE
LX0 17
BX5 X0+X5
NEXT1 SA1 B4 . NEXT PM OPERATION TO X1
ID X1,YDOL . IGNORE DOLPM OR PRDPM
UX1 X1,B2
JP B2+YSTAR
*
PMBUMP SX0 SSTY . STORE AN S TYPE DESCRIPTION OF
SA1 MINSTAT . STACKS S AND P IN STATIC SUCH
LX0 55 . THAT THE GARBAGE COLLECTION
BX6 X3+X0 . WILL BE ABLE TO CHANGE THEM.
SA6 X1+SIXREL
BX6 X5
SA6 SKMRAR5
SA5 PMA5 . RESTORE A5 FOR ERRORMESSAGE
SA5 X5+0
SA3 PIX
BX6 X3+X0
SX3 A0
SA6 X1+PIXREL
SB2 B3+1 . DESCRIBE IN A0 WHERE THE LAST
SA0 B6-B2 . NORMAL STACK ENTRY CAN BE FOUND
RJ GETSTAK
SA1 MAXSTAK
SA0 X3
SB5 X1
SA1 MINSTAT
SA3 X1+PIXREL . CLEAR USED LOCATIONS
SX6 X3
SA1 X1+SIXREL
SA6 PIX . RESTORE STACK POINTERS
SX3 X1
BX6 X6-X6
SA6 A3
SA6 A1
SA5 SKMRAR5
EQ PMBUMPR
SKMRAR5 BSSZ 1
*
ALTLFM SA1 LENFAIL
BX5 -X1*X5
EQ ALTLF
ALT MX0 1 . ALTERNATE WITHOUT LENGTH FAILURE
BX5 -X0*X5
ALTLF SX7 NEXT . SIGN BIT IN X5 IS ONE IFF ALL
SX1 X5 . ALTERNATIVES LENGTH FAILED
PL X1,SETSIPI
MX0 1
BX6 -X5*X0
SA6 LENFAIL
EQ EXIT
*
SETSIPI SA1 PIB . OPEN SUBROUTINE TO RESET S AND P
ZR X1,ALTLF5
SA2 PIX . STACK POINTERS
SB2 X1+0 . THESE STACKS CONSTITUTE TWO LIST
LX5 24 . STRUCTURES
SX1 X5+0
LX5 36
ALTLF1 SX0 B0-B2 . RESET STACK P
IX0 X0+X1
ZR X0,ALTLF2
SA2 X2
SX6 B7 . LINK FREED WORD TO THE FREE CHAIN
SB7 A2
SA6 A2
SB2 B2-1 . B2 IS THE NUMBER OF WORDS IN
EQ ALTLF1 . STACK P
ALTLF2 SX6 X1+0
SA6 A1+0 . STORE B2 IN PIB
SX6 X2
SA6 PIX
ALTLF5 LX5 42
SX1 X5+0
LX5 18
ALTLF3 SB2 B0-B1 . RESET STACKS
SB2 X1+B2
EQ B0,B2,ALTLF4
SA3 X3
SX6 B7 . AS ABOVE
SB7 A3
SA6 A3
SB1 B1-1 . B1 IS RESERVED FOR THE NUMBER OF
EQ ALTLF3 . WORDS IN STACK S
ALTLF4 SX3 X3
SB2 X7
JP B2
*
YENDEX NZ X1,PMFOUND . FOUND IF OUERMOST END
SB4 B4+1
SA2 X3
BX6 X2
AX2 36
SB2 X2
ZR X2,YENDEX1 . UNLESS ARBNO CALLED
SA1 B4
SX2 A0
DF X1,YENDEX1 . PERFORM ASSIGNMENTS
RJ ASSIGNS
YENDEX1 SX7 B7 . REMOVE TOP ELEMENT FROM
SB7 X3 . STACK S
SX3 X6
SA7 B7
AX6 18
SB1 B1-1
SA1 X6-1
UX1 X1,B2
SB4 X6
NE B2,B0,YENDEX2 . IF STAR CALLED
BX2 X6
AX2 18
SB2 X2
SX2 A0
RJ ASSIGNS
YENDEX2 SX7 B4 . SAVE WORD FROM STACK S IN X4
BX4 X6 .
SX0 A0
LX7 18
BX7 X0+X7
SB4 X6
RJ ENTER . RECURSIVE CALL
BX6 X4
LX6 18
SA1 B7
BX6 X6+X3 . RESTORE X4 INTO STACK S
NZ X1,YENDEX3
RJ MORFREE
YENDEX3 SA6 B7
SB7 X1
SB1 B1+1
SX3 A6
EQ EXIT
YALTER SX1 X1+B4 . PACK ADDRESS OF ALTERNATIVE
MX0 42 . INTO X5
BX5 X5*X0
BX5 X5+X1
YDOL SB4 B4+1 . NEXT OPERATION
EQ NEXT1
*
YEXP SX6 B4+1 . BEGIN EXPRESSION
SB4 X1+B4
SB1 B1+1
SB2 YEXPR
POPS SA1 B7 . STACK INDEX AND POS IN STACK S
SX7 A0 . (OPEN SUBROUTINE IS USED BY
SX2 X5 . YSTAR AS WELL)
LX7 18
NZ X1,POPS1
RJ MORFREE
POPS1 PL X2,POPS2
SX2 B4+0
POPS2 BX7 X7+X2
SB7 X1
LX7 18
BX7 X7+X3
SA7 A1
JP B2
YEXPR SX3 A1
SX7 B4
SX0 A0 . SET UP CALL TO MATCH THE
LX7 18 . EXPRESSION
SB4 X6
BX7 X7+X0
RJ ENTER
EQ ALTLFM
*
YARB SB4 B4+1 . ARB PATTERN ELEMENT
SX4 A0
YARB1 SA1 B4
DF X1,YARB2
SX2 X4
SB2 A0
RJ ASSIGNS
YARB2 SX7 B4
SX0 A0
LX7 18
SA0 X4
BX7 X7+X0
RJ ENTERA . TRY TO MATCH THE REST OF THE
SA1 LENFAIL . PATTERN
SB2 X4+0 . EXTEND THE STRING MACHED
SX4 X4+1
LT B3,B2,ALT . TOO LONG
ZR X1,ALT
SX7 YARB1 . RESET STACKS AND TRY AGAIN
EQ SETSIPI
*
YLEN SB2 A0-1 . LEN PATTERN ELEMENT
SB4 B4+1
SB2 X1+B2
LT B3,B2,ALTLF . TOO LONG
SA1 B4+0
SX6 B2+1
DF X1,ENTERX6
SX2 X6
SB2 A0
EQ YTAB1 . GO TRY TO MATCH THE REST
*
YPOS SA2 SBASE . POS PATTERN ELEMENT
SB4 B4+1
YPOS1 SX7 A0-1
IX1 X1+X2 . CORE ADDRESS OF POSITION TO X1
IX1 X1-X7
NG X1,ALTLF . POS ALREADY LEFT BEHIND
NZ X1,ALT . POS NOT REACHED YET
SA1 B4
SX6 A0
DF X1,ENTERX6
SB2 A0
SX2 A0
EQ YTAB1 . GO TRY TO MATCH THE REST
*
YRPOS BX1 -X1 . RPOS PATTERN ELEMENT
SB4 B4+1
SX2 B3 . TRANSFORM INTO POS
EQ YPOS1
*
YTAB SA2 SBASE . TAB PATTERN ELEMENT
SB4 B4+1
YTAB2 IX1 X1+X2
SB2 A0
SX6 X1+1
SB2 B0-B2
SB2 X6+B2
LT B2,B0,ALTLF . TAB-STOP IS LEFT ALREADY
SB2 X1
SA1 B4+0
LT B3,B2,ALTLF
DF X1,ENTERX6
SB2 A0
BX2 X6
YTAB1 RJ ASSIGNS .
ENTERX6 SX7 B4 . TRY TO MATCH THE REST
SX1 A0
LX7 18
SA0 X6
BX7 X7+X1
RJ ENTERA
EQ ALTLFM . SEEK ALTERNATE IF MATCH FAILS
*
YRTAB BX1 -X1 . RTAB PATTERN ELEMENT
SX2 B3 . TRANSFORM INTO TAB
SB4 B4+1
EQ YTAB2
*
YREM SA1 B4+1 . REM PATTERN ELEMENT
SB4 B4+1
SX6 B3+1
DF X1,ENTERX6 . REST OF THE PATTERN WILL HAVE
SB2 A0 . TO MACH THE NULL STRING
BX2 X6
EQ YTAB1
*
YBAL SB4 B4+1 . BAL PATTERN ELEMENT
SX4 0
YBAL1 SX6 1R)
SX7 1R(
SB2 A0 . NOTE THAT BAL NEVER SIGNALS LENGTH
SB2 X4+B2 . FAILURE
LT B3,B2,ALT . SEEK ALTERNATIVE IF END OF STRING
SA1 B2
BX0 X1-X6
ZR X0,ALT . MISMATCH IF NEXT CHARACTER IS )
SX0 0 . X0 IS THE LEVEL COUNTER
YBAL2 SA1 B2
BX2 X1-X7
NZ X2,YBAL3
SX0 X0+1 . IF ( ADD ONE
EQ YBAL4
YBAL3 BX2 X1-X6
NZ X2,YBAL4
SX0 X0-1 . IF ) SUBTRACT ONE
YBAL4 SB2 B2+1
ZR X0,YBAL5 . LOOP UNTIL IT IS ZERO
LT B3,B2,ALT
EQ YBAL2
YBAL5 SX4 A0
SA1 B4
BX4 -X4 . NUMBER OF CHARACTERS SCANNED
SX4 X4+B2 . TO X4
SX6 B2
DF X1,YBAL6
BX2 X6
SB2 A0
RJ ASSIGNS
YBAL6 SX1 B4 . SET UP RECURSIVE CALL
SX7 A0
SA0 X6
LX1 18
BX7 X1+X7
RJ ENTERA . TRY TO MATCH THE REST OF THE
SX7 YBAL1 . PATTERN
EQ SETSIPI . IF FAILS GO TO EXTEND BAL
*
YFAIL SB4 B4+1 . FAIL PATTERN ELEMENT
EQ ALT . SEEK ALTERNATIVE
*
YFENCE SB4 B4+1 . FENCE PATTERN ELEMENT
SB2 A0
SX2 A0
RJ ASSIGNS . IF THE REST OF THE PATTERN DOES
RJ ENTERA . NOT MACH THEN
*
YABORT EQ PMABT . ABORT THE WHOLE PATTERN MATCH
*
YARBNO SX4 B4 . ARBNO PATTERN ELEMENT
SB4 X1+B4
SA2 X4+1
SX7 A0
SX6 X2
ZR X6,ALT . ALTERNATIVE IF NO HOPE TO MATCH
SX1 X6-MARK
NZ X1,YARBNO1
LX7 18 . HAS NOT BEEN CALLED YET RECURSI-
BX7 X2+X7 . VELY - INITIALIZE
BX2 X7
SA7 A2
YARBNO1 SA1 B4 . MATCH A NULL STRING FIRST
DF X1,YARBNO2
AX2 18
SB2 X2
SX2 A0
RJ ASSIGNS
YARBNO2 SB2 A0-1
SX1 X6-1
SX0 B3-B2
IX7 X1-X0 . SET HOPE TO THE NUMBER OF CHARAC-
SA2 X4+1 . TERS IN THE REST OF THE STRING
LX4 42 . OR HOPE - 1 WHICHEVER IS SMALLER
NG X7,YARBNO3
BX1 X0
YARBNO3 MX0 42
BX4 X4+X6
BX7 X0*X2
LX4 18
BX6 X7+X1 . SET UP RECURSIVE CALL
SA6 A2
SX7 B4
SX0 A0
LX7 18
BX7 X7+X0
RJ ENTERA . TRY TO MATCH THE REST OF THE
. STRING
SX7 YARBNO4
EQ SETSIPI
YARBNO4 SA1 B7
SX6 X4 . IF IT FAILS WE STACK A RETURN
LX6 18 . TO THIS ARBNO ELEMENT AND TRY
BX6 X6+X3 . TO MATCH THE ARGUMENT OF ARBNO
NZ X1,YARBNO5 . IF IT MATCHES WE RETURN TO A
RJ MORFREE . NEW INCARNATION OF ARBNO WHICH
YARBNO5 SB7 X1 . WILL MATCH A NULL STRING FIRST
SX3 A1 . ETC.
SA6 A1
SX7 B4
SB1 B1+1
SX0 A0+0
LX7 18
SB4 X4+2
BX7 X0+X7
RJ ENTER
YARBNO6 SA1 X4+1 . IF ALL THIS FAILS WE RESTORE
MX0 42 . THE HOPE AND GO TO SEEK AN
AX4 18 . ALTERNATIVE
BX1 X7*X0
BX7 X1+X4
SA7 A1+0
EQ ALT
*
YSTAR SA2 X1+0 . DEFERRED EVALUATION (*) OPERATOR
SB4 B4+1
YSTAR1 BX7 X2 . SVD OF ARGUMENT TO X7,X2
AX2 55
SX0 X2-SSTY . STRING
ZR X0,YSTARS
SX0 X2-PETY-1 . PATTERN PS,PA OR PE
NG X0,YSTARP
SX0 X2-INTY . INPUT ASSOCIATED
ZR X0,YSTARIN
SX0 X2-OUTTY . TYPE ERROR IF NOT OUTPUT
NZ X0,ERR24
SA2 X7+0 WILL THE REAL DESCRIPTOR PLEASE STAND UP
EQ YSTAR1
YSTARS SB2 A0-1 . TREATMENT OF A STRING IS
SX6 X7 . SIMILAR TO THE TREATMENT OF LIT
MX0 54
YSTARS1 ZR X6,YSTARS3 . MATCHES IF END OF STRING
SA1 X6+0
SX6 X1+0 . NEXT WORD TO X1
BX1 X1-X6
YSTAR2 LX1 6
BX4 -X0*X1
SB2 B2+1
ZR X4,YSTARS1 . NEXT CHARACTER TO X4
LT B3,B2,ALTLF . SEEK ALTERNATIVE IF NOT EQUAL
SA2 B2 . TO CORRESPONDING CHARACTER IN
BX2 X4-X2 . THE STRING
ZR X2,YSTAR2
EQ ALT
YSTARS3 SA1 B4
SX6 B2
DF X1,ENTERX6
BX2 X6 . TRY TO MACH THE REST OF THE STRING
SB2 A0
EQ YTAB1
YSTARIN BX6 X3 . IF INPUT ASSOCIATED
SX7 B1
SA6 PMSTX3
SA7 PMSTB1
SX6 B4 . SAVE REGISTERS
SX7 A2
SA6 PMSTB4
SA7 PMSTB3
SB3 A2
RJ INPUT . CALL INPUT
SA1 PMSTB1
SA2 PMSTB3
SA3 PMSTX3
SA4 PMSTB4 . RESTORE REGISTERS
SB1 X1
SB4 X4
SA1 MAXSTAK
SA4 SLENGTH
SB5 X1
SB3 X4
SA1 X2
EQ YSTARS . TREAT THE STRING JUST INPUT
*
YSTARP SA4 PCHAIN . THE ARGUMENT IS A PATTERN
SB2 A0-1
YSTARP1 SA2 X4
SX4 X2
AX2 18
BX2 X2-X1 . FIND IT
NZ X2,YSTARP1
SX4 A2+1
SX6 A2+2
SA1 X4
LX4 18
ZR X1,ALT . SEEK ALTERNATIVE IF NO HOPE TO
BX4 X4+X1 . MATCH
SB2 B2-B3
SX7 X1-1
SB1 B1+1 . SET HOPE TO THE NUMBER OF CHARAC-
SX0 X7+B2 . TERS IN THE REST OF THE STRING
NG X0,YSTARP2 . OR TO HOPE - 1 WHICHEVER IS
SX7 B0-B2 . SMALLER
YSTARP2 SB2 YSTARPR
SA7 A1+0
EQ POPS . STACK RETURN
YSTARPR SX3 A1 . (LIKE IN CASE OF EXP)
SX7 B4
SX0 A0
LX7 18
SB4 X6
BX7 X7+X0
RJ ENTER . TRY TO MATCH THE PATTERN IN TH
SX7 X4 . VARIABLE AND THE REST OF THIS
AX4 18 . PATTERN
SA7 X4+0
EQ ALTLFM . SEEK ALTERNATIVE IF IT FAILS
*
YLIT SB2 A0-2 . MATCH A LITERAL
SX7 B4+1
SB2 X1+B2
SB4 X1+B4
LT B3,B2,ALTLF . LITERAL TOO LONG
SB2 X1-2
SX6 A0+B2
SA4 B4 . LIT MAY USE X4
SX6 X6+1
LT B2,B0,YLIT2
YLIT1 SA1 A0+B2
SA2 X7+B2
SB2 B2-1
BX1 X1-X2
NZ X1,ALT . TRY ALTERNATIVE IF MISMATCH
GE B2,B0,YLIT1
YLIT2 DF X4,ENTERX6
SX2 X6
SB2 A0
RJ ASSIGNS
EQ ENTERX6
*
YANY SB2 A0 . ANY -PATTERN ELEMENT
SA2 A0
SB4 B4+X1
LT B3,B2,ALTLF . TOO SHORT
SB2 X1
SA4 B4
YANY1 SB2 B2-1 . FAIL IF NONE OF THE CHARACTERS
EQ B2,B0,ALT
SA1 B4-B2 . MATCHED
BX0 X1-X2
NZ X0,YANY1
YANY2 SX6 A0+1
DF X4,ENTERX6
SB2 A0
BX2 X6
EQ YTAB1
*
YNOTANY SB2 A0 . NOTANY-PATTERN ELEMENT
SA2 A0
SB4 B4+X1
LT B3,B2,ALTLF
SB2 X1
SA4 B4
YNOTAN1 SB2 B2-1
EQ B2,B0,YANY2
SA1 B4-B2
BX0 X1-X2 . FAIL IF ANY OF THE CHARACTERS
NZ X0,YNOTAN1
EQ ALT
*
YSPAN SB4 B4+X1 . SPAN PATTERN ELEMENT
BX7 X7-X7
BX6 X1
SA4 B4
YSPAN1 SB2 X6 . COUNT IN X7 HOW MANY CONSECUTIVE
SX1 A0 . ANY -ELEMENT WOULD MATCH
SX0 B3
IX1 X1+X7
SA2 X1
IX1 X0-X1
PL X1,YSPAN2 . END OF STRING IS REACHED
ZR X7,ALTLF
EQ YSPAN4
YSPAN2 SB2 B2-1
EQ B2,B0,YSPAN3
SA1 B4-B2
BX0 X1-X2
NZ X0,YSPAN2
SX7 X7+1
EQ YSPAN1
YSPAN3 ZR X7,ALT . FAIL IF NONE
YSPAN4 SX6 A0 . MATCH X7 CHARACTERS
IX6 X6+X7
DF X4,ENTERX6
SB2 A0
BX2 X6
EQ YTAB1
*
YBREAK SB4 B4+X1 . BREAK PATTERN ELEMENT
BX7 X7-X7
BX6 X1
SA4 B4
YBREAK1 SB2 X6 . COUNT IN X7 HOW MANY CONSECUTIVE
SX1 A0 . NOT ANY ELEMENTS WOULD MATCH
SX0 B3
IX1 X1+X7
SA2 X1
IX1 X0-X1
NG X1,ALTLF . END OF STRING IS REACHED
YBREAK2 SB2 B2-1
EQ B2,B0,YBREAK3
SA1 B4-B2
BX0 X1-X2
NZ X0,YBREAK2
EQ YSPAN4 . MATCH X7 CHARACTERS
YBREAK3 SX7 X7+1
EQ YBREAK1
*
EXIT SX7 EXIT1 . EXIT FROM THE RECURSIVE
EQ SETSIPI . PROCEDURE
EXIT1 SB6 B6-4 . DECREASE STACK
SA1 B6+3
SA4 B6+1 . RESTORE X4,X5,A0,B4
SA0 X1
AX1 18
SA5 B6+2
SB4 X1+0
JP B6+4 . AND RETURN (THE ADDRESSES CELL
. CONTAINS AN EQ JUMP)
* X0,X1,X2,X7,B2
*
ASSIGNS NO
+ SX0 -1
SX2 X2-1 . LAST IN STRING TO X2
ASGNS1 SX0 X0+1
SA1 X0+B4 . NEXT ASSIGNMENT
DF X1,ASSIGNS . RETURN IF NO MORE ASSIGNMENTS
SX7 B2
NG X1,ASGNS2 . BRANCH IN INSTANT ($) ASSIGNMENT
SX7 X1 . VARIABLE ADDRESS TO P STACK
SA1 PIX
LX7 18
BX7 X7+X1
SA1 B7
NZ X1,ASGNS3
RJ MORFREE
ASGNS3 SA7 A1
SB7 X1
BX7 X2 . PACK LAST AND FIRST IN STRING
SX1 B2 . INTO X7
LX7 18
BX7 X1+X7
SX1 A1
LX7 18
BX7 X7+X1 . X7 TO P STACK
SA1 B7
NZ X1,ASGNS4
RJ MORFREE
ASGNS4 SA7 A1
SB7 X1+0
SX7 A1 . CODE TO BUMP P STACK POINTER (PIX)
SA1 PIB . AND WORD COUNT (PIB)
SA7 PIX
SX7 X1+2
SA7 A1
EQ ASGNS1
ASGNS2 SA6 PMASX6 . $ TYPE ASSIGNMENT
SA7 PMASB2
BX7 X0
BX6 X3
SA7 PMASX0 . SAVE REGISTERS
SX3 X1
BX7 X2
SA6 PMASX3
SA7 PMASX2
BX7 X4
SX6 B1
SA7 PMASX4
SA6 PMASB1
SB3 X2
SX7 B4
SA7 PMASB4 . CONVERT PART OF THE STRING FROM
RJ STOSFX6 . FIRST TO LAST INTO SF FORMAT
SA6 TEMPDOL
SB2 TEMPDOL+1
SA6 B2 . MAKE SURE SF TYPE
RJ SASSIGN
SA1 SLENGTH
SA2 MAXSTAK
SA3 PMASX0
SA4 PMASX6 . RESTORE REGISTERS
SB3 X1
SB5 X2
BX0 X3
BX6 X4
SA1 PMASB1
SA2 PMASB4
SA3 PMASX3
SA4 PMASX4
SB1 X1
SB4 X2
SA1 PMASB2
SA2 PMASX2
SB2 X1+0
EQ ASGNS1
*
TITLE DEFINITIONS OF PM OPERATIONS
*
PRDPM EQU 1777B . NOTE. POSITIVE INDEFINITE
DOLPM EQU 6000B . NEGATIVE INDEFINITE
*
*
ENDEXPM EQU YENDEX-YSTAR+1777B . NOTE NEGATIVE VALUES
ALTPM EQU YALTER-YSTAR+1777B
EXPPM EQU YEXP-YSTAR+1777B
ARBPM EQU YARB-YSTAR+1777B
LENPM EQU YLEN-YSTAR+1777B
POSPM EQU YPOS-YSTAR+1777B
RPOSPM EQU YRPOS-YSTAR+1777B
TABPM EQU YTAB-YSTAR+1777B
RTABPM EQU YRTAB-YSTAR+1777B
REMPM EQU YREM-YSTAR+1777B
BALPM EQU YBAL-YSTAR+1777B
FAILPM EQU YFAIL-YSTAR+1777B
FENCEPM EQU YFENCE-YSTAR+1777B
ABORTPM EQU YABORT-YSTAR+1777B
ARBNOPM EQU YARBNO-YSTAR+1777B
*
STARPM EQU YSTAR-YSTAR+2000B . NOTE ZERO VALUE
*
LITPM EQU YLIT-YSTAR+2000B . NOTE POSITIVE VALUES
ANYPM EQU YANY-YSTAR+2000B . THE ELEMENTS ARE FOLLOWED
NTANYPM EQU YNOTANY-YSTAR+2000B . BY A CHARACTER STRING
SPANPM EQU YSPAN-YSTAR+2000B
BREAKPM EQU YBREAK-YSTAR+2000B
TITLE I/O ROUTINES COMMON TO RUN-TIME AND COMPILER
TITLE ERROR OVERLAY LOADER
USE SNOJOB
TITLE I/O SUBROUTINES
* CIO USES X2,X3,X7, X0 CONTAINS ON INPUT THE RECAL FLAG (0 OR 1) AND IS
* NOT CHANGED.
*
CIOWAIT SA2 1
NZ X2,*
CIO DATA 0
SA2 B2 FET FWA
MX3 42
BX2 X2*X3 CLEAR OUT CODE AND STATUS
BX7 X2+X7 ADD FUNCTION CODE
SA7 B2
SX7 3RCIO
LX7 2
BX7 X0+X7 ADD RECALL BIT
SX3 B2 FET ADDRESS
LX7 40
BX7 X3+X7
SA7 1
EQ CIOWAIT
RCLWAIT SA2 1
NZ X2,*
RCL
SX7 3RRCL
LX7 2
BX7 X0+X7
LX7 40
ZR X0,RCL1 . B2 CONTAINS GARBAGE
SX2 B2+0
BX7 X2+X7
RCL1 SA7 1
EQ RCLWAIT
* GETB RETURNS THE NEXT WORD IN THE FILE POINTED TO BY B2. GETB
* DECREMENTS B3 BY THE NUMBER OF CHARACTERS IT RETURNS EACH TIME IT IS
* CALLED. WHEN B3 REACHES ZERO, GETB RETURNS ZERO CHARACTERS AND
* INCREMENTS B5 BY 2.
*
* WHEN GETB REACHES A ZERO BYTE OR EOR, IT RETURNS BLANK CHARACTERS,
* INCREMENTS B5 BY 1, AND CONTINUES TO CHECK B3. THUS TO READ A LINE,
* SET B3 = UNIT RECORD LENGTH, B5 = 0, AND CALL GETB UNTIL B5 = 2 OR 3.
*
* IN X2 IS RETURNED THE FILE WORD WITH BLANK AND/OR ZERO FILL. IN X3 IS
* RETURNED THE WORD EXACTLY AS IT APPEARED IN THE FILE (BUT IT IS NOT
* RETURNED IF GETB IS CALLED WITH B5 .NE. 0).
*
GETB DATA 0
ZR B5,GETB02 EQL/EQUR FLAG NOT SET
SB4 B5-2
SX2 0
PL B4,GETB . URL EXCEEDED, ZERO FILL
GETB01 SA2 BLANKS
EQ GETB05
GETB08 RECALL B2 . WAIT FOR COMPLETION OF LAST OP
GETB02 SA1 B2+2 IN
SA3 B2+3 OUT
IX1 X1-X3
ZR X1,GETB07
SA2 X3 PICK UP BUFFER WORDS
SA1 MASKM
IX0 X1-X2
BX0 X0-X2
BX0 X0*X1
NZ X0,GETB56
GETB03 SX7 X3+1 . INCREMENT THE OUT POINTER
SA1 B2+4 LIMIT
SX1 X1
IX1 X1-X7
ZR X1,GETB09 OUT=LIMIT
GETB04 SA7 A3+0 STORE NEW OUT
BX3 X2 FOR COMPILER LISTING ROUTINE
GETB05 SB3 B3-10 DECREMENT UNIT RECORD LENGTH
LT B0,B3,GETB RETURN
SB5 B5+2
SB3 -B3
MX0 54
GETB06 ZR B3,GETB
BX2 X0*X2
LX0 6
SB3 B3-1
EQ GETB06
GETB07 SA1 B2 FET FWA
LX1 59
PL X1,GETB08 . FILE IS BUSY
LX1 60-4 . =RCY 4 (LEFT-JUSTIFY THE EOR BIT)
NG X1,GETB12
READ RECALL
EQ GETB02
GETB09 SA1 B2+1 FIRST
SX7 X1+0
EQ GETB04
GETB12 SB5 B5+1
EQ GETB01
GETB56 MX1 48
BX1 -X1*X2
NZ X1,GETB57
SB5 B5+1
GETB57 LX0 54
BX0 -X2*X0
BX7 X0
LX7 2
BX7 X0+X7
BX2 X2+X7
LX7 3
BX2 X2+X7
EQ GETB03
MASKM DATA 10HAAAAAAAAAA
* CZB MOVES THE (INPUT) FILE WHOSE FET ADDRESS IS CONTAINED IN B2 TO THE
* NEXT ZERO BYTE OR EOR, WHICHEVER COMES FIRST. HOWEVER, IF THE LINE
* STATUS IN B5 IS 1 OR 3, INDICATING A ZERO BYTE HAS ALREADY BEEN FOUND,
* CZB DOES NOTHING AND IMMEDIATELY EXITS.
* REGISTERS SAVED] B1, B2, B6, B7, A0, A5-X5, AND A6-X6.
CZB DATA 0 . ENTRY/EXIT
CZB1 SB5 B5-2 . B5 = ;1 IF ZERO BYTE ENCOUNTERED!
* +&2 IF RECORD LENGTH REACHED]
NZ B5,CZB . WAS 1 OR 3, SO ZERO BYTE SEEN
SB3 377777B . =2!17-1, A LONG RECORD
RJ GETB . GET BUFFER WORD AND POSSIBLY SET B5
CZB2 NZ B5,CZB1 . MOST LIKELY B5 = 1 NOW
RJ GETB
JP CZB2
* PB USES X0,X2,X3,X4,X7. IT PUTS THE WORD IN X6 INTO THE BUFFER WHOSE
* FET FWA IS IN B2. X6 AND B2 ARE NOT CHANGED.
*
PB3 SA6 X2 . PUT WORD INTO BUFFER
SX7 X4
SA7 A2+0 . UPDATE IN POINTER
PB DATA 0
SA2 B2+2 FET IN POINTER
SA3 B2+4 LIMIT POINTER
SX4 X2+1
SX3 X3
IX3 X4-X3
NZ X3,PB1
SA4 B2+1 FIRST
PB1 SX4 X4
SA3 B2+3 . OUT
IX3 X3-X4
NZ X3,PB3
SA3 B2 FET FWA
LX3 59 CHECK COMPLETION BIT
PL X3,PB2
WRITE RECALL
EQ PB+1
PB2 RECALL B2
EQ PB+1
*
* CBO USES X2,X3,X4, AND X7(IF CIO IS CALLED)
* IT RETURNS X2 .NE. 0 IF ZERO BYTE IS NOT IN X6
*
CBO DATA 0
MX0 48
BX6 -X0*X6
NZ X6,CBO
SA2 B2+2 IN
SA3 B2+3 OUT
IX2 X3-X2
SA3 B2+1 FIRST
SA4 B2+4 LIMIT
IX3 X4-X3
SX3 X3
AX3 1 BUFFER LENGTH / 2
NG X2,CBO1
BX3 -X3
CBO1 IX2 X2+X3
PL X2,CBO
SA2 B2
LX2 59
PL X2,CBO
WRITE
EQ CBO
*
CBI2 LX4 5
SA2 B2-1 . LINK WORD
MX7 1
LX7 37
BX7 X2+X7 . SET EOI FLAG
SA7 A2
CBI . CHECK FOR EOR ON INPUT FILE
SA1 B2-1
LX1 59-36
NG X1,ERR55 . EOI FLAG WAS SET
CBI0 SA1 B2+2 . IN POINTER
SA2 B2+3 . OUT POINTER
IX1 X1-X2
NZ X1,CBI . BUFFER IS NOT EMPTY
SA4 B2 . FET FIRST WORD
LX4 59
PL X4,CBI1 . BUSY
LX4 51
NG X4,CBI2 . EOI ENCOUNTERED
SA1 A1 . IN AGAIN
IX1 X1-X2
NZ X1,CBI . A PRU WAS JUST MOVED
LX4 5 . EXAMINE EOR BIT
NG X4,CBI . EOR WAS ENCOUNTERED
READ RECALL
EQ CBI0 . TRY AGAIN
CBI1 RECALL B2
EQ CBI0 . LIKEWISE
ABT RJ CLOSEOUT
.ABT. SX7 3LABT . MONITOR REQUEST TO ABORT
LX7 42
SA7 1
EQ *
CLOSEOUT . ROUTINE TO TERMINATE OUTPUT FILES
SB1 FETHEAD . HEAD OF FILE LIST
CO1 SA1 B1 . BUFFER BLOCK HEADER WORD
SB2 B1+1 . FET ADDRESS
SB1 X1 . LINK
RJ TERMIN . TO WRITER OR NOT TO WRITER...
NZ B1,CO1
EQ CLOSEOUT
TERMIN DATA 0 . ISSUE WRITER ON OUTPUT FILE
WAIT
SA1 B2+2 . IN POINTER
SA2 B2+3 . OUT
IX1 X1-X2
SA2 B2
ZR X1,TERMIN3 . SEE IF BUFFERED WRITE WAS LAST OP
SX0 44B . EXAMINE MOTION, R/W BITS
SX1 30B . EXAMINE EOR/EOF BITS
BX0 X0*X2
BX1 X1*X2
NZ X0,TERMIN2 . LAST OP WRITE OR REWIND
NZ X1,TERMIN . LAST OP OPEN
TERMIN2 WRITER RECALL
EQ TERMIN
TERMIN3 SX0 24B
BX2 X0*X2 . EXAMINE EOR, R/W BITS
SX2 X2-4B . COMPARE TO BUFFERED WRITE
NZ X2,TERMIN . LAST OP WAS NOT BUFFERED WRITE
EQ TERMIN2
TITLE INPUT ROUTINE
GETL MACRO
LOCAL NEXT
SA1 B7 . NEXT FREE WORD
NZ X1,NEXT . NOT THE LAST ONE
RJ MORFREE . GET MORE
NEXT SB7 X1 . UPDATE FREE POINTER
SX1 X1 . CLEAR UPPER 42 BITS
ENDM
*
INPUT DATA 0
SB1 B3
SA2 B1 INPUT ASSOCIATED VARIABLE DESCRIPTOR
AX2 18
SB2 X2+1 FWA OF FET
RJ CBI
SA3 B2-1 . FILE HEADER WORD
MX6 1
LX6 1+18+18+1 . EOR FLAG POSITION
NZ X1,READ . BUFFER CONTAINS DATA
BX6 X6+X3 . SET EOR FLAG
SA6 A3
MX7 1
BX7 -X7*X4 . CBI LEFT FET FIRST WORD IN X4
LX7 5
SA7 A4
RJ ZROX7
SA2 B1
SA7 X2 . NULL VALUE
EQ FAIL
READ BX6 -X6*X3 . CLEAR EOR FLAG
SA6 A3
SB5 B0 . CLEAR END FLAG
SA4 B1 . INPUT ASSOCIATED SVD
LX4 60-36 . RIGHT JUSTIFY UNIT RECORD LENGTH
SB3 X4
SA1 MXLNGTH . MAXIMUM STRING LENGTH KEYWORD
SX2 X4
IX2 X1-X2
NG X2,ERR18 . ERROR - TOO LONG
RJ GETB . GET DATA WORD IN X2
GETL GET LIST WORD
SX6 A1
SX3 SSTY
LX3 55
BX6 X3+X6 NEW ISD
MX0 18
LX0 54
LX4 36
BX0 X0*X4
BX6 X0+X6
SA6 X4
MX0 42
BX6 X0*X2
EQ LOOPA
LPLP RJ GETB . GET BUFFER WORD ONE
MX0 42
BX6 X0*X2
ZR X6,ENDL
GETL REACHED END-OF-UNIT-RECORD
LOOPA BX6 X1+X6
SA6 A1+0 STORE LIST WORD 1
BX6 -X0*X2
ZR X6,ENDL
RJ GETB GET BW2
MX0 24
LX6 42
BX3 X0*X2
LX3 42
BX6 X3+X6
GETL
BX6 X1+X6
SA6 A1 STORE LW2
BX6 -X0*X2
ZR X6,ENDL
RJ GETB GET BW3
MX0 6
LX6 24
BX3 X0*X2
LX3 24
BX6 X3+X6
GETL
BX6 X1+X6
SA6 A1 STORE LW3
BX2 -X0*X2
ZR X2,ENDL
MX0 42
LX2 6
BX6 X0*X2
GETL
BX6 X1+X6
SA6 A1 STORE LW4
BX6 -X0*X2
ZR X6,ENDL
RJ GETB GET BW4
MX0 30
LX6 42
BX3 X0*X2
LX3 48
BX6 X3+X6
GETL
BX6 X1+X6
SA6 A1 STORE LW5
BX6 -X0*X2
ZR X6,ENDL
RJ GETB GET BW5
MX0 12
LX6 30
BX3 X0*X2
LX3 30
BX6 X3+X6
GETL
BX6 X1+X6
SA6 A1 STORE LW6
BX2 -X0*X2
ZR X2,ENDL
LX2 12
MX0 42
BX6 X0*X2
GETL
BX6 X1+X6
SA6 A1 STORE LW7
BX6 -X0*X2
ZR X6,ENDL
RJ GETB GET BW6
MX0 36
LX6 42
BX3 X0*X2
LX3 54
BX6 X3+X6
GETL
BX6 X1+X6
SA6 A1 STORE LW8
BX6 -X0*X2
ZR X6,ENDL
RJ GETB GET BW7
MX0 18
LX6 36
BX3 X0*X2
LX3 36
BX6 X3+X6
GETL
BX6 X1+X6
SA6 A1 STORE LW9
BX6 -X0*X2
ZR X6,ENDL
LX6 18
GETL
BX6 X1+X6
SA6 A1 STORE LW10
EQ LPLP
ENDL SA1 A6
MX0 42
BX6 X0*X1
SA6 A6
SA2 B1 IAVD
SA2 X2 ISD
SX3 A6 LWA OF NEW STRING
LX3 18 IS INSERTED
BX6 X2+X3 INTO ISD
SA6 A2
RJ CZB SKIP UP TO ZERO BYTE
CHECK1 SA1 B2+2 IN
SA2 B2+3 OUT
IX1 X1-X2
SA2 B2+1 FIRST
SA3 B2+4 LIMIT
IX2 X3-X2
SX2 X2
AX2 1 BUFFER LENGTH / 2
NG X1,CHECK2
BX2 -X2
CHECK2 IX1 X1+X2
PL X1,INPUT
SA1 B2
LX1 55
NG X1,INPUT
READ B2
EQ INPUT
BLANKS DATA 10H
TITLE OUTPUT ROUTINE
OUTPUT DATA 0
SA2 B3 OUTPUT ASSOCIATED VARIABLE DESCRIPTOR
SA1 X2 SIMPLE VARIABLE DESCRIPTOR
SB4 X1 B4 = NEXT LIST WORD
AX2 18
SB2 X2+1 FET FWA
AX2 18
MX0 54
BX6 -X0*X2 CARRIAGE CONTROL CHARACTER
LX6 54 LEFT JUSTIFY CCC
NZ X6,HAV1 IF CCC IS NONNULL, ENTER SEQ AT HAV1
HAV0 ZR B4,H01
SA1 B4 GET LIST WORD 1
SB4 X1
MX0 42
BX6 X0*X1
SX1 0
ZR B4,H01
SA1 B4
SB4 X1
MX0 18
BX3 X0*X1
LX3 18
BX6 X3+X6
H01 RJ PUTB STORE BUFFER WORD 1
LX1 18
MX0 24
BX6 X0*X1 REMAINDER TO X6
SX1 B0
HAV4 ZR B4,H41
SA1 B4
SB4 X1
MX0 36
BX3 X0*X1
LX3 36
BX6 X3+X6
H41 RJ PUTB STORE BW2
LX1 36
MX0 6
BX6 X0*X1
SX1 B0
HAV1 ZR B4,H11
SA1 B4+0
SB4 X1+0
MX0 42
BX3 X0*X1
LX3 54
BX6 X3+X6
SX1 0
HAV8 ZR B4,H11
SA1 B4
SB4 X1
MX0 12
BX3 X0*X1
LX3 12
BX6 X3+X6
H11 RJ PUTB STORE BW3
LX1 12
MX0 30
BX6 X0*X1
SX1 B0
HAV5 ZR B4,H51
SA1 B4
SB4 X1
MX0 30
BX3 X0*X1
LX3 30
BX6 X3+X6
H51 RJ PUTB STORE BW4
LX1 30
MX0 12
BX6 X0*X1
SX1 B0
HAV2 ZR B4,H21
SA1 B4+0
SB4 X1+0
MX0 42
BX3 X0*X1
LX3 48
BX6 X3+X6
SX1 0
HAV9 ZR B4,H21
SA1 B4
SB4 X1
MX0 6
BX3 X0*X1
LX3 6
BX6 X3+X6
H21 RJ PUTB STORE BW5
LX1 6
MX0 36
BX6 X0*X1
SX1 B0
HAV6 ZR B4,H61
SA1 B4
SB4 X1
MX0 24
BX3 X0*X1
LX3 24
BX6 X3+X6
H61 RJ PUTB STORE BW6
LX1 24
MX0 18
BX6 X0*X1
SX1 B0
HAV3 ZR B4,H31
SA1 B4
SB4 X1
MX0 42
BX3 X0*X1
LX3 42
BX6 X6+X3
H31 RJ PUTB
SX6 0
EQ HAV0
PUTB DATA 0
RJ PB
RJ CBO
NZ X6,PUTB
EQ OUTPUT
TITLE INITIALIZATION OF THE TRANSLATED CODE
SMESS DIS ,* SUCCESSFUL COMPILATION*
POST0 SA1 MINSTAT
SA2 X1+STNPRL+1
POST1 LX2 1 . LOOP TO FIND FIRST STANDARD
AX2 19 . PROCEDURE IN THE CHAIN WHICH HAS
PL X2,POST2 . BEEN USED
SB5 X2
SA2 X1+B5
EQ POST1
POST2 SB1 1 . B1 IS THE CONSTANT ONE
AX2 18 . NEW STATIC BASE
IX0 X2-X1 . STATIC DISPLACEMENT TO X0 AND B7
BX7 X2 . RELOCATE MINSTAT
SA7 A1
SA2 MAXSTAT
SB7 X0
SB3 X2
SB2 SPCTYP
SA2 X1-1
EQ B7,B0,POST11A . BYPASS IF NO DISPLACEMENT
POST3 SA2 A2+B1 . NEXT RECORD HEADING
SB4 A2-B3
SB5 X2
BX7 X2
POST4 EQ B4,B0,POST9 . END OF STATIC
ZR X2,POST7 . EMPTY WORD
EQ B5,B0,POST5
IX7 X2+X0 . RELOCATE THE HASH-LINK
POST5 AX2 55 . TYPE OF RECORD TO B5
SA7 A2+B7
SB5 X2+37B
SB4 B2+B1 . LITERAL TYPE
SX1 B5-B4 . REMEMBER IF LITERAL
LT B4,B5,POST5B . BRANCH IF VAR,CALL OR LABEL
EQ B5,B2,POST8 . BRANCH IF I/O BUFFER
SA2 A2+1
SB4 B2-B1 . INTEGER TYPE
IX7 X2+X0 . RELOCATE FIRST
LX7 42
LT B5,B4,POST5A . BRANCH IF REAL
IX7 X7+X0 . RELOCATE LAST
POST5A LX7 18
SA7 A2+B7
ZR X1,POST6 . BRANCH IF LITERAL
POST5B SA2 A2+1 . COPY ONE WORD
BX6 X2
SA6 A2+B7
LT B5,B4,POST3 . BRANCH IF REAL
POST6 SA2 A2+B1 . COPY BCD WITH LINKS RELOCATED
SB5 X2
EQ B5,B0,POST7
IX7 X2+X0
SA7 A2+B7
EQ POST6
POST7 BX6 X2 . LAST WORD WITH ZERO LINK
SA6 A2+B7
EQ POST3
POST8 AX7 18
SB5 X7 . BYPASS TO B5
SA2 A2+B5
SB4 A2-B3
SB5 X2
BX7 X2
EQ POST4
*
POST9 SB5 HASHLN . LOOP TO RELOCATE NONZERO ENTRIES
POST10 SB5 B5-1 . IN THE HASH - TABLE
SA1 B5+HASHTBL
IX7 X1+X0
ZR X1,POST11
SA7 A1
POST11 NE B5,B0,POST10
SA5 INFET+1 . UPDATE INPUT AND OUTPUT FET - S
IX7 X5+X0
SX6 X7
SA7 A5 . FIRST
SA6 A5+B1 . IN
SA6 A6+B1 . OUT
SA5 A6+B1
IX7 X5+X0
SA7 A5 . LIMIT
SA5 OUTFET+1
IX7 X5+X0
SX6 X7
SA7 A5 . FIRST
SA6 A5+B1 . IN
SA6 A6+B1 . OUT
SA5 A6+B1
IX7 X5+X0
SA7 A5 . LIMIT
POST11A SA5 PRGBASE
SX4 B7
SB5 X5
SB6 B0-B6
SB6 B6+B1 . ADDRESS OF LAST MICRO-OPERATION
SX2 B2 . SPCTYP FOR THE HEADING
SX1 B5-B6 . PROGRAM LENGTH TO X1
LX2 55
SB4 X1+B1
LX1 18
BX7 X1+X2 . STATIC RECORD READING FOR THE CODE
MX0 42
SA7 B3+B7
SA1 CODELINK
SX6 B3+B7
NZ X1,POST11B
SX1 B3+B7
POST11B LX6 18
SX5 X1
BX6 X5+X6
SA6 A1
AX1 18
ZR X1,POST11C
SA1 X1
AX6 18
BX6 X6+X1
POST11C SA6 A1
SB4 A7+B4 . NEW PROGRAM BASE TO B4
SX5 B7
MX6 42
LX4 18 . RELOCATION CONST. FOR LOW ORDER
LX5 36 . RELOCATION CONST. FOR HIGH ORDER
LX6 18 . MICOP-S
BX0 -X0
POST12 SA1 B6 . NEXT WORD OF MICOP-S
ZR X1,POST17 . FINISHED IF ZERO
BX7 -X0*X1
SA2 X1+MCOPTBL
SX3 X2 . ABS ADDRESS OF LOW ORDER MICOP
BX7 X7+X3 . TO X3
NG X2,POST15 . GO TO OR CALL
EQ B7,B0,POST14 . BYPASS IF NO RELOCATION
AX1 18
SB2 X1 . LOW ORDER ADDRESS
AX1 18
SB3 X1 . HIGH ORDER ADDRESS
EQ B2,B0,POST13
IX7 X7+X4 . NONZERO ADDRESSES HAS TO BE
POST13 EQ B3,B0,POST14 . RELOCATED
IX7 X7+X5
POST14 SA7 A7+B1 . STORE WORD
SB6 B6+B1
EQ POST12
*
POST15 LX2 38
NG X2,POST16 . BRANCH IF CALL
AX1 18 . ADDRES OF GO TO
SX1 X1
NG X1,POST14
BX7 X6*X7
BX1 -X1
SX1 X1+B4
LX1 18 . IF DEFINED, REPLACE IT BY THE ABS
BX7 X7+X1 . ADDRESS
EQ POST14
POST16 IX7 X7+X4 . RELOCATE ADDRESS OF CALL
EQ POST14
*
POST17 SA1 LBLLINK . WE SHALL PROCESS ALL LABELS
SA4 MAXSTAK . REFERENCED OR DEFINED DURING THE
POST18 SB2 X1 . RECENT COMPILATION
EQ B2,B1,POST24 . END OF THE CHAIN OF LABELS
SA1 X1+B7
SB2 X1
LX1 24
SB3 X1
LX1 18
LT B2,B0,POST21 . BRANCH IF LABEL IS NOT DEFINED
SX5 B4-B2 . ABS ADDRESS TO X5
BX3 X5
POST18A EQ B3,B0,POST20 . BRANCH IF LABEL HAS NOT BEEN USED
LX3 18 . IN PREVIOUSLY COMPILED CODE
SB2 B0-B1 . IF NOT SO, SPREAD DEFINED VALUE
EQ B2,B3,POST20
POST19 SA2 B0-B3
BX7 X2*X6
AX2 18
BX7 X7+X3
SB3 X2
SA7 A2
NE B3,B2,POST19
POST20 BX7 X5 . STORE NEW LABEL DESCRIPTION
SA7 A1
EQ POST18
POST21 LT B0,B3,POST22A . LABEL DEFINED IN EARLIER COMPLTN.
SX5 B4+B2 . IF THE LABEL HAS NOT BEEN DEFINED
BX5 -X5*X0 . THEN IN THE CHAIN OF
POST22 SA2 B4+B2 . REFERENCES, THE RELATIVE LINKS
BX7 X6*X2 . HAVE TO BE REPLACED BY ABSOLUTE
AX2 18 . ONES
SB2 X2
SX2 X2+B1
ZR X2,POST23
SX2 B4+B2
BX2 -X2*X0
LX2 18
BX7 X7+X2
SA7 A2
EQ POST22
POST22A SX5 B3 . ABS ADDRESS TO X5
SX3 B3
LX3 18
POST22B SA2 B4+B2 . SPREAD VALUE TO JUMPS THROUGH
BX7 X6*X2 . NEGATIVE RELATIVE CHAIN TERMINATED
AX2 18 . BY -1 LINK
SB2 X2
SX2 X2+B1
BX7 X7+X3
SA7 A2
NZ X2,POST22B
EQ POST20
*
POST23 EQ B3,B0,POST20
SX2 B3
LX2 18
BX7 X7+X2
SA7 A2
EQ POST20
*
POST24 SX6 B4-B1 . BEGINNING OF THE STACK TO X6
SB3 X4
SA3 COMPB7 . RESTORE B7 (IT POINTS TO THE FREE
POST25 SA1 B5 . LIST)
SB5 B5+B1 . SHIFT THE STACK TO ITS PLACE
BX7 X1
SA7 B4-B1
SB4 B4+B1
GE B3,B5,POST25
SX0 B7
SB7 X3
SB6 A7 . B7 IS THE STACK TOP POINTER
SA6 MAXSTAT
SA3 STAKTOP . SET STACKTOP TO ITS ABS VALUE
SA6 MINSTAK
SA2 VARLINK
IX6 X6+X3
SA6 A3
POST26 ZR X2,POST27 . ASSIGN A NULL VALUE TO ALL VARI-
IX2 X2+X0 . ABLES DEFINED IN THE RECENT
SA3 X2 . COMPILATION
RJ ZROX7
SA7 X2
SX2 X3
EQ POST26
* NOW THE CODE IS READY TO RUN. IT BEGINS AT X6-1
POST27 SA1 NXTWRD
SA5 X6+0 . BEGIN EXECUTION OF THE PROGRAM
NG X1,NEXTMIC . IF FIRST COMPILATION
SX7 CTY . IF RESULT OF COMPILE, PUT
SX6 X6-1 . REFERENCE TO THE COMPILED
SA4 B6-1 . CODE TO THE TOP OF THE STACK
SA5 X4 . HEADER HAS BEEN FIXED AT QCMPL
LX7 55
BX7 X7+X6
SA7 A4
SA1 FRSTWRD
ZR X1,NEXTMIC . FREE THE REMAINDER OF THE
SX7 B7 . ARGUMENT STRING
SB7 X1
POST28 SA1 X1
SX1 X1
NZ X1,POST28
SA7 A1
EQ NEXTMIC
TITLE RUN - TIME FUNCTIONS
*
*
QIF SA1 B6 . STANDARD PROCEDURE IF
SB1 X1 . SKIP PARAM AND
SB6 A1-B1 . RETURN A NULL VALUE
AX1 55
MX0 6
NZ X1,QIF3 . FREE IF SF
SA1 B6+1
SX7 B7
SB7 X1
AX1 18
SA7 X1
QIF3 SX5 X5-1
NZ X5,QIF
SB6 B6+2
QIF2 RJ ZROX7
SX6 2
BX7 -X0*X7 . REMOVE SS TYPE
SA6 B6
SA7 B6-1
EQ NEXTMIC
*
IFQ BSS 0
*
*
QSIZE SX5 X5-1
NZ X5,ERR20 . TOO MANY PARAMETERS
SA2 B6
AX2 55
SA1 B6-1
BX6 X1
ZR X2,QSIZE1 . PARAM IS SF TYPE
SX2 X2-ITY
NZ X2,ERR29 . NOT STRING TYPE
RJ ITOSF
QSIZE1 SX7 B7
SB7 X6
AX6 18
SA7 X6 . LINK PARAM TO FREE CHAIN
SA2 ITYWD
BX7 X2
AX6 18
SA6 B6-1 . LENGTH
SA7 B6
EQ NEXTMIC
SIZEQ BSS 0
QLEN SB1 LENPM
EQ QPAT
QPOS SB1 POSPM
EQ QPAT
QRPOS SB1 RPOSPM
EQ QPAT
QTAB SB1 TABPM
EQ QPAT
QRTAB SB1 RTABPM
QPAT SX5 X5-1
NZ X5,ERR20 . TOO MANY PARAMETERS
SA0 10
SA1 TENTO10
BX0 X1
SX5 B1 . SAVE PATTERN TYPE
RJ SACHEK
LX7 3
PL X7,ERR42 . NOT ITY
MX0 43
SA1 B6-1
NG X1,ERR42 . NEGATIVE NOT LEGAL
BX0 X0*X1
NZ X0,ERR42 . TOO LARGE
LX5 48
BX6 X1+X5
SX7 PSTY
SA6 A1
LX7 55
SX6 2
BX6 X6+X7
SA6 B6
EQ NEXTMIC
PATQ BSS 0
*
* . - + 0
QEQ SB1 6B . 1 1 0
EQ QEQ1
QNE SB1 1 . 0 0 1
EQ QEQ1
QGT SB1 5 . 1 0 1
EQ QEQ1
QGE SB1 4 . 1 0 0
EQ QEQ1
QLT SB1 3 . 0 1 1
EQ QEQ1
QLE SB1 2 . 0 1 0
QEQ1 SX5 X5-1
ZR X5,QEQ8 . BRANCH IF SINGLE PARAM
SX5 X5-1
NZ X5,ERR20 . ERROR IF MORE THAN TWO PARAMS
SA1 B6
SX5 B1
SB1 X1
SA2 B6-B1
AX1 55 . RIGHT PARAM TYPE
AX2 55 . LEFT PARAM TYPE
SX3 X1-ITY
SX4 X2-ITY
NZ X3,QEQ5 . BRANCH IF NOT BOTH ARE
NZ X4,QEQ5 . INTEGERS
QEQ2 SA1 B6-1 . COMPARE INTEGERS
SA2 B6-3
SB6 B6-2
IX1 X2-X1
QEQ3 SX4 1 . TEST ON X1 - + 0
ZR X1,QEQ4
LX4 1
PL X1,QEQ4
LX4 1
QEQ4 BX5 X4*X5 . MASK BY BIT PATTERN OF THE
NZ X5,FAIL . RELATION
MX0 5
RJ ZROX7 . NULL STRING IS RETURNED IF
SX6 2 . SUCCESS
BX7 -X0*X7
SA6 B6 . CLEAR SS TYPE
SA7 B6-1
EQ NEXTMIC
QEQ5 SX6 X1-RTY . IF ONE PARAM IS REAL THEN
SX4 X2-RTY . BOTH HAVE TO BE REAL
ZR X6,QEQ7
ZR X4,ERR47
SA4 B6-1
ZR X3,QEQ5A . BRANCH IF RIGHT OP IS INTEGER
NZ X1,ERR47 . ERROR IF NOT SF
SA2 MINSTAT
SX0 SSTY
LX0 55
BX6 X4+X0 . ADD SS TYPE BITS
SA6 X2 . IF SF STORE IN XWRD
EQ QEQ5B
QEQ5A BX6 X4 . ELSE IN SAVE LOCATION
SA6 QEQSV
QEQ5B SB6 B6-2
SA1 TENTO10
BX0 X1
SA0 10
RJ SACHEK . CHECK LEFT PARAM
SA0 2
RJ RESERVE
SA2 MINSTAT
SA2 X2
BX6 X2
NZ X2,QEQ5C . RESTORE RIGHT PARAM
SA2 ITYWD
SA1 QEQSV . CUT IT SHORT IF INTEGER
BX7 X2
BX6 X1
SA6 B6-1
EQ QEQ5D
QEQ5C SX7 A0 . SACHEK DOES NOT CARE IF THE
SA6 B6-1 . SS BITS ARE ON
SA7 B6
BX7 X7-X7 . CLEAR XWRD
SA7 A2
SA1 TENTO10
BX0 X1
SA0 10
RJ SACHEK . CHECK RIGHT PARAM
QEQ5D SB1 X7
SA1 B6-B1
LX7 3
LX1 3
PL X7,QEQ6
NG X1,QEQ2 . BRANCH IF BOTH ARE INTEGERS
QEQ6 ERROR 32
*
*
QEQ7 NZ X4,ERR47
SB6 B6-2
SA1 B6+1
SA2 B6-1
FX1 X2-X1 . COMPARE REAL VALUES
NX1 X1 . TAKE CARE OF ZERO RESULT
EQ QEQ3
*
QEQ8 SA1 TENTO10 . CHECK SIMGLE PARAM
SA0 10
BX0 X1
SX5 B1
RJ SACHEK
LX7 3
SA1 B6-1
NG X7,QEQ3 . BRANCH IF INTEGER TYPE
ERROR 32
*
EQQ BSS 0
*
*
QSPAN SB4 SPANPM
EQ QANY1
QBREAK SB4 BREAKPM
EQ QANY1
QNOTANY SB4 NTANYPM
EQ QANY1
QANY SB4 ANYPM
QANY1 SX5 X5-1 . NO OF PARAMETERS
NZ X5,ERR20
SA1 B6
AX1 55 . TYPE OF PARAMETER
NZ X1,QANY3 . BRANCH IF NOT SF
QANY2 SA2 B6-1 . SVD TO X2
AX2 36
SB5 X2 . LENGTH TO B5
SA0 X2
SB3 A2
RJ RESERVE . RESERVE B5 WORDS
SX6 B4 . PM OPERATION TO X6
SX4 B5+2 . BYPASS TO X4
LX6 48
SX2 B6-B3 . PM OPERATION BYPASS PART
SA1 B3
BX6 X6+X2
SA6 B3 . STIRE PM OPERATION
SX3 PSTY
LX3 55
BX7 X3+X4
BX4 X1
SA7 B6 . STORE HEADING ( PS TYPE )
RJ SSTOS . BREAK THE STRING DOWN INTO
SX6 B7 . FREE SF PARAMETER
SB7 X4
AX4 18
SA6 X4
EQ NEXTMIC . CHARACTERS AND EXIT
QANY3 SX1 X1-ITY
NZ X1,ERR29 . ERROR IF NOT INTEGER
SA1 B6-1
RJ ITOSF . CONVERT I TO SF
SA6 B6-1
EQ QANY2
*
ANYQ BSS 0
*
QTRIM SX5 X5-1
NZ X5,ERR20 . ERROR IF MORE THAN ONE PARAMETER
SA1 B6
AX1 55
ZR X1,QTRIM1 . BRANCH IF STRING PARAM
SX1 X1-ITY
NZ X1,ERR29 . ERROR IF NOT INTEGER
EQ NEXTMIC . INTEGERS ARE TRIMMED ANYWAY
QTRIM1 SA2 B6-1 . SVD OF OPERAND
BX6 X6-X6 . CHARACTER COUNT
BX5 X2
SA1 X2+0 . TO INITIALIZE X3
MX0 54
SX4 1R . BLANK TO X4
SB1 0 . NO SKIP MODE
QTRIM2 ZR X2,QTRIM5 . FINIS IF LINK IS ZERO
SX3 A1 . LAST REFERENCE
SA1 X2 . NEXT WORD
SX2 X1
BX1 X1-X2 . REMOVE LINK
SB2 -6 . INITIALIZE POSITION COUNT
QTRIM3 LX1 6 . NEXT CHAR TO X7
SB2 B2+6
BX7 -X0*X1
ZR X7,QTRIM2 . NEXT WORD IF IT IS ZERO
SX6 X6+1 . BUMP CHARACTER COUNT
BX7 X7-X4 . COMPARE IT WITH A BLANK
EQ B1,B0,QTRIM4 . BRANCH IF NO SKIP
ZR X7,QTRIM3 . NEXTCHAR IF BLANK
SB1 B0 . END SKIP MODE IF NOT BLANK
EQ QTRIM3
QTRIM4 NZ X7,QTRIM3 . NOT BLANK IN NO SKIP
SB1 A1 . BLANK IN NO SKIP
SA0 X6
SB3 B2
SB5 X3
EQ QTRIM3
QTRIM5 EQ B1,B0,NEXTMIC . RETURN IF NO SKIP
NE B3,B0,QTRIM6
SA3 B1+0 . CASE OF ALL BLANKS
SX6 X3
SA6 A3
SA2 B5 . FIRST BLANK WAS THE FIRST
SX1 B1 . CHARACTER IN A WORD
SX7 X2
BX7 X2-X7
SA7 A2
EQ QTRIM7
QTRIM6 SA1 B1 . FIRST BLANK WAS NOT THE FIRST
MX0 6 . CHARACTER IN A WORD
SB3 B3-6
AX0 X0,B3 . MASK THE BLANKS OFF
BX7 X0*X1
SA7 A1
SB5 A1
QTRIM7 SX7 X5 . FIRST
SX6 B5 . LAST
SX3 X5
AX5 18
LX6 18
SX0 A0-1 . LENGTH IN CHARACTERS
LX0 36
BX7 X6+X7
BX7 X7+X0 . FORM SVD IN X7
SA7 B6-1 . RESULT
SX1 X1 . RETURN IF NOTHING IS THERE
BX3 X3-X1 . TO BE FREED
ZR X1,NEXTMIC
ZR X3,NEXTMIC
SX7 B7 . FREE WORDS CONTAINING TRAILING
SB7 X1 . BLANKS
SA7 X5
EQ NEXTMIC
*
TRIMQ BSS 0
*
QANCHOR SB1 ANCHOR . STANDARD PROCEDURE ANCHOR
QANCHOR1 SA1 B6
AX1 55
NZ X1,QANCHOR2 . BRANCH IF PARAM IS NOT A STRING
SA2 B6-1
SA1 X2 . FETCH FIRST WORD OF STRING
QANCHOR2 BX7 X1 . SET KEYWORD TO ZERO IF PARAM
SA7 B1 . IS A NULL STRING ELSE
* . SET IT TO NOT ZERO
SX4 X5-1
ZR X4,QIF
EQ ERR20 . ONLY ONE PARAMETER ALLOWED
*
ANCHORQ BSS 0
*
*
QARBNO SX5 X5-1
NZ X5,ERR20 . ERROR IF MORE THAN ONE PARAM
SA1 B6
AX1 55
ZR X1,QARBN1 . BRANCH IF STRING
SX1 X1-ITY
NG X1,QARBN2 . BRANCH IF PATTERN
NZ X1,ERR27 . ERROR IF NOT INTEGER
SB1 QARBN1
EQ ITOSFTP . CONVERT INTEGER TO STRING
QARBN1 SB1 QARBN2 . CONVERT STRING TO PATTERN
SX4 B6-1
SB4 B0 . SIGNAL SF TYPE
EQ PMSF
QARBN2 SA4 B6
SB2 X4
SA0 3
SB3 B6
SX6 A0+B2 . NEW BYPASS
RJ RESERVE . RESERVE THREE LOCATIONS
QARBN3 SA1 B3-1 . PUSH PATTERNN TOWARD HIGH CORE
SB2 B2-1 . TO MAKE ROOM FOR ARBNO HEADING
BX7 X1
SB3 A1
SA7 A1+2
NE B2,B0,QARBN3
SX0 ARBNOPM
SX1 PETY
SX2 ENDEXPM
SB1 -1
LX0 48 . PREPARE ARBNOPM OPERATION
LX1 55 . PREPARE PS TYPE HEADING
LX2 48 . PREPARE END EXPRESSION
SX7 X6+B1 . BYPASS FOR ARBNOPM
BX6 X6+X1 . FORM HEADING IN X6
BX7 X7+X0
SA7 B3-B1
SA6 B6
BX7 X2
SX6 MARK . PART OF THE ARBNO OPERATION
SA6 A7-B1
SA7 B6+B1
EQ NEXTMIC
*
ARBNOQ BSS 0
*
*
*
QNXID6 LX5 12 . LEFT JUSTIFY LAST WORD
LX7 X5,B3
SA1 B7
EQ B2,B0,QNXID . RETURN IF NO RESULT
NZ X1,QNXID7
RJ MORFREE
QNXID7 SA7 A1 . STORE LAST WORD
SB7 X1
NG X6,QNXID8 . BYPASS IF NOTHING TO BE FREED
SX7 B7
SB7 B4 . FREE USED INPUT WORDS
SA7 X6
QNXID8 SX6 A1 . LAST
SX7 B2 . LENGTH
LX6 18
LX7 36
SX1 B5 . FIRST
BX6 X7+X6 . FORM SVD IN X6 AND RETURN
BX6 X1+X6
QNXID NO . ENTRY POINT
+ SB4 X4 . FIRST TO BE FREED
SB5 B7 . FIRST
SB2 B0 . FIRST SYMBOL = TRUE
BX5 X5-X5 . CLEAR OUTPUT WORD
SB3 48 . OUTPUT POSITION
EQ QNXID2
QNXID1 ZR X4,QNXID6 . END OF INPUT
SA2 X4 . TAKE NEXT WORD
SX4 X2
SX6 A2 . LAST TO BE FREED
BX2 X2-X4
QNXID2 LX2 6
BX3 -X0*X2 . NEXT INPUT CHARACTER TO X3
ZR X3,QNXID1 . END OF WORD
SX7 X3-1RZ-1
NG X7,QNXID3 . BRANCH IF ALPHABETIC
SX7 X3-1R9-1
EQ B2,B0,QNXID
NG X7,QNXID3 . BRANCH IF DIGIT
SX7 X3-1R.
NZ X7,QNXID6 . BRANCH IF TERMINATOR
QNXID3 SB2 B2+1 . FIRST SYMBOL = FALSE
SB3 B3-6
NE B3,B0,QNXID5 . BYPASS IF OUTPUT WORD NOT FULL
LX5 18
SA1 B7
NZ X1,QNXID4 . GET FREE WORD
RJ MORFREE
QNXID4 SX1 X1
SB7 X1 . ADD LINK
BX7 X5+X1
BX5 X5-X5
SA7 A1+0 . STORE OUTPUT WORD
SB3 42
QNXID5 LX5 6 . PACK NEXT OUTPU0 CHARACTER
BX5 X5+X3
EQ QNXID2
*
SRCHCLL NO
+ SX0 CALLTYP . SEARCH FOR A CALL TYPE ENTRY
RJ INDRX . IN STATIC
EQ B3,B0,SRCHCLL . RETURN IF NEW ENTRY
SA2 X1
BX3 X2
AX3 55
SX7 B7
NZ X3,SRCHCLL . RETURN IF NOT PROCEDURE
SB7 X2 . RELEASE PARAMETERLIST
SRCHC1 SA2 X2
SX2 X2
NZ X2,SRCHC1
SA7 A2
EQ SRCHCLL
*
*
QDEFINE SA1 B6 . STANDARD PROCEDURE DEFINE
SA4 B6-1
MX7 1
SB1 1
SX5 X5-1 . BYPASS IF ONE PARAMETER
ZR X5,QDEF1
SX6 X5-1
NZ X6,ERR20 . MORE THAN TWO PARAMETERS
LX7 54
BX7 X7+X1
SA7 A1 . SET BIT A ON TOP STACK ENTRY
AX1 55
NZ X1,ERR29 . ERROR IF NOT SF
SA2 X4 . FIRST WORD OF STRING
NZ X2,QDEF0 . SECOND ARGUMENT NOT NULL
SX7 B7 . FREE THE
SA7 A2 . NULL SECOND
SB7 A7 . PARAMETER AND
SB6 B6-2 . POP THE STACK
JP QDEFINE . TRY AGAIN
QDEF0 MX0 54 . =HOLE 6
BX2 X2-X2
RJ QNXID . GET IDENTIFIER
NZ X4,ERR44 . ERROR IF TERMINATOR IS NOT END
SA6 B6-1
SB1 0 . SET A FLAG, TWO PARAMS
SA1 B6-2
SA4 B6-3
QDEF1 AX1 55
MX0 54
NZ X1,ERR29 . ERROR, FIRST PARAM NOT SF
BX2 X2-X2
RJ QNXID . GET FIRST IDENTIFIER
EQ B2,B0,ERR44 . ERROR, PROC NAME MISSING
SX7 X3-1R(
NZ X7,ERR44 . TERMINATOR IS NOT (
NE B1,B0,QDEF2
SA6 B6-3
EQ QDEF3
QDEF2 SA6 B6-1 . IF IT IS THE ENTRY LABEL ALSO.
SA1 B6 . SET BIT B ON TOP STACK ENTRY
MX7 2
LX7 54
BX7 X7+X1
SA7 A1
QDEF3 BX6 X6-X6
SB1 B0
SA6 QDEFSV2 . NO OF PARAMS = 0
QDEF4 BX6 X0
RJ QNXID . GET NEXT IDENTIFIER
NZ X3,QDEF5
EQ B2,B0,QDEF6
QDEF5 SB1 B1+1 . BUMP NUMBER OF PARAMS
SA0 2
EQ B2,B0,ERR44
RJ RESERVE . STORE NAME AS A SF TYPE STACK
SA6 B6-1 . ENTRY
SX7 A0
SA7 B6
ZR X3,QDEF6
SX7 X3-1R,
ZR X7,QDEF4
SX7 X3-1R) . ) DELIMITS FORMALS AND LOCALS
NZ X7,ERR44
SA1 QDEFSV2
SX7 B1
NZ X1,ERR44 . TWO )-S IN PROTOTYPE
SA7 A1
EQ QDEF4
QDEF6 SA1 QDEFSV2
ZR X1,ERR44 . ERROR , NO ) IN PROTOTYPE
SX7 B1+2
LX7 37 . APPETITE = 2 * (LOCALS + FORMALS)
LX1 18
BX7 X7+X1 . NO OF FORMALS IS IN X1
SA7 A1
QDEF7 RJ INDRCT . FIND ADDRESS OF NEXT FORMAL
SA2 MINSTAT . PARAM OR LOCAL VARIABLE
EQ QDEF9
QDEF8 SA2 B1+0
QDEF9 SB1 X2
NE B1,B0,QDEF8
SX7 B7
BX7 X2+X7 . PUT THE ADDRESS ON A LIST
SA7 A2
SX6 X1
SA1 B7
NZ X1,QDEF10
RJ MORFREE
QDEF10 SB7 X1
LX6 18
SA3 B6
SA6 A1
LX3 6
PL X3,QDEF7 . JUMP BACK IF BIT A IS NOT SET
SB4 B0 . SIGNAL SF TYPE FOR INDRX
SA4 B6-1
SX0 LBLTYP . FIND STATIC ADDRESS OF THE
RJ INDRX . ENTRY LABEL
SX6 X1
SA6 QDEFSV1
MX7 17
NE B3,B0,QDEF11
LX7 18 . INITIALIZE LABEL IF NEW RECORD
SA7 X1
QDEF11 SA1 B6
LX1 7
NG X1,QDEF12
SA1 B6-1 . RELEASE THE STRING CONTAINING
SX7 B7 . THE ENTRY NAME IF BIT B IS NOT
SB7 X1 . SET
AX1 18
SA7 X1
SB6 B6-2
QDEF12 SA4 B6-1 . FIND STATIC ADDRESS OF THE
RJ SRCHCLL . PROCEDURE
SX7 X1+0
SA7 QDEFSV3
RJ INDRCT . LOOK UF VARIABLE HAVING
SX6 B7 . THE SAME NAME AS THE PROCEDURE
SB6 B6+2 . RESET STACK POINTER
LX1 18 . FORM PARAMETER LIST BY CONCATE-
SA2 QDEFSV3 . NATING THE REVERSED LIST OF
BX6 X6+X1 . STATIC ADDRESSES AND THE
SB2 X2 . ADDRESS OF THE ENTRY LABEL
SA1 B7
SA2 QDEFSV1
MX0 1 . THIS BIT SIGNALS THE END OF LIST
NZ X1,QDEF13A
RJ MORFREE
QDEF13A SB7 X1
LX2 18
BX7 X2+X0
SA7 A1
SA1 B7
SA4 MINSTAT
SB1 B7
NZ X1,QDEF13B
RJ MORFREE
QDEF13B SB7 X1
SA6 A1+0
SA2 X4
BX6 X6-X6
SA6 X4 . CLEAR XWRD
SB3 X2
QDEF14 SA3 X2 . NEXT WORD FROM ADDRESS LIST
SX2 X3
BX3 X3-X2
SB4 A3
SA1 B7
NZ X1,QDEF15
RJ MORFREE
QDEF15 SB7 X1
SX1 X1
SX7 B1
SB1 A1
BX7 X3+X7
SA7 A1 . NEXT WORD TO PARAM LIST
NZ X2,QDEF14
SA2 QDEFSV2
SX1 B1
BX7 X1+X2
SA7 B2 . ASSIGN THE PARAM LIST IS THE
SX6 B7 . STATIC ENTRY
SB7 B3
SA6 B4
MX0 5
RJ ZROX7 . RESULT OF DEFINE IS A NULL STRING
SX6 2
BX7 -X0*X7 . CLEAR SS TYPE
SA6 B6
SA7 B6-1
EQ NEXTMIC
DEFINEQ BSS 0
*
*
QDIFFER SB5 B0 . DIFFER FLAG
EQ QCOMP
QIDENT SB5 1 . IDENT FLAG
QCOMP SB1 X5-2
GT B1,B0,ERR20 . TOO MANY PARAMETERS
SB4 1 . SET IDENT FLAG
LT B1,B0,QCOMP6 . NULL SECOND PARAMETER
SA1 B6
BX0 X1 . SAVE HEADER WORD
AX1 55
NZ X1,QCOMP8 . SECOND PARAMETER IS NOT SF
QCOMP1 SA1 B6-2
BX0 X1 . SAVE HEADER WORD
AX1 55
NZ X1,QCOMP14 . FIRST PARAMETER NOT SF
SA1 B6-3 . FIRST SVD
QCOMP2 BX0 X1
SX7 B7 . PREPARE TO FREE SF
SB7 X0
AX0 18
SA2 X0
BX7 X2+X7
SA7 X0
AX0 18 . SAVE LENGTH OF STRING
SA2 B6-1 . SECOND SVD
BX5 X2
SX6 B7
SB7 X5
AX5 18
SA3 X5
BX7 X3+X6
SA7 X5
AX5 18 . LENGTH OF STRING
SB6 B6-4 . POP DESCRIPTORS FROM STACK
IX5 X0-X5 . COMPARE LENGTH
NZ X5,QCOMP5 . DIFFER
QCOMP3 SA3 X1
SX1 X3 . LINK OF STRING ONE
SA4 X2
BX3 X1-X3
SX2 X4 . LINK TO STRING TWO
BX4 X2-X4
BX3 X3-X4 . COMPARE STRING WORDS
BX4 X2-X6 . SEE IF END OF STRING
NZ X3,QCOMP5 . DIFFER
NZ X4,QCOMP3 . TRY NEXT PAIR
QCOMP4 NE B4,B5,FAIL
MKNULL RJ ZROX7
MX0 5
BX7 -X0*X7 . CLEAR SS TYPE
SA7 B6+1
SX6 2
SB6 B6+2
SA6 B6
EQ NEXTMIC
QCOMP5 SB4 B0 . SET DIFFER FLAG
EQ QCOMP4
QCOMP6 SA1 B6 . HEADER WORD
BX0 X1
SA2 B6-1
AX1 55
NZ X1,QCOMP12 . GO POP STACK, REPORT DIFFER
SA1 X2 . FIRST STRING WORD
ZR X1,QCOMP7 . IDENT
SB4 B0 . SET DIFFER F-AG
QCOMP7 SX7 B7 . PREPARE TO FREE SF
SB7 X2
AX2 18
SA7 X2
SB6 B6-2
EQ QCOMP4
QCOMP8 SX1 X1-ITY
NZ X1,QCOMP9
SA1 B6-1
RJ ITOSF
SA6 B6-1
EQ QCOMP1
QCOMP9 SB3 X0 . BYPASS OF SECOND PARAM
SA2 B6-B3
BX3 X0-X2
SB6 B6-B3 . POP SECOND PARAMETER
NZ X3,QCOMP13 . DIFFER
SB3 B3-1 . GET WORD COUNT
QCOMP10 SA1 A1-B4
SA2 A2-B4
IX1 X1-X2
SB3 B3-B4 . DECREMENT WORD COUNT
NZ X1,QCOMP12 . DIFFER
NZ B3,QCOMP10
QCOMP11 SB3 X0
SB6 B6-B3 . POP FIRST PARAM
EQ QCOMP4
QCOMP12 SB4 B0 . SET DIFFER FLAG
EQ QCOMP11
QCOMP13 BX0 X2 . SAVE SVD
AX2 55
SB4 B0 . SET DIFFER FLAG
NZ X2,QCOMP11 . POP FIRST PARAMETER, EXIT
SA2 B6-1
EQ QCOMP7 . FREE FIRST PARAMETER, EXIT
QCOMP14 SX1 X1-ITY
NZ X1,QCOMP15
SA1 B6-3
RJ ITOSF
BX1 X6
EQ QCOMP2
QCOMP15 SA1 B6-B4 . PREPARE TO FREE SECOND PARAMETER
SX7 B7
SB7 X1
AX1 18
SA7 X1
SB6 A1-B4
EQ QCOMP12 . SET DIFFER FLAG AND POP FIRST PARAM
*
COMPQ BSS 0
*
QSTAR SX5 X5-1
NZ X5,ERR20 ONLY ONE ARGUMENT IF YOU PLEASE
SA1 B6 PICK UP THE DESCRIPTOR
AX1 55 SHIFT THE DESCRIPTOR TO THE TYPE FIELD
ZR X1,HEXTERN STRING TO INTEGER CONVERSION DESIRED
SX1 X1-ITY IS IT AN INTEGER
NZ X1,ERR29 WHAT DO YOU WANT, MAGIC.....
SA1 B6-1 PICK UP THE INTEGER
HEXUDE MX2 1 PREPARE TO PICK OFF THE TOP BIT
BX2 X2*X1 PICK OFF THE SIGN BIT
MX4 12
BX1 -X4*X1
LX2 1 SHIFT THE SIGN BIT TO ADD POSITION
IX1 X2+X1 MAKE THE NUMBER TWOS COMPLEMENT
MX0 56 THE COMPLEMENT OF THE FOUR BIT MASK
SX4 1777B THIS IS THE NUMBER OF TIMES AROUND THE LOOP
MX6 0 CLEAR THE FIRST WORD RESULT REGISTER
HEXED BX3 -X0*X1 PICK OFF A CHARACTER
AX1 4 SHIFT THE SOURCE WORD ONE CHARACTER
SX2 X3-12B IS IT 0-9 OR A-F
PL X2,HEXALL GO WASH YOUR MOUTH OUT
SX3 X3+44B IT IS A DIGIT 0-9 ADD IN 33B
HEXALL SX3 X3-11B
AX4 1 DECREMENT THE COUNTER (NOTE PALINDROMIC SHIFTS)
BX6 X6+X3 OR THE CHARACTER INTO THE RESULT REGISTER
LX6 60-6 SHIFT THE RESULT ONE PARCEL RIGHT
NZ X4,HEXED SHOULD WE DO IT AGAIN
MX4 30 PICK UP THE LOW FIVE CHARACTERS
BX7 -X4*X6 LOAD THEM INTO THE SECOND WORD
BX6 X4*X6 KILL OFF THE OLD BITS IN X6
SX4 3 WE GO AROUND THIS LOOP TWICE
HEXAGON BX3 -X0*X1 PICJ UP YE OLDE CHARACTER
AX1 4 END OFF THE DATA WORD
SX2 X3-12B AGAIN, ARE WE FISH OR FOWL
PL X2,NOHEX
SX3 X3+44B CLEARLY IT IS A FOWL
NOHEX SX3 X3-11B BIRDS AND FISH ARE RELATED
AX4 1 DECREMENT THE LOOP COUNTER IN TIME FOR CHRISTMAS
BX6 X6+X3 OR THE CHARACTER INTO THE DESTINATION REG
LX6 60-6 SHIFT THE DESTINATION REGISTER RIGHT
NZ X4,HEXAGON SIX SIDES TIME TWO MAKE TWELVE CHARS.
SX1 B7 PICK UP THE NEXT FREE WORD ADDRESS
MX0 2 THIS IS AN 12B BELIEVE IT OR NOT
LX0 36+4 ONE FOR ME AND ONE FOR YOU
BX4 X1+X0 OR IN THE LINK ADDRESS
SA1 B7 PCIK UP THE POINTER TO THE NEXT FREE WORD
NZ X1,HEXSTAR IF THERE IS ONE OKAY, IF NOT THEN
RJ MORFREE REQUEST MORE GARBAGE FROM THE FSL
HEXSTAR SB7 X1 PICK UP THE CHAIN ADDRESS
SX1 X1 ONLY 18 BITS SURVIVE
BX6 X6+X1 OR THE DATA INTO THE CHAIN LINK ADDRESS
SA6 A1 STORE THE DATA AND CHAIN IN THE INDICATED ADDRES
LX7 30 JUSTIFY THE SECOND WORD PROPERLY
SA1 B7 AND GET THE NEXT FREE WORD POINTER
NZ X1,STARHEX IF NONE IS AVAILABLE GET SOME
RJ MORFREE SOME IS GOTTEN
STARHEX SB7 X1 GET THE CHAIN POINTER BACK INTO B7
SX1 X1 TRUNCATE ALL BUT THE BOTTOM 18 BITS
SX5 A1 GET THE CHAIN ADDRESS
SA7 A1 STUFF THE WORD AWAY
LX5 18 SHIFT FOR THE DESCRIPTOR
BX6 X4+X5 LOAD THE DESCRITOR WITH THE END
SA6 B6-1 LOAD THE DESCRIPTOR ADDRESS
SX7 2 ALMOST DONE
SA7 B6 ALL DONE NOW
EQ NEXTMIC GO TO THE NEXT MICROP
HEXTERN SA1 B6-1 GET THE ACTUAL PARAMETER
MX0 42
BX6 X6-X6 IDLE UNITS ARE THE DEVIL PLAYTHINGS
MX3 6
BX7 X7-X7
HEXCITE BX2 -X0*X1 YANK OFF THE LINK ADDRESS
BX1 X0*X1 TRIM THE DATA OFF THE WORD
HEXAM BX4 X3*X1 MUNCH OFF A CHARACTER
BX1 -X3*X1 DELETE THE CHARACTER FROM THE WORD
LX4 6 ROUND THE ROSY ONE CHARACTER
LX1 6 LIKEWISE IM SURE
ZR X4,HEXCISE IF CHARACTER IS NULL,CHECK LINK
SX5 X4-1R- MINUS SIGN PERCHANCE
ZR X5,HEXCELL WHY YES IT IS A MINUS SIGN
SX5 X4-1R+ WHAT ABOUT A UNARY PLUS SIGN
ZR X5,HEXAM IF IT IS IGNORE IT THOROUGHLY
SX5 X4-45B ARE WE IN THE BOUNDS OF AN INTEGER
PL X5,FAIL THOUGHT YOUWOULD SLIP ONE OVER ON ME DID YOU
SX5 X4-33B CHECK LOWER BOUND
NG X5,FAIL NAUGHTY,NAUGHTY TO FOOL MOTHER NATURE
BX4 X6 LOOK HOW I MULTIPLY BY TEN
LX4 1 TIMES TWO
LX6 3 TIMES EIGHT
IX6 X6+X4 AND WE GET TIMES TEN
IX6 X6+X5 ADD IN THE NEW CHARACTER
EQ HEXAM OFF WE GO INTO THE WIDE BLUE YONDER
HEXCISE ZR X2,HEXTANT NOW CUT THAT OUT(PUN)
SA1 X2 PICK UP THE WORD POINTED TO BY THE LINK
EQ HEXCITE TURN ON THE PROCESS AGAIN
HEXCELL BX7 -X7 GEN UP A WORD OF ALL ONES
EQ HEXAM SHAZZAN
HEXTANT BX1 X6-X7 COMPLEMENT IF NECESSARY
EQ HEXUDE EXUDE CONFIDENCE THAT WE ARE DONE
STARQ BSS 0
QUNSTAR SX5 X5-1
NZ X5,ERR20 TWO MANY ARGUMENTS(PUN)
SA1 B6 PCIK UP THE DESCRIPTOR
AX1 55 OFF WITH HIS HEAD
ZR X1,HEXTINT STRING IN
SX1 X1-ITY IS IT AN INTEGER
NZ X1,ERR29 NO ITS NOT, ZAPPPPP....
EQ FAIL DONT CALL ME ILL CALL YOU
HEXTINT SA1 B6-1 PICK UP THE VARIABLE FIRST WORD
MX0 42
BX6 X6-X6
MX3 6
HEXNEXT BX2 -X0*X1 PICK UP THE LINK ADDRESS (IF ANY)
BX1 X0*X1 MASK THE DATA REGISTER
HEXIT BX4 X3*X1 PCIK UP ONE CHARACTER
BX1 -X3*X1 CLEAN OUT THAT CHARACTER
LX4 6 SHIFT THE CHARACTER TO THE LOW BYTE
LX1 6 SHIFT THE HOLE IN THE DATA WORD TO THE LOW BYTE
ZR X4,HEXOUT IF NO CHARACTER CHECK FOR NEXT LINKAGE
SX5 X4-45B DID WE OVERSHOOT
PL X5,FAIL
SX5 X4-33B IS THIS A DECIMAL NUMBER
PL X5,PUREHEX YES IT IS, JUMP TO STORAGE ROUTINE
SX5 X4-7B IS IT A VALID HEXADECIMAL DIGIT
PL X5,FAIL
SX5 X4+11B CONVERT IT TO BINARY
PUREHEX LX6 4 SHIFT THE DESTINATION REGISTER TO ACCEPT THE OR
BX6 X6+X5 OR IN THE CHARACTER
EQ HEXIT GO BACK AND TRY IT AGAIN
HEXOUT ZR X2,HEXDONE
SA1 X2 PICK UP THE NEXT WORD IN THE CHAIN
EQ HEXNEXT
HEXDONE MX0 12
BX6 -X0*X6 CLEAR THE HIGH BITS JUST IN CASE
MX3 13
BX3 X3*X6 PICK OFF THE HEXADECIMAL SIGN BIT
LX3 13
IX6 X6-X3 SUBTRACT OFF THE ADDITIONAL COMPLEMENT
LX6 12 POSIITION THE HEX SIGN BIT TO THE TOP
AX6 12 SHIFT THE BIT INTO ALL 12 POSITIONS
SA6 B6-1
SX7 ITY
LX7 55
SX1 2
BX7 X1+X7
SA7 B6
EQ NEXTMIC
UNSTARQ BSS 0
QCNVT SX5 X5-1
NZ X5,ERR20 . TOO MANY PARAMETERS
SA1 B6
AX1 55 . EXAMINE TYPE
ZR X1,QCNVT3 . SFTY
SX1 X1-RTY
NZ X1,QCNVT1 . INTEGER OR WHAT
SA1 B6-1
RJ RTOSF
SA6 B6-1
SX7 SSTY STRING TYPE AS RESULT
SA7 B6
EQ NEXTMIC
QCNVT1 SX1 X1+RTY-ITY
NZ X1,ERR29 . PARAMETER TYPE ERROR
SA1 B6-1
PX6 X1
NX6 X6
QCNVT2 SA6 B6-1
SX7 RTY
LX7 55
SX1 2
BX7 X1+X7
SA7 B6
EQ NEXTMIC
QCNVT3 BX7 X7-X7 . SIGN ASSUMED POSITIVE
MX6 0
SB4 0
SA1 B6-1 . SVD
SX0 77B
MX5 0
SB5 B0
SB4 B0
SA4 TEN
QCNVT4 ZR X1,QCNVT9 . END OF STRING
SA2 X1+0 . NEXT STRING WORD
SX1 X2+0 . LINK
BX2 X2-X1 . CLEAR LOWER 18 BITS
QCNVT5 LX2 6
BX3 X0*X2
ZR X3,QCNVT4
SX3 X3-1R0
NG X3,ERR53 . ILLEGAL CHARACTER IN REAL NUMBER
SB2 X3-1R++1R0
GE B2,B0,QCNVT7 . NOT DIGIT
PX3 X3
NX3 X3
NZ B4,QCNVT6 . STATE IS AFTER POINT
FX6 X6*X4 . NUMBER := NUMBER * 10
FX6 X3+X6 . NUMBER := NUMBER + NEW DIGIT
SB5 1R9-1R- . STATE ]= AFTER SIGN
EQ QCNVT5
QCNVT6 FX3 X3*X5 . SCALE NEW DIGIT
FX5 X5*X4
FX6 X3+X6
EQ QCNVT5
QCNVT7 SB2 X3-1R.+1R0
EQ B2,B4,QCNVT8 . POINT, IN -BEFORE POINT- STATE
SB2 X3-1R-+1R0
GT B2,B5,ERR53 . ILLEGAL CHARACTER (INCLUDING
* POINT OR SIGN IN WRONG STATE)
SB5 1R9-1R- . STATE ]=AFTER SIGN
NG B2,QCNVT5 . SIGN WAS +
MX7 60 . NEGATIVE
EQ QCNVT5
QCNVT8 SA4 ONETENTH
SB4 77B-1R.+1 . STATE ]= AFTER POINT (77B IS CODE
* FOR SEMICOLON - SEE TEST AT QCNVT7)
BX5 X4
EQ QCNVT5
QCNVT9 SA1 B6-1
BX6 X6-X7 . GIVE RESULT PROPER SIGN
SX7 B7
SB7 X1
AX1 18
SA7 X1+0 . FREE SF STRING
EQ QCNVT2
ONETENTH DATA 0.1E0
CNVTQ BSS 0
*
QARRAY SX5 X5-1 . X5 CONTAINS NO. OF PARAMETERS
NZ X5,ERR20 . TOO MANY PARAMETERS
SA1 B6 . DESCRIPTOR FROM TOP OF STACK
AX1 55
NZ X1,QAR18 . IF NOT SF, MUST BE INTEGER
QAR0 SA1 MINSTAT
SB5 X1+XWDREL . XWDREL IS KNOWN BY GARBCOLL.
SA1 B6-1 . SVD
SX6 X1
SA6 B5 . INITIALIZE XWDREL = NEXT STRING WRD
SX4 1
SA1 MAXSTAT
SX6 X1
PX4 X4 . X4 WILL CONTAIN ARRAYSIZE
SA6 QARSV . SAVE OLD MAXSTAT
SX6 X6+1
SB6 B6-2 . POP PARAMETER FROM STACK
SA6 A1 . LET MAXSTAT POINT AFTER HEADER WORD
BX2 X2-X2 . X2 WILL CONTAIN CURRENT STRING WORD
SX0 77B . ONE CHARACTER MASK
QAR1 SX3 0 . INTEGER := 0
SB4 B0 . INSIDENUMBER := -FALSE-
MX5 60 . BEFORECOLON := -TRUE-
QAR2 LX2 6
BX1 X0*X2 . EXAMINE NEXT CHARACTER
NZ X1,QAR3
SA1 B5 . ADDRESS OF NEXT WORD
ZR X1,QAR10 . END OF STRING
SA2 X1 . PICK UP NEW WORD
SX7 B7 . PUT SF
SA7 X1 . WORD ONTO
SB7 X1 . FREE CHAIN
SX7 X2 . LINK
SA7 B5
BX2 X2-X7 . CLEAR LOWER 18 BITS
EQ QAR2 . TRY AGIAN
QAR3 SX6 X1-1R0
NG X6,ERR39 . MALFORMED PROTOTYPE (ILLEGAL CHAR)
SX7 X6-10
NG X7,QAR4 . DIGIT
SX6 X7-2
NG X6,QAR6 . SIGN
SX6 X1-1R,
ZR X6,QAR7 . COMMA
SX6 X1-1R:
ZR X6,QAR8 . COLON
SX6 X1-1R/
ZR X6,QAR8 . COLON
EQ ERR39 . MFP (ILLEGAL CHAR, AGAIN)
QAR4 NZ B4,QAR5 . -IF- INSIDENUMBER -THEN- -JUMP-
SB4 1 . INSIDENUMBER := -TRUE-
SX3 X6 . INTEGER := DIGIT
EQ QAR2
QAR5 LX3 1
BX7 X3
LX3 2
IX3 X3+X7
IX3 X3+X6 . INTEGER := INTEGER * 10 + DIGIT
EQ QAR2
QAR6 NZ B4,ERR43 . SYNTAX ERROR (TWO SIGNS)
BX7 -X7
IX7 X7+X7
SB4 X7+1 . SIGN := +1 OR -1
EQ QAR2
QAR7 SX6 QAR1 . RETURN ADDRESS
EQ QAR13 . PROCESS COMMA
QAR8 PL X5,ERR43 . SYNTAX ERROR (TWO COLONS)
NZ X5,ERR43 . SYNTAX ERROR (TWO COLONS)
MX1 43
BX1 X1*X3
NZ X1,ERR49 . LOWER BOUND TOO LARGE
BX5 X3
GE B4,B0,QAR9 . -IF- SIGN = + -THEN- -JUMP-
BX5 -X3
QAR9 BX3 X3-X3 . INTEGER := 0
SB4 B0 . INSIDENUMBER := -FALSE-
EQ QAR2
QAR10 SX6 QAR11 . RETURN ADDRESS
EQ QAR13 . PROCESS IMPLIED COMMA
QAR11 MX7 1 . FLAG TO MARK LAST DESCRIPTOR
BX7 X6+X7 . X6 CONTAINS LAST DESCRIPTOR
SA7 A6
UX4 X4
IX7 X3+X4 . X3 CONTAINS C(MAXSTAT)
SA2 MINSTAK
SA7 A3 . NEW MAXSTAT
LX5 18 . X5 ALSO CONTAINS OLD MAXSTAT
SA1 QARSV
IX6 X3-X1 . CALCULATE BYPASS
SX0 SPCTYP . STATIC RECORD TYPE
LX6 18
LX0 55
BX6 X0+X6
SA6 X1
SX0 X1+0 . DOPE ADDRESS
BX5 X0+X5 . COMBINE WITH BASE ADDRESS
IX2 X7-X2
NG X2,QAR12 . ROOM EXISTS FOR ARRAY
SB3 X2+BUFF4
RJ PUSHSTK . MAKE ROOM
QAR12 SX4 X4-1 . DECREMENT ARRAY LENGTH
RJ ZROX7 . MAKE NULL VALUE
SA7 X3+0
SX3 X3+1
NZ X4,QAR12
SX6 ATY . ARRAY TYPE
SA0 2
RJ RESERVE . GET TWO STACK WORDS
LX6 55
BX7 X5+X6
SA7 B6-1
SX7 2
BX7 X6+X7
SA7 B6
EQ NEXTMIC
QAR13 MX7 1
LX7 57
LX6 30
BX6 X6+X7
SA6 QAR17 . RETURN INSTRUCION
MX1 43
BX7 X1*X3
NZ X7,ERR49 . UPPPER BOUND TOO LARGE
PL X5,QAR14 . -IF- ~BEFORECOLON -THEN- -JUMP-
NZ X5,QAR14 . -IF- ~BEFORECOLON -THEN- -JUMP-
SX5 1 . LOWERBOUND := 1 BY DEFAULT
QAR14 PL B4,QAR15 . UPPER IS POSITIVE
BX3 -X3 . UPPER IS NEGATIVE
QAR15 IX7 X3-X5 . UPPER - LOWER
SX6 X7+1 . U - L + 1
BX1 X1*X6
SX7 X7 . BANISH MINUS ZERO
NG X7,ERR48 . NON-POSITIVE DIMENSION
PX7 X6
DX4 X4*X7 . ARRAYSIZE := ARRAYSIZE * DIMENSION
MX7 42
BX5 -X7*X5 . MAKE 60 BITS FIT INTO 18
BX3 -X7*X3
LX5 18 . LOWER BOUND
BX5 X3+X5 . UPPERBOUND
LX6 36 . U-L+1
BX6 X5+X6
NZ X1,ERR50 . DIMENSION TOO LARGE
SA3 MAXSTAT
SX7 X3+1
SA1 MINSTAK
SA7 A3 . UPDATE MAXSTAT
IX1 X7-X1
NG X1,QAR16 . STATIC AND STACK HAVE NOT COLLIDED
SB3 X1+BUFF4
RJ PUSHSTK . MAKE ROOM
QAR16 SA3 A3 . MAXSTAT AGAIN
SA6 X3-1 . STORE DESCRIPTOR
BX5 X3 . LEAVE MAXSTAT IN X3, X5
QAR17 EQ * . RETURN WORD
QAR18 SX1 X1-ITY
NZ X1,ERR29 . WRONG PARAMETER TYPE
SA1 B6-1
RJ ITOSF
SA6 B6-1
EQ QAR0
ARRAYQ BSS 0
*
*
* REMARK PUTS A MESSAGE ON THE DAYFILE, USING THE SCOPE FUNCTION MSG.
* UNDER PSEUDO-SCOPE (TSS), MSG-S GO TO THE TELETYPE, AND THUS WE HAVE
* THE PROCEDURE OUT. THE ARGUMENT IS A SINGLE STRING OR INTEGER.
*
*
QREMARK SX5 X5-1
NZ X5,ERR20 . TOO MANY ACTUAL PARAMETERS
SA2 B6
AX2 55
SA1 B6-1
BX6 X1
ZR X2,QREMARK1 . PARAMETER IS STRING
SX2 X2-ITY
NZ X2,ERR29 . NOT INTEGER, TYPE ERROR
RJ ITOSF INTEGER IN X1 TO SVD IN X6
SX7 2
SA6 B6-1 . STORE NEWLY MADE SVD
NO
NO
SA7 B6+0 . STORE STACK BYPASS
QREMARK1 SX7 B6-1 . ADDRESS OF STRING SVD
SX5 QRMKFET-1
LX5 18
AX6 36
SX6 X6-81
PL X6,ERR56 . MESSAGE TOO LONG
SX6 QRMKBUF
BX7 X5+X7
SA7 QRMKSVD
SB3 A7 . PARAM FOR OUTPUT ROUTINE
SA6 QRMKFET+1 . PSEUDO FIRST POINTER
SA6 A6+1 . IN
SA6 A6+1 . OUT
SX6 X6+QRMKBUFL
SA6 A6+1 . LIMIT
RJ OUTPUT
SX6 QRMKBUF
SA1 QRMKCALL . MSG CALL
LX6 30
BX7 X1
SA6 QRMKSTAT
SA7 1
SX5 1 . =1, FOR QIF
+ SA1 1
NZ X1,* . WAIT FOR RA+1 TO CLEAR
EQ QIF
*
QRMKCALL VFD 18/3LMSG,2/1,40/QRMKSTAT
*
QRMKSVD EQU PMASX3
QRMKSTAT EQU PMASX3
QRMKFET EQU 2
QRMKBUF EQU 2+5
QRMKBUFL EQU 3*8 . LONG ENOUGH SO BUFFER WILL NEVER BE
. MORE THAN 1/2 FULL, SO OUTPUT WILL
. NOT TRY TO ISSUE A WRITE
*
REMARKQ BSS 0
*
IN IFNE TSS,0
*
* IN IS THE PROCEDURE USED TO COLLECT THE NEXT LINE FROM THE TELETYPE.
* IT CALLS THE PSEUDO-SCOPE (TSS) FUNCTION GSM (MSG BACKWARDS), WHICH
* RETURNS A LIST OF CHARACTERS IN R1 FORMAT. THE COMPILER STACK SPACE IN
* LOW CORE, 2 THROUGH 2+STAKSP-1, IS USED AS THE BUFFER SPACE. IN
* ADDITION, RTOSF0, PART OF THE REAL-TO-STRING CONVERSION ROUTINE, IS
* USED TO BUILD A SNOBOL STRING FROM THE INDIVIDUAL CHARACTERS. IN TAKES
* A SINGLE, ARBITRARY ARGUMENT.
*
QIN SX5 X5-1
NZ X5,ERR20 . TOO MANY ACTUAL PARAMETERS
SA1 B6
SB5 X1
SB6 B6-B5 . POP STACK
AX1 55
NZ X1,QINA . NOT STRING
SA1 B6+1
SX7 B7
SB7 X1 . FREE SF TYPE
AX1 18
SA7 X1
QINA SA1 QINCALL . GSM CALL (TELETYPE INPUT)
BX7 X1
BX6 X6-X6 . INITIALIZE CHARACTER BUFFER
SA7 1
SB5 42 . INITIALIZE BIT COUNT
+ SA1 A7
NZ X1,* . WAIT FOR RA+1 TO CLEAR
SA0 B0 . INITIALIZE CHARACTER COUNT
SB4 QINE . 'RETURN' FROM RTOSF0
SA3 MINSTAT
SA4 QINBUFF
SX7 B7
BX0 X4
SA7 X3+XWDREL . SAVE START OF NEW STRING
NZ X4,RTOSF0
QINB SX5 A0
LX5 36 . POSITION CHARACTER COUNT
SB5 B5+18
LX6 B5,X6 . LEFT JUSTIFY LAST WORD
SA1 B7
NZ X1,QINC
RJ MORFREE
QINC SA6 A1+0
SB7 X1+0
SX6 A6 . LWA
LX6 18
BX6 X6+X7 . FWA
BX6 X5+X6 . CHARACTER SOUNT
SX7 2
SB6 B6+X7 . BUMP STACK POINTER
SA7 B6
SA6 B6-1
BX6 X6-X6
SA6 X3+XWDREL . ZERO OUT THE WORD
EQ NEXTMIC
*
QINE SA4 A4+1
ZR X4,QINB . END OF LINE
BX0 X4
EQ RTOSF0
*
QINCALL VFD 18/3LGSM,42/QINBUFF
*
QINBUFF EQU 2 . (LENGTH IS STAKSP)
*
INQ BSS 0
*
IN ENDIF
*
* TIME IS A SNOBOL PRIMITIVE FUNCTION WHICH RETURNS AN 8 CHARACTER
* PARAMETER(S) (IGNORED) ARE ARBITRARY IN TYPE AND NUMBER.
QTIME SB1 QTD . RETURN
SX4 8 . LENGTH OF VALUE STRING
MX3 6 . 1 CHARACTER MASK
* LEFT-JUSTIFIED, BLANK FILLED. TOD USES A1-X1,X2,A6-X6, AND RETURNS TO
* THE ADDRESS PASSED TO IT IN B1.
TOD SA1 TODCALL . SCOPE RA+1 REQUEST WORD
BX6 X1
BX7 X7-X7
SA7 TODWD . THE LOW ORDER BIT OF THE RESPONSE
* WORD IS NON-ZERO WHEN THE REQUEST
* PROCESSING IS COMPLETE
SA6 1 . ISSUE REQUEST
TOD1 SA1 1
NZ X1,TOD1 . WAIT FOR COMPLETION
SA1 TODWD . TIME, IN BHH.MM.SS. FORMAT
SA2 TODMASK
BX6 X1-X2 . CHANGE DOTS TO COLONS AND BLANK
LX6 6 . LEFT JUSTIFY
JP B1 . RETURN
TODCALL VFD 18/3LTIM . PP ROUTINE
VFD 2/1 . RECALL DESIRED
VFD 16/2 . TIM FUNCTION FOR T-O-D
VFD 24/TODWD . ADDRESS FOR RESPONSE
TODWD EQU PMASX3
TODMASK VFD 24/34B,18/34B,18/2
* DATE IS LIKE TIME, EXCEPT IT RETURNS A 9 CHARACTER STRING, AS
* 10 JUL 70.
QDATE SB1 QTD
SX4 9
MX3 2*6
* CALENDR RETURNS THE CURRENT DATE IN X6, FORMATTED AS 10 JUL 70, LEFT
* JUSTIFIED, BLANK FILLED. CALENDR USES X0,A1-X1,X2,A6-X6. IT RETURNS TO
* THE ADDRESS PASSED TO IT IN B1.
CALENDR SA1 DATCALL
BX6 X1
BX7 X7-X7
SA7 DATWD . CLEAR RESPONSE WORD
SA6 1 . ISSUE REQUEST
CAL1 SA1 A6
NZ X1,CAL1 . WAIT FOR COMPLETION
MX0 60-18 . =HOLE 18
SA1 DATWD . DATE, IN BMM/DD/YYB FORMAT
BX6 -X0*X1 . YYB
LX1 4*6 . LEFT JUSTIFY DD...
MX0 6+6
BX0 X0*X1
BX6 X0+X6 . DD00000YYB
AX1 6 . RIGHT JUSTIFY ONES DIGIT OF MONTH
MX0 60-6
BX2 -X0*X1
SX2 X2-1R0-1 . CONVERT TO BINARY (AND SUBTRACT 1)
AX1 6
BX1 -X0*X1 . TENS DIGIT OF MONTH
SX1 X1-1R0 . CONVERT TO BINARY
LX1 1 . 2 * TENS
IX2 X1+X2 . 2 * TENS + ONES - 1
LX1 2 . 8 * TENS
IX2 X1+X2 . 10 * TENS + ONES - 1
LX2 59 . DIVIDE BY 2
SA1 MONTHS+X2
MX0 30
NG X2,CAL2 . ODD
LX1 30 . EVEN
CAL2 BX1 -X0*X1
LX1 18
BX6 X6+X1 . ADD ABBREVIATION FOR MONTH
JP B1 . RETURN
DATCALL VFD 18/3LTIM . PP ROUTINE
VFD 2/1 . RECALL DESIRED
VFD 16/1 . TIM FUNCTION FOR DATE
VFD 24/DATWD . RESPONSE ADDRESS
DATWD EQU PMASX3
M MACRO E,O
VFD 6/1R ,18/3R_E,12/2R ,18/3R_O,6/1R
ENDM
MONTHS M JAN,FEB
M MAR,APR
M MAY,JUN
M JUL,AUG
M SEP,OCT
M NOV,DEC
QTD MX0 7*6
BX7 X0*X6 . FIRST 7 CHARACTERS
LX6 7*6
GETL . GET A (CLEARED) FREELIST WORD IN X1
SX2 A1 . SAVE ADDRESS OF THIS FREE WORD
BX7 X7+X1
SA7 A1
BX6 X3*X6
LX4 18+18 . POSITION FUTURE SVD LENGTH FIELD
GETL
SA6 A1
SX6 A6 . LWA FOR SVD TO BE CONSTRUCTED
LX6 18
BX6 X4+X6
BX6 X6+X2
SX2 2 . STACK BYPASS WORD (TYPE = SF = 0)
QTDC SA1 B6 . STACK BYPASS OF PARAMETER
SB1 X1
SB6 B6-B1 . POP PARAMETER
AX1 55
NZ X1,QTDC1 . NOT SF, SO NOTHING TO FREE
SA1 A1-1 . SF SVD
SX7 B7
SB7 X1
AX1 18
SA7 X1 . LET LAST STRING WORD LINK TO FREE
QTDC1 SX5 X5-1 . DECREMENT ACTUAL PARAMETER COUNT
NZ X5,QTDC . POP ANOTHER
SB6 B6+2 . STACK-SPACE FOR VALUE
BX7 X2
SA7 B6 . BYPASS WORD
SA6 B6-1 . VALUE WORD
JP NEXTMIC . FINISHED
* CLOCK IS SIMILAR TO DATE AND TIME, BUT IT RETURNS AN INTEGER
* REPRESENTING THE NUMBER OF MILLISECONDS OF CPU TIME THE JOB HAS
* CONSUMED SO FAR.
QCLOCK SA1 CLKCALL
BX6 X1
BX7 X7-X7
SA7 CLKWD . CLEAR RESPONSE WORD
SA6 1 . ISSUE REQUEST
QCLK1 SA1 A6
NZ X1,QCLK1 . WAIT FOR COMPLETION
MX0 48
SA1 CLKWD . 48/SECONDS,12/MILLISECONDS
BX6 -X0*X1
MX0 15
LX0 15+12
BX1 X1*X0
LX1 60-12+3
BX2 X1
LX1 1 . 16 * SECONDS
IX2 X2+X1 . 24 * SECONDS
LX1 6 . 1024 * SECONDS
IX1 X1-X2 . 1000 * SECONDS
SA2 ITYWD
IX6 X1+X6
JP QTDC
CLKCALL VFD 18/3LTIM . PP ROUTINE
VFD 2/1 . RECALL DESIRED
VFD 16/0 . TIM FUNCTION FOR ELAPSED TIME
VFD 24/CLKWD . RESPONSE ADDRESS
CLKWD EQU PMASX3
TDCQ BSS 0 . END OF TIME, DATE, CLOCK
*
QEOI SX5 X5-1
NZ X5,ERR20 . TOO MANY PARAMETERS
SB1 QEOI1 . RETURN LINK
EQ FETLOOK
QEOI1 NZ X4,ERR35 . UNDEFINED FILENAME
LX3 59-36 . LOOK AT EOI FLAG
PL X3,FAIL . NOT EOI
EQ MKNULL . MAKE NULL STRING AND RETURN
*
JPB1 EQU SSKIP1 . ADDRESS OF A -JP B1- INSTRUCTION
FETLOOK SA1 B6
AX1 55
NZ X1,ERR40 . ILLEGAL FILENAME
SA1 B6-1
SA1 X1 . PICK UP BCD
BX6 X1
SX7 B7
SA7 A1
SB7 A7 . PUT SF WORD BACK ON LIST
MX0 42
SB6 B6-2 . POP STACK
SA3 FETHEAD . HEAD OF FILE-LIST
FETLOOK1 SA4 A3+1 . FIRST WORD OF FET
BX4 X0*X4 . CLEAR LAST CODE AND STATUS
BX4 X4-X6 . COMPARE FILENAME TO X6
ZR X4,JPB1 . A4 = ADDRESS OF FET
SX3 X3+0 . GET RID OF DESCRIPTION
ZR X3,JPB1 . A3 = ADDRESS OF LAST LINK
SA3 X3+0
EQ FETLOOK1
*
EOIQ BSS 0 . EOI NEEDS FETLOOK
*
*
* VALID CHECKS THE FILENAME IN X6. IF IT IS INVALID, X6 IS SET TO ZERO.
* X2, X3, X4, X5, AND X7 ARE USED.
*
VALID
SA2 MASK
SA3 MAX
BX4 -X2*X3 . MAX(2,4,6,8-10)
BX3 X2*X3 . MAX(1,3,5,7)
BX5 X2*X6 . LFN(1,3,5,7)
BX7 -X2*X6 . LFN(2,4,6,8-10)
IX3 X3-X5
IX4 X4-X7
BX3 -X2*X3
BX4 X2*X4
BX3 X3+X4
ZR X3,VALID . FILENAME OK
BX6 X6-X6
EQ VALID
MASK VFD 12/7700B,12/7700B,12/7700B,12/7700B,12/0000B
MAX DATA 7LZ999999 . MAXIMUM ALLOWABLE FILENAME
*
OPEN . OPEN ALTERNR
SA1 B2
SX7 120B . FUNCTION CODE
BX7 X1+X7
SA7 A1
SA1 OPECALL
SX7 B2
BX7 X1+X7
MX2 42
SA7 1
+ SA1 A7
NZ X1,*
SA1 B2
BX7 X1*X2 . CLEAR CODE AND STATUS
SX1 A7 . ONE BIT
BX7 X1+X7
SA7 A1
SA1 B2+3
SX7 X1+0
SA7 B2+2 . IN := OUT
EQ OPEN
OPECALL VFD 18/3LOPE,2/1,40/0
QOUTPUT SB2 X5-2 . ATTACH VARIABLE IN OUTPUT SENSE
GT B2,B0,QOUT1 . CARRIAGE CONTROL CHAR SPECIFIED
NG B2,ERR40 . ILLEGAL FILENAME
SX6 0 . NULL CARRAIGE CONTROL CHARACTER
EQ QOUT3
QOUT1 SA1 B6
SA2 B6-1
AX1 55 . EXAMINE TYPE
SB6 B6-2 . POP PARAMETER
NZ X1,QOUT2 . CCC NOT A STRING
SA1 X2 . PICK UP STRING
SX7 B7 . PUT SF
SA7 X2 . WORD ONTO
SB7 X2 . FREE CHAIN
MX0 6
BX2 -X0*X1
NZ X2,ERR29 . TYPE ERROR (CC NOT SINGLE CHAR)
BX6 X1
LX6 6
EQ QOUT3
QOUT2 SX1 X1-ITY
NZ X1,ERR29
NG X2,ERR29 . TYPE ERROR (MUST BE SINGLE POS DIG)
SX1 X2-10
PL X1,ERR29
SX6 X2+1R0
QOUT3 SX5 OUTTY
LX5 19
BX6 X5+X6
SA6 QIOSV
EQ QIO
QINPUT SB2 X5-2 . ATTACH VARIABLE IN INPUT SENSE
GT B2,B0,QIN1 . UNIT RECORD LENGTH WAS SPECIFIED
NG B2,ERR40 . ILLEGAL FILENAME
SX6 0 . NULL URL
EQ QIN2
QIN1 SA0 10
SA1 TENTO10
BX0 X1
RJ SACHEK . GUARANTEE INTEGER ON TOP OF STACK
LX7 3 . X7 CONTAINS TYPE
PL X7,ERR29 . TYPE ERROR (URL TOO LARGE)
MX0 43
SA1 B6-1
BX6 X1
BX0 X0*X1
NZ X0,ERR29 . TYPE ERROR (URL TOO LARGE)
SB6 B6-2 . POP STACK
QIN2 SX5 INTY . STATIC RECORD TYPE
LX5 19
BX6 X5+X6
SA6 QIOSV
QIO SB1 *+1
EQ FETLOOK . SEARCH FOR FET
SX0 A3+0 . SAVE BUFFER BLOCK ADDRESS
ZR X4,QIO2 . BUFFER BLOCK ALREADY EXISTS
SA1 MAXSTAT
RJ VALID . CHECK FOR GOOD FILENAME
ZR X6,ERR40 . X6 = 0 OR FILENAME
SA4 BUFFSIZE
SB4 X4+6 . BB LENGTH (FET + HEADER = 6)
SX7 X1+B4
SA7 A1 . UPDATE MAXSTAT
SA2 MINSTAK
IX2 X7-X2
BX5 X1 . SAVE OLD MAXSTAT
NG X2,QIO1 . STATIC AND STACK HAVE NOT COLLIDED
SB3 X2+BUFF4
RJ PUSHSTK . X0,X4,X5,X6,B4 MUST BE SAVED
QIO1 SA3 X0 . LAST BB HEADER
BX7 X3+X5 . ADD LINK
SA7 A3
SX1 B4 . BB LENGTH
SX7 SPCTYP . CATCH-ALL TYPE
LX7 37
BX7 X1+X7
LX7 18
SA7 X5 . STATIC RECORD TYPE
SB5 1
SX7 X5+6 . FWA OF CIRCULAR BUFFER
SA6 X5+B5 . STORE FILENAME IN FET
SX1 B5
LX1 18 . FET LENGTH FIELD
BX6 X1+X7
SA6 A6+B5 . FIRST
SA7 A6+B5 . IN
SA7 A7+B5 . OUT
IX7 X4+X7
SA7 A7+B5 . LIMIT
SB2 X5+B5 . FET ADDRESS FOR OPEN ROUTINE
SX0 X5 . ADDRESS OF BUFFER BLOCK
RJ OPEN
QIO2 SA1 QIOSV
LX1 18
BX6 X1+X0 . ADD BB POINTER TO FUTURE SVD
LX6 18
SA6 A1
RJ INDRCT . GET ADDRESS OF SVD IN X1
BX5 X1
SA1 B7
NZ X1,QIO3
RJ MORFREE
QIO3 SB7 X1
SA2 QIOSV
SA3 X5 . OLD VALUE
BX6 X3
BX4 X3
AX4 55
SX7 X4-INTY
ZR X7,ERR41 . ALREADY ATTACHED
SX7 X4-OUTTY
ZR X7,ERR41 . ALREADY ATTACHED
QIO4 SA6 A1 . PUT OLD VALUE INTO FREEWORD
SX3 A1
RJ ZROX7
MX0 5
BX7 -X0*X7 . CLEAR SS TYPE
BX6 X2+X3 . NEW SVD POINTS TO OLD
SA6 X5
EQ QIORET
QDETACH SX5 X5-1 . DETACH A VARIABLE FROM FILE
NZ X5,ERR20 . TOO MANY PARAMETERS
RJ INDRCT . RETURN ADDRESS OF SVD IN X1
SA2 X1
SA3 X2 . VALUE SVD
BX6 X3
AX2 55 . EXAMINE TYPE
SX4 X2-INTY
ZR X4,QDTCH1 . INPUT ASSOCIATED
SX4 X2-OUTTY
NZ X4,ERR36 . NOT ATTACHED
QDTCH1 SA6 X1 . RESTORE VALUE
SX7 0
SA7 A3 . MAKE NULL IN LEFT-OVER FREE WORD
SX7 A7
BX6 X7
LX7 18
BX7 X6+X7 . FUNCTION VALUE
QIORET SA0 2
RJ RESERVE . RESERVE TWO STACK WORDS
SA7 B6-1 . VALUE
SX7 2
SA7 B6 . BYPASS
EQ NEXTMIC
IOQ BSS 0
QREWIND SX5 X5-1 . ROUTINE TO REWIND FILE
NZ X5,ERR20 . TOO MANY PARAMETERS
SB1 QRW0
EQ FETLOOK . SEARCH FOR FET
QRW0 NZ X4,ERR35 . UNDEFINED FILENAME
SB2 A4
RJ TERMIN . PERFORM WRITER IF OUTPUT FILE
SA2 B2-1
MX6 2
LX6 2+18+18
BX6 -X6*X2 . CLEAR EOR,EOI FLAGS
SA6 A2
SA1 B2+2
BX6 X1
SA6 B2+3 . SET OUT := IN
REWIND RECALL
SA1 B2 PICK UP THE FIRST WORD OF THE FET
LX1 59 SHIFT THE COMPLETION BIT TO THE TOP
NG X1,QRW3 IF WE ARE COMPLETE SKIP THE RECALL
RECALL B2 WE ARE NOT DONE SKIP THE RECALL
QRW3 SA1 B2 OH WELL, LETS BE COMPLETELY SAFE
MX6 1 GENERATE THE ONE BIT SIEVE
LX6 10 SHIFT THE HOLE TO THE EOI POSITION
BX6 -X6*X1 KNOCK OUT THE ACCURSED EOI BOI BIT
SA6 A1 AND BACK GOES THE BOWDLERIZED EDITION
EQ QEFRW
QUNLOAD SX5 X5-1
NZ X5,ERR20
SB1 QUNL0 CF. CLOSE
EQ FETLOOK
QUNL0 NZ X4,ERR35
SB2 A4
WAIT
UNLOAD RECALL
EQ QEFRW
QCLOSE SX5 X5-1 STANDARD PROCEDURE CLOSE(FILE)
NZ X5,ERR20 TOO MANY ARGUMENTS
SB1 QCL0 HOME IS WHERE YOUR B1 IS...HA.
EQ FETLOOK CHECK FILE VALIDITY
QCL0 NZ X4,ERR35 SHAME ON YOU, YOU DIDNT HAVE THAT FILE
SB2 A4
WAIT
CLOSE RECALL
EQ QEFRW
QENDFILE SB1 X5-2 . STANDARD PROCEDURE ENDGROUP
GT B1,B0,ERR20 . MORE THAN TWO PARAMETERS
BX5 X5-X5 . =0, THE DEFAULT LEVEL NUMBER
NG B1,QEOR1 . USE THE DEFAULT SECOND PARAMETER
SA0 10
SA1 TENTO10
BX0 X1
RJ SACHEK . GET INTEGER ON TOP OF STACK
LX7 3 . X7 CONTAINS TYPE OF STACK TOP
PL X7,ERR29 . TYPE ERROR (TOO LARGE)
MX0 60-4
SA1 B6-1
BX0 X0*X1
BX5 X1
NZ X0,ERR29 . LEVEL NUMBER MUST BE BETWEEN ;0,15!
SB6 B6-2 . POP STACK
QEOR1 SB1 QEOR2
JP FETLOOK
QEOR2 NZ X4,ERR35 . NO SUCH FILE
SB2 A4
WAIT . RECALL IF BUSY
SX0 1 . RECALL FLAG FOR CIO CALL
SX7 24B . =WRITER FUNCTION
LX5 18-4 . POSITION LEVEL NUMBER
BX7 X5+X7
RJ CIO . ISSUE REQUEST
QEFRW SA0 2
RJ RESERVE
SX6 2
RJ ZROX7
MX0 5
BX7 -X0*X7 . CLEAR SS TYPE
SA7 B6-1 . MAKE A NULL VALUE
SA6 B6
EQ NEXTMIC
EFRWQ BSS 0
*
QEORL SX5 X5-1 . STANDARD PROCEDURE EORLEVEL
NZ X5,ERR20 . TOO MAY PARAMETERS
SB1 QEORL1
JP FETLOOK
QEORL1 NZ X4,ERR35 . NO SUCH FILE
LX3 60-37 . FILE HEADER WORD WAS RETURNED IN X3
PL X3,QEORL3 . EOI FLAG WAS NOT SET
MX6 59 . =-1, PSEUDO-LEVEL FOR EOI
QEORL2 SB6 B6+2
SA1 ITYWD
SA6 B6-1 . RETURN-VALUE
BX6 X1
SA6 B6 . STACK BYPASS
JP NEXTMIC . FINISHED
QEORL3 LX3 60-1 . LEFT JUSTIFY EOR FLAG
PL X3,FAIL . THE FILE IS NOT AT AN ENDGROUP
SA4 A4 . LFN AND CODE AND STATUS
AX4 18-4 . RIGHT JUSTIFY LEVEL NUMBER
SX6 17B
BX6 X6*X4
JP QEORL2
EORLQ BSS 0 . END OF EORLEVEL
*
*
QDT SX5 X5-1
NZ X5,ERR20 . TOO MANY PARAMETERS
SA1 B6
SB1 X1
SB6 B6-B1
AX1 55
NZ X1,QDT7 . FOR SURE NOT STRING
SA2 B6+1
BX0 X2 . SAVE SVD
SB1 B0 . SET STATE TO BEFORE SIGN
SX7 77B
SB2 QDTS . INNOCENT UNTIL PROVEN GUILTY
QDT1 LX1 6
BX3 X7*X1 . NEXT CHARACTER
NZ X3,QDT2 . NOT END OF WORD
ZR X2,QDT4 . GUILTY OF INTEGERISM
SA1 X2 . NEXT STRING WORD
SX2 X1 . LINK
BX1 X1-X2 . CLEAR LOWER 18 BITS
EQ QDT1 . TRY AGAIN
QDT2 SX3 X3-1R0
NG X3,QDT5 . NOT AN INTEGER
SX3 X3-1R++1R0
NG X3,QDT3 . DIGIT
SX3 X3-1R*+1R+
PL X3,QDT5 . STRING
NZ B1,QDT5 . STRING (TWO SIGNS)
QDT3 SB1 1
EQ QDT1
QDT4 SB2 QDTI
QDT5 SX6 B7
SB7 X0
AX0 18
SA6 X0 . RELEASE SF STRING
QDT6 SB6 B6+2
SA1 SSTYWD
BX7 X1
SA7 B6
SX6 B2+0
SA6 B6-1
EQ NEXTMIC
QDT7 SX1 X1-ITY
SB2 QDTP
NG X1,QDT6
SX2 X1-DTY+ITY
ZR X2,QDT8
LX1 1
SB2 X1+QDTI
EQ QDT6
QDT8 SA1 B6+1
AX1 18
SA1 X1
MX0 18
LX0 54
SX2 SSTY
BX6 X0*X1
LX2 55
SX3 A1+2
BX6 X2+X6
BX6 X3+X6
SA6 DTYPWD
SB2 A6
EQ QDT6
QDTS VFD 5/SSTY,19/6,18/*+1,18/*+1
DATA 6LSTRING
QDTI VFD 5/SSTY,19/7,18/*+1,18/*+1
DATA 7LINTEGER
QDTR VFD 5/SSTY,19/4,18/*+1,18/*+1
DATA 4LREAL
QDTA VFD 5/SSTY,19/5,18/*+1,18/*+1
DATA 5LARRAY
QDTP VFD 5/SSTY,19/7,18/*+1,18/*+1
DATA 7LPATTERN
QDTN VFD 5/SSTY,19/4,18/*+1,18/*+1
DATA 4LNAME
QDTC VFD 5/SSTY,19/4,18/*+1,18/*+1
DATA 4LCODE
DTQ BSS 0
*
*
QFLV SX5 X5-1
NZ X5,ERR20
SA1 B6
SB1 X1
SB6 B6-B1
AX1 55
NZ X1,QFLV1 . NO STRING TO RELEASE
SA1 B6+1
SX6 B7
SB7 X1
AX1 18
SA6 X1
QFLV1 SA1 STAKTOP
SX6 0
QFLV2 SA2 X1 . NEXT STACK HEADER
SB1 X2 . BYPASS
ZR X2,QFLV4 . DONE
PL X2,QFLV3 . NOT FUNCTION CALL
SX6 X6+1
QFLV3 SB1 -B1
SX1 X1+B1
EQ QFLV2
QFLV4 SB6 B6+2
SA1 ITYWD
BX7 X1
SA7 B6
SA6 B6-1
EQ NEXTMIC
FLVQ BSS 0
*
*
QLGT SB1 X5-2
GT B1,B0,ERR20 . TOO MANY PARAMS
LT B1,B0,QLGT6 . SECOND PARAM NULL
SA1 B6
AX1 55
NZ X1,QLGT7 . SECOND PARAM NOT SF TYPE
QLGT1 SA1 B6-2
AX1 55
NZ X1,QLGT8 . FIRST PARM NOT SF
QLGT2 NO
SA1 B6-3 . FIRST SVD
BX0 X1 . SAVE
QLGT22 BX7 X7-X7 . PRESET S/F FLAG TO FAILURE
SA2 B6-1 . SECOND SVD
BX5 X2 . SAVE ALSO
QLGT3 SA3 X1 . WORD OF FIRST STRING
SA4 X2
SX1 X3 . LINK
SX2 X4
BX3 X1-X3 . CLEAR LOWER 18 BITS OF STRING WORD
BX4 X2-X4
IX3 X4-X3
LX3 59 . LOOK AT BIT 0
NG X3,QLGT4 . FIRST > SECOND
NZ X3,QLGT5 . FIRST < SECOND
ZR X1,QLGT5 . FIRST @ SECOND
NZ X2,QLGT3
QLGT4 RJ ZROX7 . SUCCESS - MAKE NULL VALUE
QLGT5 SX6 B7
SB7 X0
AX0 18
SA6 X0 . FREE FIRST STRING
SX6 B7
SB7 X5
AX5 18
SA6 X5 . FREE SECOND STRING
SB6 B6-4 . POP STACK
ZR X7,FAIL
SB6 B6+2
MX0 5
BX7 -X0*X7
SA7 B6-1
SX7 2
SA7 B6+0
EQ NEXTMIC
QLGT6 SA0 2
RJ RESERVE . RESERVE STACK SPACE FOR NULL
SX6 2
RJ ZROX7
SA7 B6-1 . NULL SECOND PARAM
SA6 B6
EQ QLGT1 . GO CHECK FIRST PARAM
QLGT7 SX1 X1-ITY
NZ X1,ERR29 . TYPE ERROR
SA1 B6-1
RJ ITOSF
SA6 B6-1
EQ QLGT1 . GO CHECK FIRST PARAM
QLGT8 SX1 X1-ITY
NZ X1,ERR29 . TYPE ERROR
SA1 B6-3
RJ ITOSF
BX1 X6
BX0 X1 . SAVE SVD
EQ QLGT22 . GO COMPARE STRINGS
LGTQ BSS 0
*
*
QDATA SX5 X5-1
NZ X5,ERR20 . ERROR IF MORE THAN ONE PARAMETER
SA1 B6
MX3 1
BX6 X1
AX1 55
NZ X1,ERR24 . PARAM HAS TO BE A STRING
SA4 B6-1
SB1 B0 . INITIALIZE FIELD COUNT
MX0 54 . PREPARE QNXTID
BX2 X2-X2
LX3 54
BX6 X6+X3
SA6 B6 . MARK TOP OPERAND IN STACK
QDAT1 BX6 X0
RJ QNXID . NEXT IDENTIFIER IN PROTOTYPE
ZR X3,QDAT5 . BRANCH IF END OF PROTOTYPE
EQ B2,B0,ERR30 . SYNTAX ERROR E. G. A(,
SX7 X3-1R(
NZ X7,QDAT2
NE B1,B0,ERR30 . SYNTAX ERROR E. G. A(B(
QDAT3 SB1 B1-1 . BUMP FIALD COUNT
QDAT4 SA6 B6-1 . STORE SVD OF THE IDENTIFIER
EQ QDAT1
QDAT2 SA0 2
RJ RESERVE
GE B1,B0,ERR30 . SYNTAX ERROR E. G. A,
SX7 A0
SA7 B6
SX1 X3-1R,
ZR X1,QDAT3
SX1 X3-1R)
NZ X1,ERR30 . SYNTAX ERROR E. G. A(B.
SB1 B0-B1 . B1 IS THE TRUE FIELD COUNT NOW
EQ QDAT4
QDAT5 GE B0,B1,ERR30 . SYNTAX ERROR E. G. A
NE B2,B0,ERR30 . OR A(B
SX7 B1 . SAVE NUMBER OF FIELDS
SA7 QDATSV1
SB4 B0 . SIGNAL SF FOR INDRX
QDAT6 SA4 B6-1
RJ SRCHCLL . LOOK UP NEXT FUNCTION
SA2 B6-1
SX7 B7 . FREE THE IDENTIFIER
SB7 X2
AX2 18
SA3 B6
SA7 X2
LX3 6 . END LOOP IF TOPOPERAND IS MARKED
NG X3,QDAT10
SB6 B6-2
SX6 FLDTYP
SX3 1
LX6 55 . IT IS A FIELD FUNCTION
LX3 18 . WITH ONE PARAMETER
BX6 X6+X3
BX7 X1
SA1 B7
SA6 X7
NZ X1,QDAT7 . PUT ADDRESS ON A LIST
RJ MORFREE
QDAT7 SB7 X1
LX7 18
SA2 MINSTAT . BEGINNING OF THE LIST IS IN XWRD
SA3 X2 . CHECK IF ADDRESS IN NOT
BX7 X3+X7 . REPEATED IN THE LIST
SX6 A1
SA7 A1
QDAT8 ZR X3,QDAT9
SA3 X3
BX1 X7-X3
SX3 X3
AX1 18
NZ X1,QDAT8
EQ ERR31
QDAT9 SA6 X2
EQ QDAT6
QDAT10 SA3 QDATSV1
SA2 MAXSTAT
SB4 X3+1 . NO OF FIELDS + 1
SX0 DATATYP
LX3 18 . NO OF FIELDS TO X3
LX0 55
BX6 X2+X3
BX6 X6+X0 . FUNCTION DESCRIPTOR
SX5 X1
SA4 MINSTAK
SX7 X2+B4 . RESERVE B4 WORDS IN STATIC
IX4 X7-X4
SA7 A2
NG X4,QDAT11
SB3 X4+BUFF4
RJ PUSHSTK . PUSH THE STACK IF NECESSARY
QDAT11 SX0 SPCTYP . CREATE A STATIC RECORD
SB1 X6 . CONSISTING OF THE ADDRESSES
SA6 X5 . OF THE FIELD FUNCTIONS OF
SA2 MINSTAT
SX6 B4 . THIS DATATYPE.
SA2 X2
LX6 18
BX7 X7-X7
SA7 A2 . CLEAR XWRD
SB2 X2
LX0 55
BX6 X6+X0
SA6 B1 . HEADER
QDAT12 SB1 B1+1
SA3 X2 . NEXT WORD FROM LIST
BX7 X3
AX7 18
BX1 X5-X7 . CHECK IF NOT THE SAME NAME AS
ZR X1,ERR31 . THE DATATYPE
SX2 X3
SA7 B1
MX0 1
BX6 X0+X7
NZ X2,QDAT12
SX7 B7 . FREE THE LIST
SB7 B2
SA7 A3
SA6 B1
EQ QIF2 . NULL VALUE IS RETURNED
*
DATAQ BSS 0
QSTLIMIT SB1 STLIM . STANDARD PROCEDURE STLIMIT
EQ QMAXLN1
QSTCOUNT SB1 STCOUNT . STANDARD PROCEDURE STCOUNT
EQ QMAXLN1
QMAXLN SB1 MXLNGTH . STANDARD PROCEDURE MAXLNGTH
QMAXLN1 SX5 X5-1 . ERROR IF MORE THAN ONE PARAM
NZ X5,ERR20
SA1 B6
AX1 55
NZ X1,QMAXLN2 . BRANCH IF NOT STRING PARAM
SA1 B6-1
SA1 X1
SX7 B7
ZR X1,QMAXLN3 . BRANCH IF NULL STRING
QMAXLN2 SA1 TENTO10
SA0 10
SX5 B1
BX0 X1
RJ SACHEK . CONVERT PARAM INTO INTEGER FORM
LX7 4
PL X7,ERR29 . VALUE TOO BIG
SA1 B6-1
BX7 X1
SA7 X5 . ASSIGN VALUE TO KEYWORD
SX5 1
EQ QIF . RETURN NULL
QMAXLN3 SB7 A1 . RETURN THE VALUE OF THE KEYWORD
SA7 A1 . FREE THE NULL STRING
SA1 B1
BX6 X1
SA6 B6-1
SA1 ITYWD
BX6 X1
SA6 B6
EQ NEXTMIC
*
MAXLNQ BSS 0
*
QALPHA SX5 X5-1 . STANDARD PROCEDURE ALPHABET
NZ X5,ERR20 . ERROR IF MORE THAN ONE PARAMETER
SA1 B6
SB1 X1 . REMOVE THE PARAMETER
AX1 55
SB6 A1-B1
NZ X1,QALPHA1
SA1 B6+1
SX7 B7
SB7 X1
AX1 18
SA7 X1
QALPHA1 SX4 ABC . THE RESULT IS THE DISPLAY CODE
SB1 NEXTMIC . ALPHABET
EQ SOPERND
*
ABC VFD 5/SSTY,19/63,18/ABC2,18/ABC1
*
ABC1 VFD 42/01020304050607B,18/*+1
VFD 42/10111213141516B,18/*+1
VFD 42/17202122232425B,18/*+1
VFD 42/26273031323334B,18/*+1
VFD 42/35363740414243B,18/*+1
VFD 42/44454647505152B,18/*+1
VFD 42/53545556576061B,18/*+1
VFD 42/62636465666770B,18/*+1
ABC2 VFD 42/71727374757677B,18/0
*
ALPHAQ BSS 0
*
QFREEZE SX5 X5-1
NZ X5,ERR20 . TOO MANY PARAMETERS
SA1 B6 . SVD
AX1 55
NZ X1,ERR29 . MUST BE STRING
SA1 B6-1 . SVD
SA1 X1 . FIRST (AND HOPEFULLY LAST) WORD
BX6 X1
RJ VALID . CHECK FOR GOOD FILENAME
ZR X6,ERR40 . NO
SA6 QFRZFET
SA1 FIELDLN
SB2 A6 . FET ADDRESS FOR OPEN CALL
BX6 X1
SA6 A6+4 . LIMIT POINTER OF FET
RJ OPEN
SA1 QFRZFET+1 . FIRST
SX6 X1
SA6 A1+1 . IN
SX6 X6+1
SA6 A6+1 . OUT
SA1 QFRZWRD . LOADER TABLE HEADER WORD
BX6 X1
SX7 B7
SA6 BGP2STK-1 . STORE JUST BEFORE REAL SNOBOL
LX7 18
SX5 B6
BX7 X5+X7
LX7 18
SX5 A5
BX7 X5+X7
SA7 QFRZSV
RJ CLOSEOUT . TERMINATE FILE(S)
SB2 QFRZFET . RESTORE B2
BWRITER RECALL
JP .END. . JUST ISSUE END REQUEST
QFREEZE1 SA1 QFRZSV
SA5 X1
AX1 18
SB6 X1
AX1 18
SA2 FIELDLN
BX2 -X2
SB7 X1
SB1 A0
SX3 X2+B1
SX7 A0
SA7 A2
ZR X3,NEXTMIC . NEW FL = OLD FL
QFREEZE2 SB1 B1-1
SX6 B1-1
SB2 X2+B1
SA6 B1
NE B2,B0,QFREEZE2
SX6 B7
SB7 X7-1
SA6 B1
EQ NEXTMIC
*
QFRZFET DATA 0
VFD 60/BGP2STK-2 . FIRST
VFD 60/BGP2STK-2 . IN
VFD 60/BGP2STK-1 . OUT
DATA 0 . LIMIT
QFRZWRD VFD 6/50B,18/0,18/BGP2STK-1,18/QFREEZE1
*
FREEZEQ BSS 0
*
TITLE PASS1 CONTROL TABLE
P1TBL MACRO VAL,ALTVAL,SLB,BUO,IDC,NC,SPACT,SPADD,LITTERM
VFD 1/SLB,1/BUO,1/SPACT,1/IDC,1/NC,1/LITTERM,18/SPADD,18/
,ALTVAL,18/VAL
ENDM
*
* PASS 1 TABLE FLAG BITS
*
SLB EQU 1 . SUPPRESS LEADING BLANKS
BUO EQU 1 . BINARY OR UNARY OPERATOR
SPACT EQU 1 . SPAECIAL ACTION
IDC EQU 1 . IDENTIFIER CHARACTER
NC EQU 1 . NUMBER CHARACTER
LITTERM EQU 1 . LITERAL TERMINATOR
P1TAB P1TBL P2END,,SLB ENDPRG
P1TBL -ID,,,,IDC A
P1TBL -ID,,,,IDC B
P1TBL -ID,,,,IDC C
P1TBL -ID,,,,IDC D
P1TBL -ID,,,,IDC E
P1TBL -ID,,,,IDC F
P1TBL -ID,,,,IDC G
P1TBL -ID,,,,IDC H
P1TBL -ID,,,,IDC I
P1TBL -ID,,,,IDC J
P1TBL -ID,,,,IDC K
P1TBL -ID,,,,IDC L
P1TBL -ID,,,,IDC M
P1TBL -ID,,,,IDC N
P1TBL -ID,,,,IDC O
P1TBL -ID,,,,IDC P
P1TBL -ID,,,,IDC Q
P1TBL -ID,,,,IDC R
P1TBL -ID,,,,IDC S
P1TBL -ID,,,,IDC T
P1TBL -ID,,,,IDC U
P1TBL -ID,,,,IDC V
P1TBL -ID,,,,IDC W
P1TBL -ID,,,,IDC X
P1TBL -ID,,,,IDC Y
P1TBL -ID,,,,IDC Z
P1TBL -INT,,,,IDC,NC 0
P1TBL -INT,,,,IDC,NC 1
P1TBL -INT,,,,IDC,NC 2
P1TBL -INT,,,,IDC,NC 3
P1TBL -INT,,,,IDC,NC 4
P1TBL -INT,,,,IDC,NC 5
P1TBL -INT,,,,IDC,NC 6
P1TBL -INT,,,,IDC,NC 7
P1TBL -INT,,,,IDC,NC 8
P1TBL -INT,,,,IDC,NC 9
P1TBL P2UNPL,P2PLUS,,BUO +
P1TBL P2UNMIN,P2MINUS,,BUO
P1TBL -ASTER1,P2MULT,,BUO,,,SPACT,ASTER-PASS1 *
P1TBL -SLASH1,P2DIV,,BUO,,,SPACT,SLASH-PASS1 /
P1TBL -LPAREN,P2LFTPR (
P1TBL P2RGTPR,,SLB )
P1TBL P2UNDOL,P2DOL,,BUO $
P1TBL -SUPPRESS,P2EQUAL,SLB
P1TBL -BLANK BLANK
P1TBL -SUPPRESS,P2COMMA,SLB
P1TBL P2UNPRD,P2PRD,,BUO,IDC .
P1TBL P2ERR1 #
P1TBL -SUPPRESS,P2LFTBR [
P1TBL P2RGTBR,,SLB ]
P1TBL -SUPPRESS,P2CLN,SLB
P1TBL -LIT QUOTE
P1TBL P2ERR1 _
P1TBL P2ERR2,P2ALT,,BUO !
P1AND P1TBL P2ERR1,P2AND,,BUO &&&&&&&&&&&&
P1TBL -LIT '
P1OR P1TBL P2ERR1,P2OR,,BUO ????????
P1LEFT P1TBL P2ERR1,P2LEFT,,BUO <<<<<<<<
P1RITE P1TBL P2ERR1,P2RITE,,BUO >>>>>>>>
P1TBL P2ERR1 @
P1TBL P2ERR1 \
P1NOT P1TBL P2NOT,P2EOR,,BUO ~~~~~~~~
P1TBL -SEMI,P2SMCLN,SLB SEMICOLON
P1EOS P1TBL -SEMI,P2SMCLN,SLB,,,,,,LITTERM EOS
P1EXP P1TBL P2ERR2,P2EXP,,BUO **
*
TITLE PASS 2 CONTROL TABLE
P2TBL EQU *-1
P2AND HEAD 0,0,13,13,0,0,0,0,1,1,2,2,0,0,2
TAIL 176B,0,P3AND,ST10,OUTP2
TAIL 176B,0,P3AND,ST12,OUTP2
P2EOR HEAD 0,0,10,10,0,0,0,0,1,1,2,2,0,0,2
TAIL 176B,0,P3EOR,ST10,OUTP2
TAIL 176B,0,P3EOR,ST12,OUTP2
P2OR HEAD 0,0,07,07,0,0,0,0,1,1,2,2,0,0,2
TAIL 176B,0,P3OR,ST10,OUTP2
TAIL 176B,0,P3OR,ST12,OUTP2
P2LEFT HEAD 0,0,04,04,0,0,0,0,1,1,2,2,0,0,2
TAIL 176B,0,P3LEFT,ST10,OUTP2
TAIL 176B,0,P3LEFT,ST12,OUTP2
P2RITE HEAD 0,0,01,01,0,0,0,0,1,1,2,2,0,0,2
TAIL 176B,0,0,0,ACT2
TAIL 176B,0,P3RITE,ST10,OUTP2
TAIL 176B,0,P3RITE,ST12,OUTP2
P2PLUS HEAD 0,0,13,13,0,0,0,0,1,1,2,2,0,0,2
TAIL 176B,0,P3PLUS,ST10,OUTP2
TAIL 176B,0,P3PLUS,ST12,OUTP2
P2MINUS HEAD 0,0,10,10,0,0,0,0,1,1,2,2,0,0,2
TAIL 176B,0,P3MIN,ST10,OUTP2
TAIL 176B,0,P3MIN,ST12,OUTP2
P2MULT HEAD 0,0,7,7,0,0,0,0,1,1,2,2,0,0,2
TAIL 176B,0,P3MULT,ST10,OUTP2
TAIL 176B,0,P3MULT,ST12,OUTP2
P2DIV HEAD 0,0,4,4,0,0,0,0,1,1,2,2,0,0,2
TAIL 176B,0,P3DIV,ST10,OUTP2
TAIL 176B,0,P3DIV,ST12,OUTP2
P2EXP HEAD 0,0,1,1,0,0,0,0,2,2,3,3,0,0,2
TAIL 176B,0,0,0,ACT2
TAIL 176B,0,P3EXP,ST10,OUTP2
TAIL 176B,0,P3EXP,ST12,OUTP2
P2UNPL HEAD 0,0,0,0,0,0,0,0,1,0,2,0,0,0,2
TAIL 200B,0,P3UNPL,ST10,OUTP2
TAIL 200B,0,P3UNPL,ST12,OUTP2
P2UNMIN HEAD 0,0,0,0,0,0,0,0,1,0,2,0,0,0,2
TAIL 200B,0,P3UNMIN,ST10,OUTP2
TAIL 200B,0,P3UNMIN,ST12,OUTP2
P2NOT HEAD 0,0,0,0,0,0,0,0,1,0,2,0,0,0,2
TAIL 200B,0,P3NOT,ST10,OUTP2
TAIL 200B,0,P3NOT,ST12,OUTP2
P2USTAR HEAD 0,0,0,0,0,0,0,0,0,0,1,1,0,0,1
TAIL 200B,ST12,P3STAR,ST4,ACT3
P2PRD HEAD 0,0,7,7,0,0,0,0,0,0,1,1,0,0,1
TAIL 176B,ST12,P3PRD,ST4,ACT3
P2DOL HEAD 0,0,5,5,0,0,0,0,0,0,1,1,0,0,1
TAIL 176B,ST12,P3DOL,ST4,ACT3
P2ALT HEAD 0,0,3,3,0,0,0,0,0,0,1,1,0,0,1
TAIL 176B,0,P3ALT,ST11,OUTP2
P2BLANK HEAD 2,3,1,1,0,0,4,0,5,5,6,6,0,0,6
TAIL 176B,0,0,0,ACT2
TAIL 300B,0,P3LABEL,ST2,ACT4
TAIL 176B,ST5,P3PM,ST11,ACT5
TAIL 200B,0,0,ST7,PASS2
TAIL 176B,0,P3CAT,ST9,OUTP2
TAIL 176B,0,P3CAT,ST11,OUTP2
P2UNPRD HEAD 0,1,2,0,0,0,0,0,3,3,4,4,0,0,4
TAIL 200B,ST2,P3NAME,ST4,ACT20
TAIL 200B,0,P3NAME,ST4,OUTP2
TAIL 200B,ST10,P3NAME,ST4,ACT3
TAIL 200B,ST12,P3NAME,ST4,ACT3
P2UNDOL HEAD 0,5,1,1,0,0,0,2,3,3,4,4,0,0,4
TAIL 200B,0,P3INDR,ST3,OUTP2
TAIL 200B,ST7,P3BGTT,ST3,ACT6
TAIL 200B,ST10,P3INDR,ST3,ACT3
TAIL 200B,ST12,P3INDR,ST3,ACT3
TAIL 200B,ST2,P3INDR,ST3,ACT21
P2LFTPR HEAD 0,7,1,5,0,0,2,0,3,3,4,4,0,0,4
TAIL 300B,ST3,P3LFTPR,ST9,ACT9
TAIL 300B,0,P3COND,ST8,OUTP2
TAIL 300B,ST10,P3LFTPR,ST9,ACT9
TAIL 300B,ST12,P3LFTPR,ST11,ACT9
TAIL 100B,ST3,P3LFTPR,ST9,ACT9
P2LFTBR HEAD 0,1,2,2,0,0,3,0,4,4,5,5,0,0,5
TAIL 374B,ST2,0,ST3,ACT8
TAIL 100B,ST3,0,0,ACT13
TAIL 300B,ST7,P3BGTC,ST4,ACT14
TAIL 100B,ST10,0,0,ACT13
TAIL 100B,ST12,0,0,ACT13
P2RGTPR HEAD 0,0,14,14,0,0,0,1,2,2,2,2,3,0,15
TAIL 100B,0,P3GT,ST7,OUTP2
TAIL 176B,0,0,0,ACT11
TAIL 176B,0,P3CALL,0,ACT17
P2COMMA HEAD 0,0,10,10,0,0,0,0,12,12,12,12,1,2,11
TAIL 176B,ST13,P3PARAM,ST15,ACT3
TAIL 176B,ST14,P3SUBCM,ST9,ACT3
P2RGTBR HEAD 0,0,7,7,0,0,0,0,9,9,9,9,0,1,9
TAIL 176B,0,P3RGTBR,0,ACT17
P2EQUAL HEAD 0,1,5,5,2,0,0,0,7,7,7,7,0,0,7
TAIL 102B,ST6,P3ASGN,ST15,ACT3
TAIL 176B,ST6,P3PMA,ST15,ACT18
P2CLN HEAD 1,7,2,2,5,6,0,0,4,4,4,4,0,0,3
TAIL 301B,0,P3LABEL,ST7,ACT4
TAIL 177B,0,0,0,ACT2
TAIL 376B,0,0,0,ACT12
TAIL 176B,0,0,0,ACT16
TAIL 176B,0,P3CLN2,ST7,OUTP2
TAIL 176B,0,P3CLN1,ST7,OUTP2
TAIL 302B,0,P3CLN2,ST7,OUTP2
P2SMCLN HEAD 2,3,4,4,1,5,6,0,7,7,7,7,0,0,8
TAIL 177B,0,P3RULE2,ST1,OUTP2
TAIL 301B,0,0,0,ACT19
TAIL 302B,0,P3RULE2,ST1,OUTP2
TAIL 176B,0,0,0,ACT2
TAIL 176B,0,P3RULE1,ST1,OUTP2
TAIL 200B,0,P3RULE3,ST1,OUTP2
TAIL 176B,0,0,0,ACT16
TAIL 376B,0,0,0,ACT12
AUXPR TAIL 100B,ST13,P3BCALL,ST15,ACT3
AUXBR TAIL 100B,ST14,P3LFTBR,ST9,ACT3
P2END HEAD 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
TAIL 377B,0,P3END,0,OUTP2
AUXERR EQU *-P2TBL
P2ERR4 HEAD 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
TAIL 376B,0,0,0,ERRACT3
P2ERR3 HEAD 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
TAIL 376B,0,0,0,ERRACT2
P2ERR2 HEAD 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
TAIL 376B,0,0,0,ERRACT1
P2ERR1 HEAD 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
TAIL 376B,0,0,0,ERRACT
*
TITLE PASS3 CONTROL TABLE
P3TBL EQU *-1
P3RULE1 TABLE 20B,0,PRIORI,0,ARULE1
P3RULE2 TABLE 20B,0,PRIORI,XSKIP,ARULE1
P3RULE3 TABLE 40B,0,0,0,ARULE1
P3RULE4 TABLE 40B,0,0,0,ARULE4
P3BCALL TABLE 40B,0,PRIORG,0,ABCALL
P3LFTBR TABLE 42B,0,PRIORG,XARRAY,ALFTBR
P3INDR TABLE 40B,XINDRCV,PRIORA,0,STACKX4
P3NAME TABLE 50B,0,PRIORA,0,STACKX4
P3PM TABLE 20B,XPM,PRIORG,XPMCHK,APM
P3ASGN TABLE 44B,XASGN,PRIORH,0,AASGN
P3PMA TABLE 22B,XASGNPM,PRIORH,0,0
P3CLN1 TABLE 20B,0,PRIORI,0,PASS3
P3CLN2 TABLE 20B,0,PRIORI,XSKIP,PASS3
P3UNPL TABLE 2B,XUNADD,PRIORD,XZERO,0
P3UNMIN TABLE 2B,XUNSUB,PRIORD,XZERO,0
P3AND TABLE 22B,XAND,PRIORB,XASCHK,0
P3NOT TABLE 2B,XNOT,PRIORB,XZERO,0
P3EOR TABLE 22B,XEOR,PRIORB,XASCHK,0
P3OR TABLE 22B,XOR,PRIORB,XASCHK,0
P3LEFT TABLE 22B,XLEFT,PRIORB,XASCHK,0
P3RITE TABLE 22B,XRITE,PRIORB,XASCHK,0
P3PLUS TABLE 22B,XADD,PRIORD,XASCHK,0
P3MIN TABLE 22B,XSUBTR,PRIORD,XASCHK,0
P3MULT TABLE 22B,XMULT,PRIORC,XMCHEK,0
P3DIV TABLE 22B,XDIV,PRIORC,XDCHEK,0
P3EXP TABLE 22B,XEXP,PRIORB,XEXPCHK,0
P3STAR TABLE 16B,XSTAR,PRIORA,0,0
P3CAT TABLE 22B,XCONCAT,PRIORE,XCATCHK,0
P3ALT TABLE 22B,XALT,PRIORF,XALTCHK,0
P3DOL TABLE 36B,XDOL,PRIORA,0,0
P3PRD TABLE 36B,XPRD,PRIORA,0,0
P3NULL TABLE 0B,0,0,XNULL,PASS3
P3PARAM TABLE 20B,0,PRIORF,XPARAM,APARAM
P3SUBCM TABLE 20B,0,PRIORF,XSUBCM,PASS3
P3CALL TABLE 20B,0,PRIORF,0,ACALL
P3RGTBR TABLE 20B,0,PRIORF,0,ARGTBR
P3LFTPR TABLE 2B,0,PRIORG,0,0
P3RGTPR TABLE 20B,0,PRIORF,0,ARGTPR
P3END TABLE 40B,0,0,0,AEND
P3COND TABLE 40B,0,0,0,ACOND
P3BGTT TABLE 40B,0,PRIORH,0,ABGTT
P3BGTC EQU P3BGTT
P3GT TABLE 40B,0,0,0,AGT
P3GTT TABLE 20B,0,PRIORG,XGOTOT,AGTT
P3GTC TABLE 20B,0,PRIORG,XGOTOC,AGTT
P3LABEL TABLE 40B,0,0,0,ALABEL
*
P3ENDUN EQU P3CLN1
*
TITLE PASS1: MAIN LOOP
PRE5 RJ HEADING
PRE4 RJ UNPACK
PASS1 SA2 B4+CHAR NEXT SOURCE CHARACTER
NG X2,PRE4
SB4 B4+1
SA3 P1TAB+X2
NOINPUT1 SX1 X3 VALUE FIELD OF P1TAB ENTRY
NG X1,BRANCH
NOINPUT2 RJ PASS2 OUTPUT VALUE FROM P1TAB
EQ PASS1
BRANCH BX1 -X1
SB5 X1
JP B5 JUMP TO COMPL. OF ADDRESS IN TABL
SUPSAVE BX6 X3
SA6 P1SVX3
RJ UNPACK
SA3 P1SVX3
SUPPRESS SA2 B4+CHAR SUPPRESS TRAILING BLANKS
NG X2,SUPSAVE
SB4 B4+1
SUP0 SX1 X2-1R
ZR X1,SUPPRESS
SB4 B4-1 BACK UP CHAR POINTER
LX3 42 GET ALTVAL FIELD OF P1TAB ENTRY
SX1 X3
EQ NOINPUT2
CLX BX6 X3
SA6 P1SVX3 SAVE X3
RJ UNPACK
SA3 P1SVX3
EQ BLANK1
SEMI SA1 RULENO
SX6 X1+1
SA6 RULENO
SX1 P2SMCLN
EQ NOINPUT2
RJ UNPACK
BLANK SA2 B4+CHAR PROCESS A BLANK
NG X2,*-1
SB4 B4+1
SX1 X2-1R
ZR X1,BLANK A STRING OF BLANKS # ONE BLANK
SA3 X2+P1TAB
NG X3,NOINPUT1 OP REQUIRING LEADING BLNK SUPPRES
BLANK0 LX3 1 LOOK AT BUO FLAG
PL X3,NOT.UB NOT AN EITHER/OR OPERATOR
BLANK1 SA2 B4+CHAR
NG X2,CLX
SB4 B4+1
SX1 X2-1R
LX3 59 . CANCEL PREVIOUS LEFT SHIFT
ZR X1,SUPPRESS . SUPPRESS BLANKS, OUTPUT CHAR
LX3 2 . LOOK AT SPECIAL FLAG
NG X3,SPECIAL GO PROCESS SPECIAL CASE
LX3 58
NOT.B.1 SX6 X3+0 UNARY VALUE TO OUTPUT LATER
SA6 P1SVTAB
SB4 B4-1 BACK UP CHAR POINTER
SX1 P2BLANK
RJ PASS2
SA1 P1SVTAB UNARY VALUE TO OUTPUT NOW
EQ NOINPUT2
NOT.UB SX1 P2BLANK
SB4 B4-1 BACK UP CHAR POINTER
EQ NOINPUT2
SPECIAL LX3 22 GET SPECIAL JUMP FIELD
SB5 X3
JP B5+PASS1
ASTER SX1 X2-1R*
NZ X1,NOT.EXP
SA3 P1EXP
EQ BLANK0
NOT.EXP SX3 P2USTAR
EQ NOT.B.1 OUTPUT BLANK, THEN USTAR
RJ UNPACK
ASTER1 SA2 B4+CHAR
NG X2,*-1
SB4 B4+1
SX1 X2-1R*
NZ X1,NOT.EXP1
SX1 P2ERR4
EQ NOINPUT2
NOT.EXP1 SX1 P2USTAR
SB4 B4-1 BACK UP CHAR POINTER
EQ NOINPUT2
SLASH SX1 X2-1R/
NZ X1,NOT.ALT NOT //, WHICH IS ALTERNATION
SA3 P1TAB+1R!
EQ BLANK0
RJ UNPACK
SLASH1 SA2 B4+CHAR PICK UP CHAR AFTER /
NG X2,*-1
SB4 B4+1
ZR X1,SLASH2
SX1 X2-1R-
NZ X1,NOT.ALT
SA3 P1NOT
EQ BLANK0
SLASH2 SX1 P2ERR4
EQ NOINPUT2 UNARY //, SINCE NO PRECEDING BLAN
NOT.ALT SX1 X2-1R)
NZ X1,NOT.RBR NOT /), WHICH IS RIGHT BRACKET
SX1 P2RGTBR
EQ NOINPUT2
NOT.RBR SX1 X2-1R*
NZ X1,NOT.AND
SA3 P1AND
EQ BLANK0
NOT.AND SX1 X2-1R+
NZ X1,NOT.OR
SA3 P1OR
EQ BLANK0
NOT.OR SX1 X2-1R-
NZ X1,NOT.XOR
SA3 P1NOT
EQ BLANK0
NOT.XOR SX1 X2-1RR
NZ X1,NOT.RYT
SA3 P1RITE
EQ BLANK0
NOT.RYT SX1 X2-1RL
NZ X1,NOT.LFT
SA3 P1LEFT
EQ BLANK0
NOT.LFT SX1 P2CLN
SB4 B4-1 BACK UP CHAR POINTER
EQ NOINPUT2
RJ UNPACK
LPAREN SA2 B4+CHAR
NG X2,*-1
SB4 B4+1
SX1 X2-1R/
SA3 P1TAB+1R(
NZ X1,SUP0
SA3 P1TAB+1R[
EQ SUPPRESS
TITLE PASS1: IDENTIFIER PROCESSING
ID SA1 MAXSTAT TOP OF STATIC
SX6 X1+2 FIRST ADDRESS FOR BCD OF ID
SA6 P1MAX
SX6 42
SA6 CPERW INITIALIZE CHAR/WORD COUNT
BX5 X5-X5 X5 WILL HOL UP TO 7 CHARS
BX6 X6-X6
SA6 CHARLEN LENGTH OF IDENTIFIER
EQ ID3 JUMP INTO MAIN LOOP
ID1 BX6 X5 SAVE X5 WHEN CALLING UNPACK
SA6 P1SVX5
RJ UNPACK GET MORE CHARACTERS
SA1 P1SVX5
BX5 X1 RESTORE X5 (MUST SAVE A5)
ID2 SA2 B4+CHAR
NG X2,ID1 GET MORE CHARACTERS
SB4 B4+1
SA3 P1TAB+X2 LOOK AT IDC FLAG
LX3 3
PL X3,ID4 TERMINATOR FOUND
ID3 RJ PUTCHAR
EQ ID2
ID4 SB4 B4-1 BACK UP CHAR POINTER
RJ LASTCHAR STORE LAST WORD WITH ZERO LINK
SX6 VARTYP
LX6 19
BX6 X4+X6 ADD IN LENGTH IN CHARS (LASTCHAR
* LEAVES LENGTH IN X4)
LX6 18
SA3 MAXSTAT
IX1 X1-X3 CALCULATE BYPASS, X1 = LWA + 1
BX6 X1+X6
LX6 18
SA6 X3+0
SX1 P2VAR
EQ NOINPUT2
TITLE PASS1: LITERAL PROCESSING
LIT SA1 MAXSTAT TOP OF STATIC
SX6 X1+2 FWA OF BCD
SA6 P1MAX INITIALIZE P1MAX FOR PUTCHAR
SX6 42 INITIALIZE BITS AVAILABLE/WORD
SA6 CPERW
BX6 X6-X6
BX5 X5-X5 X5 WILL HOLD UP TO 7 CHARS OF LIT
SA6 CHARLEN NUMBER OF CHARS IN LIT
SX3 X2+0 SAVE TERMINATING QUOTE MARK
EQ LIT2 JUMP INTO MAIN LOOP
LIT1 BX6 X3
BX7 X5
SA7 P1SVX5 SAVE X5
SA6 P1SVX3 SAVE X3 WHEN GETTING CHARS
RJ UNPACK
SA3 P1SVX5
BX5 X3
SA3 P1SVX3
LIT2 SA2 B4+CHAR
NG X2,LIT1 GO GET MORE
SB4 B4+1
SA4 X2+P1TAB
IX6 X3-X2 SEE IF END OF LITERAL
ZR X6,LIT3 YES
LX4 5
NG X4,LIT4 ERROR - NO LITERAL TERMINATOR
RJ PUTCHAR
EQ LIT2
LIT3 RJ LASTCHAR
SX7 LITTYP
LX7 19
BX7 X4+X7 X4 = NO OF CHARS (LASTCHAR SETS)
LX7 18
SA3 MAXSTAT
IX1 X1-X3 ITEM LENGTH
BX7 X1+X7
LX7 18
SX1 SSTY
SA7 X3 LITERAL DESCRIPTOR
LX1 19
BX7 X1+X4
LX7 18
SX1 A6 LWA OF BCD CHARACTERS
BX7 X1+X7
SX1 X3+2 FWA OF BCD CHARACTERS
LX7 18
BX7 X1+X7
SA7 A7+1 SIMPLE VARIABLE DESCRIPTOR
SX1 P2LIT
EQ NOINPUT2
LIT4 SX1 P2ERR3 ERR3 = EOS BEFORE END OF LITERAL
SB4 B4-1 BACK UP CHAR POINTER
EQ NOINPUT2
TITLE PASS1: INTEGER PROCESSING
INT SA1 MAXSTAT TOP OF STATIC
SX6 X1+3
SA6 P1MAX SET UP P1MAX FOR PUTCHAR ROUTINE
SX6 42 BITS AVAILABLE/WORD
SA6 CPERW
SX6 0
SA6 CHARLEN LENGTH OF INTEGER
EQ INT1 JUMP INTO MAIN LOOP
RJ UNPACK GET MORE CHARS
SA2 B4+CHAR
NG X2,*-1
SB4 B4+1
INT1 SX1 X2-1R0
ZR X1,*-2 SKIP LEADING ZEROES
BX5 X5-X5 X5 WILL HOLD UP TO 7 CHARS
BX3 X3-X3 X3 WILL HOLD BINARY FORM
SA4 TEN
EQ INT4 GO BEGIN ACTUAL CONVERSION
INT2 BX6 X3
SA6 P1SVX3 SAVE X3 WHILE GETTING CHARS
BX6 X5
SA6 P1SVX5
RJ UNPACK
SA3 P1SVX3
SA4 P1SVX5
BX5 X4
SA4 TEN
INT3 SA2 B4+CHAR
NG X2,INT2
SB4 B4+1
INT4 SA1 X2+P1TAB
LX1 4
PL X1,INT7 TERM FOUND
SA1 CHARLEN
SX1 X1-11
PL X1,INT6 TOO LONG, TREAT AS LIT
INT5 SX6 X2-1R0 CONVERT DIGIT TO BINARY
PX6 X6 AND
NX6 X6 FLOAT
FX3 X3*X4 OLD TOTAL * 10.0
FX3 X3+X6 + NEW DIGIT
RJ PUTCHAR STORE BCD DIGIT
EQ INT3
INT6 SA1 MAXSTAT
SA1 X1+3 FIRST WORD OF BCD
MX0 42
BX6 X0*X1 CLEAR OLD LINK
SX1 A1 AND ADD
BX6 X1+X6 NEW ONE
SA6 A1-1
SX6 A1+0
SA6 P1MAX P1MAX = C(MAXSTAT)+3
EQ INT5 GO ON
INT7 SX6 X2-1R. TEST FOR REAL NO.
ZR X6,REAL GO PROCESS REAL NUMBER
SB4 B4-1 BACK UP CHAR POINTER
SA2 CHARLEN
SX4 X2-11
PL X4,LIT3 IF> 10 CHARS, TREAT AS LITERAL
NZ X3,INT8
SX5 1R0 ALL ZEROES GIVES ONE ZERO DIGIT
SX6 36
SA6 CPERW SET BITS/WORD TO BE CONSISTENT
SX7 1 . CHARACTER COUNT = 1 FOR INTEGER 0
SA7 CHARLEN
INT8 RJ LASTCHAR
SX6 SITY
LX6 19
BX6 X4+X6 X4 = CHAR COUNT, FROM LASTCHAR
LX6 18
SX2 A6 LWA OF BCD
BX6 X2+X6
LX6 18
SA2 MAXSTAT
SX4 X2+3 FWA OF BCD
SX7 INTTYP
LX7 37
BX6 X4+X6
SA6 X2+1 SIMPLE VARIABLE DESCRIPTOR
UX6 B5,X3
LX6 B5,X6
SA6 X2+2
IX1 X1-X2
BX6 X1+X7 ITEM LENGTH
LX6 18
SA6 X2 STRING-INTGER DESCRIPTOR
SX1 P2INT OUTPUT VALUE
EQ NOINPUT2 OUTPUT P2INT AND GO ON
TITLE PASS1: REAL NUMBER PROCESSING
REAL SA1 ONETENTH =0.1E0
BX5 X1 X5 WILL HOLD SCALE FACTOR FOR ND
REAL1 SA2 B4+CHAR
NG X2,CLZ
SB4 B4+1
SA4 X2+P1TAB
SX2 X2-1R0
PX2 X2
LX4 4 NUMBER CHARACTER FLAG
PL X4,REAL2 TERMINATOR FOUND
NX2 X2
FX2 X2*X5 SCALE DIGIT
FX3 X2+X3 ADD TO TOTAL
FX5 X1*X5 NEXT POWER TO SCALE BY
EQ REAL1
REAL2 SA1 MAXSTAT
SB4 B4-1 BACK UP CHAR POINTER
BX7 X3
SA7 X1+2
SX2 A7 ADDRESS OF BINARY
SX7 RTY
LX7 55
BX7 X2+X7
SA7 X1+1
SX7 REALTYP
LX7 37
SX2 3
BX7 X2+X7 ADD IN ITEM BYPASS
LX7 18
SA7 X1 REAL NUMBER DESCRIPTOR
SX1 P2REAL
EQ NOINPUT2
CLZ BX6 X3
SA6 P1SVX3 SAVE BINARY
BX6 X5
SA6 P1SVX5 SAVE SCALE FACTOR
RJ UNPACK
SA3 P1SVX5
BX5 X3 (MUST NO TOUCH A5)
SA3 P1SVX3
SA1 ONETENTH
EQ REAL1
TITLE PASS1: MISCELLANEOUS ROUTINES FOR INT, LIT, ID
TBUMP DATA 0
SB5 B6
NG B6,*+1
SB5 -B6
SA1 P1MAX
SX1 X1+1
SB5 X1+B5
NG B5,TBUMP
RJ BUMP
EQ TBUMP+1
PUTCHAR DATA 0 ADD CHAR IN XI TO THOSE IN X5
LX5 6
BX5 X2+X5
SA2 CHARLEN
SX6 X2+1
SA6 CHARLEN
SA2 CPERW
SX6 X2-6
NZ X6,PUTCHAR1
RJ TBUMP RETURN WITH C(P1MAX)+1 IN X1
LX5 18
BX6 X1+X5 LINK
SA6 X1-1
SX5 0
SX6 X1+0
SA6 A1+0 UPDATE P1MAX ( = * + 1)
SX6 42 RESET BITS REMAINING/WORD
PUTCHAR1 SA6 CPERW
EQ PUTCHAR
LASTCHAR DATA 0
SA4 CHARLEN
ZR X5,LC1
LC0 RJ TBUMP GET C(P1MAX) + 1 IN X1
SA2 CPERW
SB3 X2+18
LX6 B3,X5
SA6 X1-1
EQ LASTCHAR
LC1 ZR X4,LC0
SA1 P1MAX
SA2 X1-1
MX0 42
BX6 X0*X2 ZERO LINK FOR LAST WORD
SA6 A2+0
EQ LASTCHAR
TITLE PASS2
ZEND SB7 0 . SET OPERAND SITUATION TO ZERO
*
PASS2 NO . ENTRY TO PASS2
P2TRCT NG X1,OPRACT . CHANGED IF TESTOUTPUT TO EQ P2TRC
LT B1,B0,INSKIP . BRANCH IF AFTER ERROR
ACT1 SA2 X1+P2TBL . FETCH TABLEWORD
MX0 56
AX2 B1,X2 . SECONDARY WORD INDEX DEPENDS ON
BX2 -X0*X2 . THE STATE (B1)
SB2 X2
EQ B0,B2,SYXERR . SYNTAX ERROR IF IT IS ZERO
SA2 A2+B2
AX4 B7,X2 . BRANCH IF OPERAND SITUATION IS
NG X4,ACT1A .ALLOWABLE
SX7 X1-P2BLANK
ZR X7,OPRERR4 BLANK AFTER AN UNARY
EQ OPRERR1 NONE OF THE ABOVE
ACT1A SB3 X2 . ACTION TO B3
AX2 18
SB1 X2+0 . NEW STATE TO B1
JP B3+0 . SWITCH TO ACTION
*
OPRACT NE B0,B7,OPRERR2 . ERROR, DELIMITER IS MISSING
SB7 X1
EQ PASS2 . NEW OPERAND SITUATION TO B7
OUTP2 LX2 34 . OUTPUT OUTPART AND RETURN
AX2 52
SX1 X2
OUTX1 ZR X1,ZEND
RJ PASS3
EQ ZEND
*
ACT2 SB2 OPSEXP
EQ B2,B7,ACT17A
DESTACK SA3 A0 . RESTORE STATE AND ACTION FROM
* . THE STACK
SA0 A0+1
SB3 X3
AX3 18
SB1 X3
JP B3+0 . SWITCH TO ACTION
*
ACT3 SX7 ACT1
STAKOUT SB2 OUTP2
STACKX7 BX6 X2 . SET X6 TO STACKPART OF THE
LX6 26 . SECONDARY TABLEWORD
AX6 52
STACKP2 LX6 18 . STACK X6 AND X7, RETURN TO B2
SA0 A0-1
BX6 X6+X7
SB3 A0 . CHECK BUMPING AGAINST PASS3
SB3 A5-B3 . STACK
SA6 A0+0
GE B3,B0,FATBUMP
JP B2+0
*
ACT4 NE B0,B7,OUTP2 . BLANK IN STATE 1
EQ PASS2
*
ACT5 SX7 B7+0 . BLANK IN STATE 2
SA7 TSTPMOP
EQ ACT3
*
ACT6 SX7 ACT7 . $ IN CONDITION
EQ STAKOUT
ACT7 SX0 X1-P2RGTPR
NZ X0,SYXERR1
SX1 P3GTT
EQ OUTX1
*
ACT8 SB2 ACT1 . WEIRD CHARACTER IN STATE2
SX7 ACT1
EQ STACKX7
*
ACT9 SX7 ACT10 . LEFT PARANTHESES ACTION
EQ B0,B7,STAKOUT . NO OPERAND
SB2 ACT9A . IDENTIFIER OPERAND
ACT9B SX7 PASS2
EQ STACKX7
ACT9A SA2 AUXPR
EQ ACT1A
ACT10 SX0 X1-P2RGTPR . CHECK MATCHING RIGHT
NZ X0,SYXERR2
SX1 P3RGTPR
RJ PASS3
SB7 OPSEXP
EQ PASS2
*
ACT11 EQU DESTACK . RIGHT PARANTHESES ACTION
*
ACT12 NE B0,B7,ACT11 . TERMINATOR IN STATE 15
SB1 X1+0 . WITHOUT OPERAND
SX1 P3NULL . SAVE X1 IN B1
RJ PASS3 . OUTPUT P3NULL
SX1 B1 . RESTORE X1 (LAST INPUT BYTE)
SB7 OPSSPEC
EQ DESTACK
*
ACT13 SB2 ACT13A . LEFT BRACKET ACTION
EQ ACT9B
ACT13A SA2 AUXBR
EQ ACT1A
*
ACT14 SX5 ACT15 . LEFT BRACKET AMONG CONDITIONS
SX1 P3COND
BX0 X2
RJ PASS3 . OUTPUT P3COND
BX7 X5 . PASS 3 SAVES X5,X0 IN THIS
BX2 X0 . PARTICULAR CASE
EQ STAKOUT
ACT15 SX0 X1-P2RGTBR
NZ X0,SYXERR3
SX1 P3GTC
EQ OUTX1
*
ACT16 EQU DESTACK .
*
ACT17 LX2 34 . END OF PARAMETER OR SUBSCRIPT
AX2 52 . LIST
SB1 X1 . SAVE X1
SX1 X2
RJ PASS3 . OUTPUT OUTPART
SX1 B1+0 . RESTORE X1
ACT17A SB7 OPSSPEC .
EQ DESTACK
*
ACT18 SA3 TSTPMOP . EQUAL SIGN IN STATE 5
SX0 X3-OPSVAR . LEFT OPERAND OF PM
ZR X0,ACT3 . CAN BE VARIABLE OR SPEC
SX0 X3-OPSSPEC
ZR X0,ACT3
EQ OPRERR3
*
ACT19 EQ B0,B7,ACT19A . SEMICOLON IN STATE 1
SX1 P3LABEL
RJ PASS3
ACT19A SX1 P3RULE4
EQ OUTX1
*
ACT20 SX7 ACT20A . NAME OPERATOR IN STATE 2
EQ STAKOUT
ACT20A SB1 X1+0 . SAVE X1
SX1 P3ENDUN
RJ PASS3 . OUTPUT END UNARY OPERATOR
SB7 OPSEXP
SX1 B1+0
SB1 ST2
EQ ACT1
ACT21 SX7 ACT21A . INDIRECT OPERATOR IN STATE 2
EQ STAKOUT
ACT21A SB1 X1+0
SX1 P3ENDUN
RJ PASS3 . OUTPUT END UNARY OPERATOR
SX1 B1+0 . RESTORE X1
SB7 OPSSPEC
SB1 ST2
EQ ACT1
*
P2TRCS EQ P2TRC
P2TRC SX7 2 . TEST OUTPUT
RJ TRC
NG X1,OPRACT . INSTRUCTIONS DISPLACED BY
LT B1,B0,INSKIP . TEST OUTPUT CALL
EQ ACT1
TITLE PASS3
PASS3 NO . ENTRY TO PASS 3
P3TRCT SA4 X1+P3TBL . FETCH TABLEWORD
NG X4,PASS3A . BRANCH IF ACTION FIRST
P3TRC1 BX1 X4 . (CHANGED IF TESTOUTPUT.
LX1 1
PL X1,P3OUT
RJ OUTST . OUTST IF BIT IS SET
P3OUT BX5 X4
AX5 18
SX6 X5
P3OUTA ZR X6,PASS3B . OUTPUT OUTPART UNLESS IT IS ZERO
RJ PASS4
PASS3B BX5 X4
LX5 4
PL X5,PASS3A . BRANCH IF BIT IS SET
STACKX4 BX6 X4
SA6 A5+1 . STACK TABLEWORD
SB2 A0
SB2 A5-B2 . CHECK BUMPING AGAINST PASS 2
SA5 A6 . STACK
LT B2,B0,PASS3 . AND RETURN
EQ FATBUMP
P3TRCS EQ P3TRC
P3TRC SX7 3 . TEST OUTPUT
RJ TRC
SA4 X1+P3TBL
PL X4,P3TRC1
PASS3A SB2 X4
JP B2+0
*
EJECT
GETVAR NO
+ SA2 MAXSTAT . SET UP SEARCH CALL
SB5 X2+2
SA3 X2
BX5 X2
BX0 X3
AX3 36
SB3 X3
RJ SEARCH
NZ X1,GETVAR . LOOK UP OPERAND
RJ SCHLINK
SB2 OPSVAR
NE B2,B7,GETVAR
SA2 VARLINK . IF VARIABLE LINK IT TO A CHAIN
BX7 X2 . SO AT THE END IT WILL BE
SX6 X1 . INITIALIZED TO A NULL VALUE
SA7 X1
SA6 A2
EQ GETVAR
*
SCHLINK NO
+ SA1 X5 . SET UP LINKAGE IF OPERAND
AX1 18 . WAS NOT FOUND
SB2 X1
SX6 X5+B2
BX7 X2+X5
SA6 MAXSTAT
SA7 A2
SX1 X5+1
EQ SCHLINK
*
SCHLBL NO
+ SA2 MAXSTAT . SET UP SEARCH CALL
SA3 X2
BX5 X2
SB5 X2+2
SX0 LBLTYP
AX3 36
LX0 55 . LABEL TYPE TO X0
SB3 X3
RJ SEARCH
NZ X1,SCHLBL . RETURN IF FOUND
RJ SCHLINK
SA2 X5
MX3 5
BX6 -X3*X2
BX6 X0+X6
SA6 A2+0
SX3 0 . DIRTY TRICK WITH X3
SCHLBL1 MX7 17
SA2 LBLLINK . LINK IT TO LABEL CHAIN
LX7 18
SX6 X1
LX2 18
SA6 A2
BX7 X2+X7
BX7 X3+X7 . SEE ALSO GETLBL3
SA7 X1
EQ SCHLBL
*
GETLBL1 MX0 42 . THIS IS NOT THE ENTRY
BX1 -X0*X3
GETLBL NO
+ RJ SCHLBL . LOOK UP LABEL
SA2 X1 . LABEL DESCRIPTION TO X2
SX3 X2
NG X2,GETLBL1 . STANDARD LABEL (RETURN, ETC.)
BX6 X2
AX6 18
MX0 42
SX6 X6
ZR X6,GETLBL3 . BRANCH IF NOT ON THE CHAIN
PL X3,GETLBL1 . DEFINED LABEL ON THE CHAIN
SA1 PRGBASE
SX6 X1+B6
LT B6,B0,GETLBL2 . RELATIVE MICOP ADDRESS
SX6 B0-B6 . TO X6
IX6 X1+X6
GETLBL2 BX6 -X6
SX6 X6-1 . MAKE IT NEGATIVE
BX2 X0*X2
BX6 -X0*X6
BX6 X2+X6
SA6 A2
BX1 -X0*X3
EQ GETLBL
GETLBL3 BX3 -X0*X2 . NOTE HOW WE JUMP INSIDE OF SCHLBL
LX3 36 . WHICH HAS JUST BEEN CALLED
EQ SCHLBL1
*
OUTST NO
+ SB2 OPSREAL . BYPASS IF OPERAND IS EXPRESSION
LT B7,B2,OUTST3 . OR SPEC
RJ GETVAR
OUTST2 SX6 XOPRND . OUTPUT OPERAND
LX1 18
BX6 X1+X6
RJ PASS4
OUTST3 BX1 X4
MX0 54
AX1 36
BX2 -X0*X1 . THE PRIORITY OF THE OPERATOR
SB5 X2+0 . TO B5
SA5 A5+0 . TOP ELEMENT IN THE STACK TO X5
OUTST4 LX5 24
MX0 54
BX2 -X0*X5
SB3 X2 . PRIORITY OF TOP OPERATOR
LT B3,B5,OUTST . IF SMALLER , EXIT
BX6 X6-X6
LX5 38 . IF NOT NAME, STAR ETC.
PL X5,OUTST7 . THEN BYPASS
RJ GIVENM
LX5 1 . BRANCH IF LAST MICOP IS
BX6 X6-X6
PL X2,OUTST5 . NOT AN OPERAND
PL X5,OUTST5
SA1 B6 . ONLY FOR STAR, PRD OR DOL
AX1 18
SX6 X1
SB6 B6+1
SB6 B0-B6
OUTST8 LX6 18
OUTST5 MX0 48
AX5 45 . OUTPUT TOP OPERATOR
BX0 -X0*X5
BX6 X0+X6
ZR X6,OUTST6 . UNLESS ZERO
RJ PASS4
OUTST6 SA5 A5-1
EQ OUTST4
OUTST7 LX5 1 . JUMP BACK IF NOT ASSIGN
PL X5,OUTST5
BX6 X5
LX6 21 . ADDRESS OF ASSIGN TO X6
AX6 42
EQ OUTST8
*
GIVENM NO
+ LT B6,B0,GIVENM1 . BYPASS IF LAST MICOP WAS A XCALL
SA1 B6
MX0 53
SA2 X1+MCOPTBL
LX2 37 . EXCHANGE LAST MICOP BY ITS
MX6 42 . NAME ALTERNATIVE
BX7 -X0*X2
BX6 X6*X1
BX7 X6+X7
SA7 B6
BX6 X6-X6 . X6 MUST BE STILL ZERO
EQ GIVENM
GIVENM1 MX2 1 . IF XCALL, SET CHECK NAME BIT
SA1 B0-B6
LX2 59
BX6 X1+X2
SA6 A1
EQ GIVENM
EJECT
ARULE4 SX6 XNOOP . EMPTY RULE
RJ PASS4
ARULE1 GE B6,B0,ARULEA . SET NEW RULE BIT ON LAST MICOP
SB6 B0-B6
ARULEA SA1 B6
MX0 1
BX6 X0+X1
BX7 X7-X7
SA6 A1
SB6 B0-B6 . NEXT MICOP INTO NEW WORD
SA7 TESTCND
EQ PASS3
*
ARGTPR SA5 A5-1 . RIGHT PARANTHESES, REMOVE TOP
EQ PASS3 . OPERATOR
*
ALFTBR RJ GETVAR . LEFT BRACKET
BX5 X4
AX5 18
LX1 18
SX6 X5
BX6 X1+X6
EQ P3OUTA
*
APM SB2 OPSREAL . PATTERN MATCH
LT B7,B2,STACKX4 . BRANCH IF LEFT OP NOT SIMPLE
SA1 -B6
BX6 X1 . SET ADDRESS PART OF PMCHECK TO
AX1 18 . OPERAND ADDRESS
SX1 X1
LX1 36
BX6 X1+X6
SA6 A1
EQ STACKX4
*
AASGN SX0 B7-OPSVAR
ZR X0,AASGN1
RJ OUTST
RJ GIVENM
EQ STACKX4
AASGN1 RJ GETVAR
LX1 18
BX4 X1+X4
EQ STACKX4
*
ABCALL SA2 MAXSTAT . BEGIN CALL ACTION
SX0 3 . CALLTYP EQORED WITH VARTYPE
SB5 X2+2
LX0 55
SA3 X2 . LOOK UP FUNCTION
BX7 X3-X0
BX5 X2
BX0 X7
AX3 36
SA7 A3
SB3 X3
RJ SEARCH
NZ X1,ABCALL1
RJ SCHLINK . IF NEW, INITIALIZE TO UNDEFINED
SX2 MARK
SX7 UNDFTYP
LX7 55
LX2 18 . AS MANY PARAMS AS YUO WISH
BX7 X7+X2
SA7 X1
ABCALL1 SA2 X1 . CLEAR NOT USED BIT
LX2 2
AX2 1
LX2 59
BX7 X2 . STACK AN ENTRY WITH X1
LX1 18 . AND 0 COUNTING PART
SA7 A2
MX0 42
BX4 X4+X1
BX4 X0*X4
EQ STACKX4
*
APARAM SA5 A5 . PARAMETER COMMA
SX0 1 . INCREASE NUMBER OF PARAMETERS
IX6 X5+X0 . BY ONE
SA6 A5
EQ PASS3
*
ACALL SA1 A5 . END CALL
SA5 A5-1
MX2 42
SX0 X1+1 . NO OF PARAMS TO X0
LX2 18
BX1 -X2*X1 . FUNCTION NAME TO X1
LX0 36
SX2 XCALL
BX6 X0+X1
BX6 X2+X6
RJ PASS4 . OUTPUT MICOP
SB6 B0-B6 . NEXT MICOP INTO NEW WORD
EQ PASS3
*
ARGTBR SA1 A5 . RIGHT BRACKET
SA5 A5-1 . REMOVE TOP OPERAND
SX0 X1
SX6 XARRAYV
LX0 18
BX6 X6+X0
RJ PASS4
EQ PASS3
*
ALABEL RJ SCHLBL . LOOK UP LABEL
SA2 X1 . LABEL DESCRIPTION TO X2
MX0 42
NG X2,ERRLBL
SB2 X2
BX7 X0*X2
LT B0,B2,ERRLBL2
BX3 X2 . TEST IF IT WAS USED OR DEFINED
AX2 18 . IN EARLIER COMPILATION
LX3 36 .
ZR X2,SCHLBL1 . BEWARE OF DIRTY TRICKS
SX1 B2
AX2 18
SX2 X2-1
PL X2,ERRLBL3
SA3 PRGBASE
SX6 X3+B6 . NOTE THAT B6 IS NEGATIVE
LX0 18
SB2 1
SX6 X6+B2
BX7 X6+X7
LX6 18
SA7 A2 . NEW LABEL DESCRIPTION
ALABEL1 SX2 X1+B2 . GO BACK IN THE CHAIN
ZR X2,ALABEL2 . AND ASSIGN DEFINED LABEL VALUE
IX7 X1+X3 . THE CHAIN ENDS WITH A -1 LINK
SA1 X7
BX7 X0*X1
BX7 X7+X6
SA7 A1
AX1 18
SX1 X1
EQ ALABEL1
ALABEL2 SA3 ENDBCD . TEST FOR END LABEL
SA2 A2+B2
BX2 X2-X3
NZ X2,PASS3 . RETURN IF NOT END
SB1 -2
EQ PASS3
*
ENDBCD DATA 3LEND
*
* NOTE THAT THE FOLLOWING CODE SAVES X0 AND X5. THIS FEATURE IS
* USED ELSEWHERE IN THE CODE (ACT14).
*
ACOND SA2 TESTCND . AFTER A CONDITION
SX3 3B . SET MASK TO NEITHER S NOR F
SX4 X3
EQ B7,B0,ACOND1
AX3 1 . SET MASK TO NO S
SA1 MAXSTAT
SX7 1RF
SA1 X1+2
SX6 1RS
LX1 6
BX6 X6-X1
ZR X6,ACOND1 . BRANCH IF S
LX3 1 . SET MASK TO NO F
BX7 X7-X1
NZ X7,ACOND2 . ERROR IF NOT F
ACOND1 SX2 X2 . CHECK PREVIOUS CONDITION (IF ANY)
BX7 X2+X3 . AGAINST MASK
SX6 X2
BX2 X2*X3
ZR X6,ACOND3 . SECOND GO TO IS UNCONDITIONAL
SX3 X4
ACOND3 LX3 18
BX7 X3+X7 . PRESENT CONDITION TO X7
SA7 A2
ZR X2,PASS3
ACOND2 SX1 P2RGTPR . PREPARE FOR ERROR
EQ ERRCND2 . ERRORNEOUS CONDITION
*
AGT RJ GETLBL
SA2 TESTCND
LX1 18 . OUTPUT A GOF, GOS OR GO TO
SX6 XGOX . MICOP DEPENDING THE CONDITION
AX2 18
IX6 X6+X2
BX6 X6+X1
RJ PASS4
SB6 B0-B6
EQ PASS3
*
ABGTT SA2 TESTCND
AX2 18
BX2 -X2
SX5 X2+3B
SA3 PRGBASE
SX2 B6
PL X2,ABGTT3
BX2 -X2
ABGTT3 IX3 X3-X2
ZR X5,ABGTT2 . BRANCH IF UNCONDITIONAL
SX6 XGOTO . A BYPASS JUMP WILL BE STORED
RJ PASS4 . INSTEAD OF THIS MICOP BY AGTT
SA3 PRGBASE
SX2 B6
MX0 42
IX3 X3-X2 . RELATIVE MICOP ADDRESS TO X3
BX4 X0*X4
LX5 18 . FORM STACK ENTRY USING NEGATED
BX4 X4+X3 . CONDITION CODE AND ADDRESS IN X4
BX4 X4+X5
LX5 41
PL X5,ABGTT1 . BYPASS IF S
ABGTT2 SX6 X3+2
SX7 XGOF . OUTPUT GOF *+1
LX6 18
BX6 X6+X7
RJ PASS4
ABGTT1 SX6 XNOFAIL . OUTPUT MICOP TO CHECK
RJ PASS4 . AN EVENTUAL FAILURE IN THE
EQ STACKX4 . FOLLOWING EXPRESSION
*
AGTT SA1 A5
SA5 A5-1 . REMOVE TOP OPERATOR
SB3 X1
AX1 18
SB2 X1
EQ B0,B2,PASS3 . READY IF UNCONDITIONAL
SA2 PRGBASE
SX6 B2+XGOX . BYPASS JUMP TO X6
SB2 B0-B6
SX3 X2+B2
GE B6,B0,AGTT1
SX3 X2+B6 . REL ADDRESS TO X3
AGTT1 SX3 X3+1
LX3 18
BX6 X6+X3
SB3 B0-B3
SA6 X2+B3 . STORE BYPASS JUMP
EQ PASS3
*
EJECT
TITLE PASS4
PASS4 NO
P4TRCT SA1 X6+MCOPTBL . FETCH TABLE ENTRY
NO
LX1 40
P4TRC1 NG X1,PASS4B . BRANCH IF LOW ORDER ONLY
GE B6,B0,PASS4C
SA2 MINSTAT
SB6 B6+1 . B6 IS NEGATIVE
SB2 X2+B6 . STORE MICOP IN LOW ORDER BITS
SA6 B0-B6
LT B2,B0,PASS4 . CHECK BUMPING AGAINST STATIC
PASS4A RJ BUMP
EQ PASS4
PASS4C SA1 B6 . STORE MICOP IN HIGH ORDER BITS
SX2 X6
AX6 18
LX2 54 . OPERATION TO X2
LX6 36 . ADDRESS TO X6
BX6 X6+X2
SB6 B0-B6 . NEXT MICOP INTO NEW WORD
BX6 X6+X1
SA6 B0-B6
EQ PASS4
PASS4B GE B6,B0,PASS4D . STORE MICOP IN LOW ORDER BITS
SB6 B0-B6
PASS4D SA2 MAXSTAT
SB6 B6-1
SB2 X2
SA6 B6
SB2 B2-B6
LT B2,B0,PASS4
EQ PASS4A
*
P4TRCS EQ P4TRC
P4TRC SX7 4
BX1 X6
BX6 X4
SA6 P4SVX4
SX6 B5+0
SA6 P4SVB5
RJ TRC
SA2 P4SVB5
BX6 X1
SB5 X2
SA1 X1+MCOPTBL
LX1 40
SA4 P4SVX4
EQ P4TRC1
*
INSKIP1 SA2 X1+P2TBL+1
SX3 X1-AUXERR
LX2 7
SB7 B0
PL X3,PASS2
PL X2,PASS2
SB1 ST1
SA5 BGP3STK
SA0 BGP2STK
EQ ACT1
INSKIP SX2 B1+1
ZR X2,INSKIP1
SX2 X1-P2END
ZR X2,AEND3
EQ PASS2
ERRACT1 SX7 KE1
EQ KSKM
ERRACT2 SX7 KE2
EQ KSKM
ERRACT SX7 KE
EQ KSKM
ERRACT3 SX7 KE3
EQ KSKM
SYXERR SX7 KS
EQ KSKM
SYXERR1 SX7 KS1
EQ KSKM
OPRERR1 SX7 KO1
EQ KSKM
OPRERR2 SX7 KO2
EQ KSKM
OPRERR3 SX7 KO3
EQ KSKM
OPRERR4 SX7 KO4
EQ KSKM
ERRCND2 SX7 KC2
EQ KSKM
SYXERR2 SX7 KS2
EQ KSKM
SYXERR3 SX7 KS3
EQ KSKM
ERRLBL2 SX7 KL2
EQ KSKM
ERRLBL3 SX7 KL3
EQ KSKM
ERRLBL SX1 P2RGTPR FAKE FAKE FAKE
SX7 KL
KSKM LX7 18 UP THE ERR ADDR AND PUT IN OFFSET
SX2 B4 PUT THE OFFSET IN AN X REGISTER
BX7 X7+X2 OR IN THE OFFSET
LX7 18 UP THE WHOLE WORD ONE BYTE
SA2 HCOLS PICK UP THE NUMBER OF TEN CHAR WORDS
BX7 X7+X2 OR IN THE WORD COUNT
SA7 ARROWD STORE THE TOTAL IN THE ERROR INDICATR
SB1 -1 SET UP THE ERROR INDICATOR
EQ INSKIP
*
AEND SX6 XNOEND
EQ AEND2
AEND3 SX6 XEND
AEND2 RJ PASS4
SX6 XEND
RJ PASS4 . THE WORD FOR THIS EXTRA END WILL
* BE USED FOR THE CODE HEADING
SA1 NXTWRD . BRANCH IF NOT COMPILATION
PL X1,AEND6 . FROM CARDS
SA5 P1ERFLG
ZR X5,AEND5
BX6 X6-X6
SB4 X5 . REMEMBER THE ERRORFLAG
RJ P1PB
PL X5,AEND1 . BRANCH IF COMPILATION UNSUCCESFUL
SA2 SMESS
SA1 SMESS+1
SA5 SMESS+2 . ISSUE MESSAGE INTO OUTPUT
BX6 X2
RJ PB
BX6 X1
RJ PB
BX6 X5
RJ PB
AEND1 WAIT . MAKE SURE OUTPUT FILE IS NOT BUSY
WRITER RECALL . WRITE END OF RECORD (LEVEL 0)
PL B4,ABT . FLUSH BUFFERS AND ABORT
AEND5 SA1 SCALL
BX6 X1
SA6 1
+ SA1 1
NZ X1,*
EQ POST0 . NOW RELOCATE THE CODE
AEND6 SA5 ARROWD
ZR X5,POST0 . NO COMPILATION ERRORS
SB5 -51
EQ RTERROR
TITLE GET NEXT CHARACTERS WHEN COMPILING STRINGS
*
* GETNEXT IS USED WHEN THE COMPILER IS CALLED VIA THE CONVERT FUNCTION.
* IT EXPECTS THE NEXT STRING WORD TO UNPACK TO BE AT THE LOCATION
* SPECIFIED BY THE LOWER 18 BITS OF NXTWRD. WHEN GETNEXT REACHES THE END
* OF THE STRING, IT OUTPUTS AN ENDPRG CHARACTER. GETNEXT USES X1, X2,
* X6, AND X7. IT RESETS B4 TO ZERO, SINCE IT EXITS BY JUMPING TO "EXIT"
* IN UNPACK.
*
GETNEXT SA2 X1 . X2 = LIST WORD TO PROCESS
SX6 X2 X6 = ADDRESS OF NEXT WORD, BETTER NOT
* BE NEGATIVE.
SA6 A1 UPDATE NXTWRD
BX2 X2-X6 CLEAR LOWER 18 BITS OF X2
SB4 B0
MX1 6
GETNEXT1 BX7 X1*X2
ZR X7,GETNEXT2 STOP ON ZERO CHARACTER
LX7 6
SA7 B4+CHAR OUTPUT THIS CHAR
SB4 B4+1
LX2 6
EQ GETNEXT1
GETNEXT2 NZ X6,LEAVE
SX7 P1EOS-P1TAB . END OF STATEMENT
SA7 B4+CHAR
SA6 B4+CHAR+1 . P1END-P1TBL = 0
EQ LEAVE EXIT TO UNPACK, WHERE -1 WILL BE STOR
* AT END OF CHAR, THEN FINAL RETURN IS
* MADE.
TITLE COMPILATION TIME FIELDLENGTH REQUEST
* BUMP IS CALLED WHENEVER THE COMPILER RUNS OUT OF STORAGE
*
BUMP NO
+ SX6 B6 . GET ADDRESS OF LAST MICOP
PL X6,BUMP1
BX6 -X6
BUMP1 SA6 MINSTAK . CONSIDER THE CODE AS THE BOTTOM
SA1 COMPB7
SX0 B7
SB7 X1 . START OF FREE CHAIN
SA1 FRSTWRD . ENTRY IN THE STACK
SA2 NXTWRD
NG X2,BUMP3
SX6 B7
SB7 X1
BUMP2 SA1 X1 . FREE THE TRANSLATED SOURCE
SX1 X1+0 . STRING
BX7 X1-X2
NZ X7,BUMP2
SA6 A1
SX2 SSTY
LX2 55
BX7 X1+X2 . SS TYPE FOR SOURCE STRING
SA1 MINSTAT
SA7 X1+XWDREL
BUMP3 SX6 B6 . SAVE LAST MICOP ADDRESS
SX7 A0 . SAVE STACK POINTER
SA2 MAXSTAK
SB6 X2 . STACK TOP
SA0 FLDINCR-1
RJ RESERVE . PROVOKE FIELDLENGTH REQUEST
SA1 MAXSTAK
SA0 X7 . RESTORE STACK POINTER
SX7 B7
SA7 COMPB7
SA2 MINSTAK
SB7 B0-B6
SB7 X1+B7
BX7 -X2
SB6 B6-FLDINCR+1
SB6 B6+X7
SB7 B7+FLDINCR-1
BUMP4 SA1 X2+B6 . PUSH THE STACK AND MICOPS
SB6 B6-1 . INTO THE NEW AREA
BX7 X1
SA7 A1+B7
GE B6,B0,BUMP4
SA1 PRGBASE
SX7 X1+B7
SA7 A1
SB6 X6
GE B6,B0,BUMP5
SB7 B0-B7
BUMP5 SB6 B6+B7 . RESTORE MICOP ADDRESS
SB7 X0 . RESTORE OPSIT
SA1 NXTWRD
NG X1,BUMP
SA2 MINSTAT . RESTORE SOURCE STRING POINTER
SA2 X2+XWDREL
BX6 X6-X6
BX7 X2
SA6 A2
SA7 A1
SA7 FRSTWRD
EQ BUMP
TITLE PASS1: CHARACTER UNPACKING AND LISTING GENERATION
UNPACK DATA 0
SA1 NXTWRD
PL X1,GETNEXT BRANCH IF COMPILATION FROM A STRING
SA1 HCOLS PICK UP THE WORD COUNTER
SX6 X1+1 INCREMENT IT
SA6 A1 STORE IT BACK
SA1 COLS SEE IF IN END OF LINE STATE
NZ X1,UP3 NO
SX6 B0 CLEAR OUT THE WORD COUNTER
SA6 HCOLS
SX6 72
SA6 COLS RESET REMAINING COLUMNS INDICATOR
SA1 ARROWD SEE IF ERRORS TO INDICATE
ZR X1,UP2 NO
SX6 B0 FINISH THIS LINE
RJ P1PB OUT WE GO
SX6 1
SA6 P1ERFLG IN CASE NO LIST WAS ON
SA2 HERRMES PICK UP THE WORD **ERROR**
SA1 ARROWD NOW GET THE ERROR DESCRIPTOR
BX6 X2 AFTER A RESPECTFUL WAIT PRINT ERROR
RJ PB DOWN THE CHUTE
SA2 HYPHEN PICK UP THE WORD OF RIGHT ARROWS
SB5 X1 TRIM OFF THE DESCRIPTOR BYTE COUNT
EQ B5,B0,HFORGET ERROR IN FIRST BYTE FORGET ARROWS
BX6 X2 COPY THE ARROWS TO AN OUTPUT REGISTER
HLOOP RJ PB EMPTY THE QUIVVER OF ARROWS
SB5 B5-1 DECREMENT THE WORD COUNT
LT B0,B5,HLOOP ARE WE DONE YET(IF NOT JUMP)
HFORGET AX1 18 GET THE OFFSET IN THE DESCRIPTOR
SA2 X1+HARO-1 CHOOSE YOUR WEAPON CAREFULLY
BX6 X2 ONCE AGAIN WE MUST STORE FROM X6
RJ PB THREE,TWO,ONE, FIRE.....
AX1 18 RETRIEVE THE ERROR MESS ADDRESS
SB5 X1+4 PICKUP THE OFFSET ERR MESS ADDRESS
SB4 -4 THIS IS THE COMPLEMENT OF THE MESS LE
HSTOP SA1 B5+B4 GET THE ERROR WORD FROM THE TABLE
BX6 X1 ACROSS WE GO TO X6
RJ PB OUT,OUT, DAMN WORD
SB4 B4+1 INCREMENT THE COUNTER
LT B4,B0,HSTOP IF WE REACHED 4 QUIT,IF NOT JUMP
BX6 X6-X6 EXOTIC ARENT WE
SA6 ARROWD CLEAN ARROWS NOSE
RJ P1PB P1PB CHECKS LINE COUNT
BX6 X6-X6
RJ P1PB . PRINT BLANK LINE
UP2 SX6 1 CONTINUED STATEMENT LEGAL FLAG
UP2.5 SB2 INFET
RJ CBI RETURN WITH X1.NE.0 IF NOT EOR
ZR X1,UP7 YES, EOR
SA1 X2 CBI LEFT X2 = FET.OUT
MX0 6
BX3 X0*X1 LOOK AT FIRST CHAR
LX3 6
SX4 X3-1R* SEE IF THIS IS A COMMENT LINE
ZR X4,UP8 YES
SX4 X3-1R. SEE IF IS CONTINUATION LINE
ZR X4,UP10 YES
SX4 X3-1R- IS IT A CONTROL CARD
ZR X4,CONCRD YES IT IS
UP2.7 SA1 RULENO
RJ ICX1X6 CONVERT TO BCD
SX1 1R
SX4 77B
UP2.8 BX7 X4*X6
NZ X7,UP2.9
BX6 X1+X6
LX1 6
LX4 6
EQ UP2.8
UP2.9 LX6 54
RJ P1PB PUT RULENO INTO BUFFER
SA1 COLS
UP3 SB3 X1 COLS REMAINING TO PROCESS
SB5 B0
SB2 INFET
RJ GETB GET NEXT WORD IN X2,X3
UP3.5 SX6 B3+0
SA6 COLS
BX5 X2 SAVE WORD TO UNPACK
BX6 X3 WORD TO LIST
RJ P1PB
SX0 77B
SB4 0
UP4 LX5 6
BX6 X0*X5 NEXT CHZR
ZR X6,UP5 DO NOT PUT ZEROES IN BUFF
SA6 CHAR+B4
SB4 B4+1
BX5 -X0*X5 ZERO CHAR JUST STORED
EQ UP4
UP5 ZR B5,LEAVE IF NO EOL, EXIT
SX5 B4 SAVE POS
BX6 X6-X6
SA6 COLS FLAG END OF LINE
SB5 B5-2 SEE IF ZERO BYTE HAS BEEN REACHED
NZ B5,UP6 YES
SB3 10
SB5 0
SB2 INFET
RJ GETB GET LAST WORD
BX6 X3
RJ CZB . SKIP TO ZERO BYTE
RJ P1PB LIST COLS 81 - 90
UP6 BX6 X6-X6
RJ P1PB ZERO BYTE
SB2 INFET
RJ CBI CHECK IF BUFF NOT EMPTY
SB4 X5
ZR X1,UP6.5
SA1 X2 X2 = FET.OUT
LX1 6
SX0 77B
BX1 X0*X1
SX1 X1-1R.
ZR X1,LEAVE NO EOS, EXIT
UP6.5 SX6 100B EOS CHARACTER
SA6 B4+CHAR
SB4 B4+1
LEAVE SX6 -1 TERMINATOR
SA6 B4+CHAR
SB4 0
EQ UNPACK
UP7 SX6 B0 ENDPRG CHARACTER
SA6 CHAR
MX7 1
BX7 -X7*X4 CLEAR EOR BIT
LX7 5
SA7 A4+0
SB4 1
EQ LEAVE
UP8 SB3 90
SA1 BLANKS
BX6 X1
SB5 B0
RJ P1PB
UP9 SB2 INFET
RJ GETB
BX6 X3
RJ P1PB
ZR B5,UP9
SX6 0
RJ P1PB
SX6 0
EQ UP2.5 LOOK FOR MORE COMMENTS, X6 = 0
* MEANS CONTINUE NTO RECOGNIZED
UP10 ZR X6,UP2.7 CONTINUE LEGAL FLAG NOT SET
SA1 BLANKS
BX6 X1
RJ P1PB
SB2 INFET
SB3 72
SB5 B0
RJ GETB
MX0 6
BX2 -X0*X2
LX2 6 PERIOD SHOUL NOT BE PUT IN BUFF
EQ UP3.5
P1PB DATA 0
SA1 P1ERFLG
SB2 OUTFET
ZR X1,P1PB
RJ PB
RJ CBO
NZ X6,P1PB
SA1 LC
SX6 X1+1
SA6 LC
NG X6,P1PB
RJ HEADING
EQ P1PB
TITLE TRACE ROUTINE
TRC DATA 0
SA7 TRCSVX7
BX5 X1
BX6 X6-X6
RJ P1PB GUARANTEE ZERO BYTE
SA2 BLANKS
SA1 TRCSVX7
BX6 X2
SB3 X1
SX1 X5+0
TRC1 SB3 B3-1
RJ PB
NZ B3,TRC1
MX0 57
MX4 54
SX2 1R~
NG X1,TRC3
TRC2 BX2 -X0*X1
AX1 3
SX2 X2+1R0
TRC3 BX6 X4*X6
BX6 X2+X6
LX6 54
NZ X1,TRC2
RJ P1PB
BX1 X5
EQ TRC
CONCRD MX0 18
BX3 X0*X1 PICK OFF THREE CHARACTERS
LX3 18
SX4 X3-3R-EJ
NZ X4,NOTEJCT
CONHEAD SX6 B0
SA6 LC
RJ P1PB
CONTIX SB5 B0
SB3 90
TITLOOX SB2 INFET
RJ GETB
ZR B5,TITLOOX
CONFIX SX6 0
EQ UP2.5
NOTEJCT SX4 X3-3R-SP IS IT A -SPACE CONTROL CARD
NZ X4,NOTSPCE TOO BAD NOT THIS EITHER
SX6 B0
MX0 36
BX1 -X0*X1
MX0 6
LX0 6
LX1 42
SPCLOOP BX4 X1*X0
BX1 -X0*X1
LX1 6
SX3 X4-1R
ZR X3,SPCLOOP ALLOW FREE FORMATTING OF THE SPACE NUM
ZR X4,REPTFAC
SX3 X4-1R0
LX6 1
BX4 X6
LX6 2
IX6 X6+X4
IX6 X6+X3
EQ SPCLOOP
REPTFAC SA6 REPLSP
ZR X6,CONTIX
SX6 B0
RJ P1PB
SX6 X6+LINES-2
ZR X6,CONTIX
SA1 REPLSP
SX6 X1-1
EQ REPTFAC
REPLSP BSSZ 1
NOTSPCE SX4 X3-3R-TI IS IT A -TITLE CARD
NZ X4,CONTIX IM NO SWAMI FORGET THIS CARD
SB5 B0
SB3 90
SX6 PAGE+1
SA6 SPORTIT
SB2 INFET
RJ GETB
TITLOOP SB2 INFET
RJ GETB
BX6 X3
SA3 SPORTIT
SA6 X3
SX6 X3+1
SA6 SPORTIT
ZR B5,TITLOOP
SX6 B0
SA6 LC MAKE P1PB THINK WE ARE AT THE BOTTOM OF THE PAGE
RJ P1PB EJECT A PAGE AND CLEAR THE BUFFER
EQ CONFIX CALL FOR THE NEXT STATEMENT TO BE READ
*
* HEADING DESTROYS X0,X1,X2,X3,X4,X6,X7,B3.
*
HEADING DATA 0
SA1 PAGENO
SX6 X1+1
SA6 A1
RJ ICX1X6
SA1 MASKM
IX2 X1-X6
BX2 X2-X6
BX2 X2*X1
LX2 54
BX2 -X6*X2
BX1 X2
LX1 2
BX1 X2+X1
BX6 X6+X1
LX1 3
BX6 X6+X1
SA6 PAGE
SB5 TITLE-TITB-1
HD1 SA2 TITB+1+B5
SB2 OUTFET
BX6 X2
RJ PB
SB5 B5+1
NZ B5,HD1
BX6 X6-X6
RJ PB SKIP LINE AFETER TITILE
SX6 -LINES+2
SA6 LC
EQ HEADING
KE DIS ,$ THIS CHARACTER ALLOWED ONLY IN LITERALS $
KE1 DIS ,$ THIS OPERATOR CANNOT BE UNARY $
KE2 DIS ,$ UNCLOSED LITERAL (ODD NUMBER OF QUOTES) $
KE3 DIS ,$ INVALID CHARACTER AFTER * OR / $
KS DIS ,$ BINARY OP WITH MISSING ARGUMENT $
KS1 DIS ,$ PARENTHESIS OR GROUPING ERROR $
KS3 DIS ,$ UNBALANCED BRACKETS $
KS2 DIS ,$ UNBALANCED PARENTHESES $
KC2 DIS ,$ ERROR IN GO TO FIELD OF STATEMENT $
KO1 DIS ,$ ERRONEOUS OPERATOR FOUND $
KO2 DIS ,$ MISSING BLANK OR DELIMITER $
KO3 DIS ,$ ERRONEOUS USE OF EQUALITY $
KO4 DIS ,$ BLANK FOLLOWS UNARY OPERATOR $
KL DIS ,$ RESERVED WORD USED AS LABEL $
KL2 DIS ,$ THIS LABEL IS MULTIPLY DEFINED $
KL3 DIS ,$ LABEL DEFINED IN PREVIOUS COMPILATION $
HYPHEN DATA 65656565656565656565B
HERRMES DATA 10H **ERROR**
HCOLS DATA 0 THIS IS THE COLUMN POINTER
DATA 70555555555555555555B
HARO DATA 70555555555555555555B
DATA 65705555555555555555B
DATA 65657055555555555555B
DATA 65656570555555555555B
DATA 65656565705555555555B
DATA 65656565657055555555B
DATA 65656565656570555555B
DATA 65656565656565705555B
DATA 65656565656565657055B
DATA 65656565656565656570B
DATA 65705555555555555555B
SCALL VFD 18/3LMSG,42/SMESS
TITLE DATA 10H1CAL S N
DATA 10HO B O L
DATE DATA 0
DATA 10H
TIME DATA 0
DATA 10H PAGE
PAGE DATA 0
DATA 10H
DATA 10H
DATA 10H
DATA 10H
DATA 10H
TITB DATA 10H
DATA 0
DATA 0
DATA 0
DATA 0
DATA 0
SPORTIT DATA 0
TITLE TEMPORARY TRACE R3UTINE
TRACE IFNE TRCFLG,0
QTRC SX5 X5-1
NZ X5,ERR20 . TOO MANY PARAMETERS
SA1 B6
AX1 55
NZ X1,QTRC2 . SEE IF INTEGER
SA1 B6-1
SA1 X1+0
NZ X1,QTRC1 . PARAM NULL
RJ UNTRACE . TURN OFF TRACE
EQ NEXTMIC
QTRC1 RJ TRACE . TURN ON TRACE
NO
VFD 30/1
+ EQ NEXTMIC
QTRC2 SX1 X1-ITY
NZ X1,QTRC1 . NOT INTEGER
SA1 B6-1
SA2 QTRC3
AX2 30
LX2 30
BX6 X1+X2
SA6 A2
RJ CMREF
QTRC3 VFD 6/0,24/-0,30/0
RJ TRACE
EQ NEXTMIC
LIST -L,-R
TITLE DEBUGGING PACKAGE
TITLE SNAPSHOT DUMP PROGRAM
* TIMING INFORMATION: 10 MILLISECONDS PER DUMP
OCTBCD MACRO XI
LOCAL LOOP,DONE
IFC NE,$XI$X1$,1
BX1 XI
SX6 B0
SX7 B0
SB2 10
MX0 57
LOOP LX1 3
SB2 B2-B1
BX2 -X0*X1
LX7 6
SX2 X2+1R0
BX7 X7+X2
NZ B2,LOOP
NZ X6,DONE
BX6 X7
SB2 10
SX7 B0
EQ LOOP
DONE BSS 0
ENDM
TITLE REGISTER DUMP SECTION
SNAPRET SA1 INP
SA2 OUTP
SA3 FIRSTP
SA4 LIMITP
SA1 X1
SA2 X2
SA3 X3
SA4 X4
IX5 X1-X2 AMMOUNT IN BUFFER
IX0 X4-X3 BUFFER SIZE
+ PL X5,*+1
IX5 X0-X5 COMPENSATE FOR WRAP ROUND
+ AX0 1
IX5 X5-X0 CHECK IF OVER HALF FILLED
NG X5,SNAPQ
SA1 STATUSP
SA1 X1
LX1 59
PL X1,SNAPQ
SA2 FILENAM
SX6 16B WRITE OPCODE
BX6 X2+X6
SA6 A1
SA2 WRITE+1
BX6 X2
+ SA1 B1
NZ X1,*
SA6 A1
+ SA1 1 WAIT FOR RA+1 TO CLEAR
NZ X1,*
SNAPQ RJ RESTORE
SNAP BSSZ 1
RJ SAVEREG
* FIND OUTPUT FILE
RJ GETFET
SA1 REGI
BX6 X1
SA6 SNAPQ
SNAPY SA1 SNAP
LX1 30
SB3 B0 REGISTER NUMBER
SB4 B0 OUTPUT WORD
SA2 X1-1 GET REQUEST OWRD
SB1 B2 SET B1 TO 1
MX0 36
BX4 -X0*X2 GET BITS
MX0 6
LX0 30
BX6 X0*X2
AX6 24
SA6 NUMBLK
SX6 B0
SA6 LINE+1
DUP 12,1
SA6 A6+B1
ZR X4,SNAPB SENSE NO INPUT
LX4 36 POSITON FIRST BIT
SNAPL PL X4,SNAPI
SA1 PR+B3 GET REGISTER TO BE CONVERTED
OCTBCD X1
SA2 STBL+B3 GET TABLE
SX5 B0
MX3 6
SHIFTPL SX2 X2-10
NG X2,SHIFTPLA
SA1 BLANKS
BX5 X6
BX6 X7
BX7 X1
EQ SHIFTPL
SHIFTPLA SB2 X2+10
ZR B2,SHIFTD
SHIFTL SX1 1R
BX2 X3*X7
BX7 -X3*X7
LX7 6
IX7 X7+X1
LX2 6
BX1 X3*X6
BX6 -X3*X6
LX6 6
IX6 X6+X2
LX1 6
BX5 -X3*X5
LX5 6
IX5 X5+X1
SB2 B2-B1
NZ B2,SHIFTL
SHIFTD SA1 STBL+B3 GET TABLE
MX2 18
BX5 -X2*X5
BX3 X2*X1
BX5 X5+X3
SB2 16
LT B2,B3,STB
SB2 12
NE B4,B2,OKA
SB4 B0
RJ PRINTL
OKA BX6 X5
SA6 1+LINE+B4
SB4 B4+B1
EQ SNAPI
STB SB2 10
LT B4,B2,OKB
SB4 B0
RJ PRINTL
OKB SA7 1+LINE+2+B4
SA6 1+LINE+1+B4
BX7 X5
SA7 1+LINE+B4
SB4 B4+3
SNAPI SB3 B3+B1
LX4 1
SB2 25
NE B3,B1,CONC
SB3 B3+B1
CONC NE B3,B2,SNAPL
RJ PRINTL PRINT LAST LINE
EQ SNAPB
GETFET DATA 0
SA1 FILENAM+2
ZR X1,CREFET
MX2 42
SA5 FILENAM
SA1 2
GETFETL SX3 X1
ZR X3,CREFET NO OUTPUT FILE FOUND
BX3 X2*X1
BX3 X3-X5
ZR X3,FOUND
GETFETX SA1 A1+1
SX3 A1-62
NG X3,GETFETL
CREFET SX6 IN
SX7 OUT
SA6 INP
SA7 OUTP
SX6 FIRST
SX7 LIMIT
SA6 FIRSTP
SA7 LIMITP
SX6 STATUS
SSTATUS SA6 STATUSP
SA1 WRITE
MX2 42
BX1 X2*X1
BX7 X6+X1
SA7 A1
SA1 A1+1
BX1 X2*X1
BX7 X1+X6
SA7 A1
EQ GETFET
FOUND SA3 X1
BX3 X3*X2
BX3 X3-X5
NZ X3,GETFETX
SX6 X1+1
SX7 X1+2
SA6 FIRSTP
SA7 INP
SX6 X1+3
SX7 X1+4
SA6 OUTP
SA7 LIMITP
SX6 X1
EQ SSTATUS
TITLE PRINT ONE LINE SUBROUTINE
PRINTL BSSZ 1
SA7 TEMP MAY USE X0,X1,X2,X3,B2,B5,B6,B7
SA6 A7+B1
PRINTLA SA1 INP AND NOW X6 AND X7
SA2 OUTP
SA3 FIRSTP
SA1 X1
SA2 X2
SA3 X3
SB5 X1 B5=IN
SB6 X2 B6=OUT
SA1 LIMITP
SA1 X1
SB2 X3 B2=FIRST
SB7 X1 B7=LIMIT
SX0 B0 X0=LINE WORD OUNT
SX1 B5-B6 SPACE IN BUFFER
+ NG X1,*+1 CHECK IF NOT WRAPPED AROUND
SX2 B7-B2
IX1 X1-X2 COMPENSATE FOR NO WRAP AROUND
SX2 X1+15 CHECK IF SAPACE REMAINING IS GT 15
SX7 B0
NG X2,GO
SA1 STATUSP CHECK IF FILE IS NOW BUSY
SA1 X1
LX1 59 IF SO JUST WAIT TIL THERE IS ROOM
PL X1,WAIT
SA1 WRITE GET CIO REQUEST
SA2 FILENAM GET FILE NAME
SX7 16B WRITE OPCODE
BX6 X1
BX7 X7+X2
SA1 STATUSP
SA7 X1 NEW OP CODE IN FET
+ SA1 B1 WAIT FOR RA+1
NZ X1,*
SA6 A1
WAITR SA1 1 WAIT FOR RA+1 TO CLEAR
NZ X1,*
EQ PRINTLA
WAIT SA1 1
NZ X1,*
SA2 RECALL GO INTO PERIODIC RECALL
BX6 X2
SA6 A1
EQ WAITR
GO SA1 LINE+X0 GET WORD TO BE MOVED
BX6 X1
SA7 A1 ZERO OUT LINE
SA6 B5
+ SB5 B5+B1 INCREMENT IN
NE B5,B7,*+1 CHECK IF AT LIMIT OF THE BUFFER
SB5 B2 RESET IN TO FIRST
SX0 X0+B1 INCREMENT WORD COUNT
NZ X1,GO CHECK IF MOVED A ZERO WORD INTO BUFFER
DONE SX6 B5
SA1 BLANKS
SA2 INP
SA6 X2 UPDATEIN
BX7 X1
SA1 TEMP
SA7 LINE REBLANK FIRST WORD OF LINE
SA2 A1+B1
SA3 LINECNT
SX6 X3+B1
SA6 A3
SX7 X3
SA3 FILENAM+1
IX3 X7-X3 CHECK FOR MORE THAN 100 PAGES SNAP OUT
BX7 X1 RESTORE X6 AND X7
LX6 X2
EQ PRINTL
ABORT SA1 1
NZ X1,*
SA2 MSG
BX6 X2
SA6 A1
SA1 .ONE.
+ FX1 X1+X1
EQ * ABORT
MSG VFD 18/3HMSG,2/1,40/*+1
VFD 30/*+1,30/0
DIS ,(MORE THAN 100 PAGES SNAP OUTPUT*ABORT(
LINECNT DATA 0
TITLE SHIFT TABLE
STBL VFD 18/3LP =,42/21
BSSZ 1
VFD 18/3LB1=,42/21
VFD 18/3LB2=,42/21
VFD 18/3LB3=,42/21
VFD 18/3LB4=,42/21
VFD 18/3LB5=,42/21
VFD 18/3LB6=,42/21
VFD 18/3LB7=,42/21
VFD 18/3LA0=,42/21
VFD 18/3LA1=,42/21
VFD 18/3LA2=,42/21
VFD 18/3LA3=,42/21
VFD 18/3LA4=,42/21
VFD 18/3LA5=,42/21
VFD 18/3LA6=,42/21
VFD 18/3LA7=,42/21
VFD 18/3LX0=,42/7
VFD 18/3LX1=,42/7
VFD 18/3LX2=,42/7
VFD 18/3LX3=,42/7
VFD 18/3LX4=,42/7
VFD 18/3LX5=,42/7
VFD 18/3LX6=,42/7
VFD 18/3LX7=,42/7
TITLE CORE DUMP SECTION
SNAPB SA0 B0 SET SWITCH TO FIRST TIME THROUGH
SA1 NUMBLK
SA2 SNAP
SX3 X1
LX3 30
IX6 X2+X3 INCREMENT RETURN
SA6 A2
SB3 X1 B3=NUMBER OF BLOCKS
LX2 30
SB4 X2 B4=ADDRESS OF NEXT REQUEST
SNAPLT ZR B3,SNAPRET
SA4 B4 GET REQUEST
BX5 X4 X4=FIRST OWRD ADDRESS
AX5 30 X5=LAST OWRD ADDRESS
MX0 58
BX4 X0*X4 ROUND DOWN TO MULTIPLE OF 4
RJ PRINTL PRINT BLANK LINE
OCTBCD X4
SA7 FIRSTL
OCTBCD X5
SA1 FIRSTL
MX0 24
SA2 .TO.
SA3 .DMPFR.
BX6 X3
SA6 LINE+1
BX6 -X0*X1
BX6 X6+X2
LX6 18
SA2 .BLNK4.
SA6 A6+B1
BX7 -X0*X7
BX7 X2+X7
LX7 18
SA7 A6+B1
SX6 B0
SA6 A7+B1
RJ PRINTL
RJ PRINTL PRINT BLANK LINE
SA0 B0 SET SWITCH TO FIRST TIME TRU
SNAPLD OCTBCD X4 CONVERT THE ADDRESS OF THE LINE
SA1 .BLNK4.
MX0 24
BX7 -X0*X7
BX7 X7+X1 INSERT LEADING BLANKS
LX7 24 LEFT ADJUST BLANK FILL
SA7 LINE+1 STORE ADDRESS
SX3 A0 CHECK SWITCH
ZR X3,NOCHECK
SA1 X4 CHECK THIS LINE AGAINST THE LAST
SA2 LAST
SB2 4
CHECKL BX2 X2-X1 CHECK IF THIS WORD SAME AS LAST CORR. W
NZ X2,NOCHECK
SB2 B2-B1
SA1 A1+B1
SA2 A2+B1
NZ B2,CHECKL
SA7 LASTADR SAVE ADDRESS OF START OF LINE
SA0 B1+B1 THIS LINE IS THE SAME AS LAST
SX4 X4+4
EQ CHECKE
NOCHECK SX3 X3-2 CHECK IF THIS FINISHES A SEQUENCE OF EQ
NG X3,DUMPIT LOCATIONS
SA7 SAVEREG SAVE ADDRESS OF LINE
NOCHECKB SA1 MESSG YES IT DOES
SA2 A1+B1 MOVE MESSAGE TO BUFFER
BX6 X1
LX7 X2
SA6 LINE+1
SA7 A6+B1
SA1 LASTADR
SA2 MESSG+3
BX6 X1
LX7 X2
SA6 A7+B1
SA7 A6+B1
DUP 4,6 FINISH MESSAGE
SA1 A2+B1
SA2 A1+B1
BX6 X1
LX7 X2
SA6 A7+B1
SA7 A6+B1
RJ PRINTL
SX1 A0-3 CHECK IF CALLED FROM THE EXIT ROUTINE
ZR X1,SNAPX
SA1 SAVEREG
BX6 X1
SA6 LINE+1
DUMPIT SA0 B1
SB7 4 WORD COUNT
SB6 B0 LINE LOCATION
SB5 B0 LAST ADDRESS
DUMPITL SA1 X4 GET WORD TO BE DUMPED
SX4 X4+B1 INCREMENT WORD LOCATION
BX6 X1
SA6 LAST+B5 SAVE IN LAST FOR COMPARISON NEXT LINE
OCTBCD X1
SA6 LINE+2+B6 STORE OUTPUT IN LINE
SA7 A6+B1
SA1 BLANKS
SB6 B6+3
BX6 X1
SB7 B7-B1
ZR B7,DUMPITY
SA6 A7+B1
SB5 B5+B1
EQ DUMPITL
DUMPITY RJ PRINTL PRINT OUT THE LINE OF INFORMATION
CHECKE IX1 X4-X5 CHECK IF AREA HAS BEEN DUMPED YET
NG X1,SNAPLD NOT YET
SX1 A0
SX1 X1-2 CHECK IF DUMPLICATE IN PROCESS
NG X1,SNAPX NO
SA0 3 YES GO BACK PROCESS DUP LINE
EQ NOCHECKB
SNAPX SB3 B3-B1 GET NEXT BLOCK
SB4 B4+B1 INCREMENT REQUEST ADDRESS
EQ SNAPLT LOOP BACK
TITLE REGISTER SAVING ROUTINE
SAVEREG DATA 0
DUP 18,3
PL B1,*+2
+ RJ *
SB1 B1+B1
SB1 A6 SAVE A6
SA6 XR6 STORE X6
SX6 A7 SAVE A7
SA6 AR7 STORE A7
SA7 XR7 STORE X7
SX6 B2
SX7 B3
SB2 1
SA6 BR2
SA7 A6+B2
SX6 B4
SX7 B5
SA6 A7+B2
SA7 A6+B2
SX6 B6
SX7 B7
SA6 A7+B2
SA7 A6+B2
SX6 A0
SX7 A1
SA6 A7+B2
SA7 A6+B2
SX6 A2
SX7 A3
SA6 A7+B2
SA7 A6+B2
SX6 A4
SX7 A5
SA6 A7+B2
SA7 A6+B2
SX6 B1
BX7 X0
SA6 A7+B2
SA7 XR0
BX6 X1
LX7 X2
SA6 A7+B2
SA7 A6+B2
BX6 X3
LX7 X4
SA6 A7+B2
SA7 A6+B2
BX6 X5
SA6 A7+B2
SB4 B2+B2
MX0 6
SX7 B0
SA1 SAVEREG
SB3 18
SA3 .A.
LOOPR SA1 A1+B4
SB3 B3-B2
IX7 X7+X7
BX6 -X0*X1
AX1 56
BX6 X6+X3
IX7 X7+X1
LX1 30
IX6 X6-X1
SA6 A1
NZ B3,LOOPR
LX7 42 SIGN EXTEND
AX7 42
SA7 BR1
SA1 SAVEREG
AX1 30
SA1 X1-2
AX1 30
SX6 X1-1
SA6 PR
EQ SAVEREG
TITLE REGISTER RESTORE ROUTINE
RESTORE DATA 0
SB1 1
MX0 42
SB4 6
LOOP SA1 RB1+B4 GET RESTORE SKELETON
SA2 BR1+B4 GET B REGISTER CONTENTS
BX6 X0*X1
BX2 -X0*X2
BX6 X2+X6
SA6 A1
SB4 B4-B1
PL B4,LOOP
SA1 XR1
UX1 X1,B2
LX1 11
UX1 X1,B3
LX1 11
UX1 X1,B4
LX1 11
UX1 X1,B5
AX1 33
SB6 X1
SA1 AR6
SA2 AR7
SA3 XR6
SA4 XR7
SA1 X1
SA2 X2
SA5 AR0
BX6 X1
LX7 X2
SA0 X5
SA6 A1
SA7 A2
SA5 XR0
BX6 X3
LX7 X4
SA1 XR4
SA4 AR4
BX0 X5
SA2 XR5
SA5 AR5
SA4 X4
SA3 AR3
SA5 X5
BX4 X1
SA3 X3
SA1 XR3
LX5 X2
SA2 AR2
BX3 X1
SA1 XR2
SA2 X2
BX2 X1
SA1 AR1
SA1 X1
SX1 B6
LX1 33
PX1 X1,B5
AX1 11
PX1 X1,B4
AX1 11
PX1 X1,B3
AX1 11
PX1 X1,B2
RB1 NO
NO
SB1 0
NO
NO
SB2 0
NO
NO
SB3 0
NO
NO
SB4 0
NO
NO
SB5 0
NO
NO
SB6 0
NO
NO
SB7 0
EQ RESTORE
TITLE TEMPORARIES
LINE DIS 1,
BSSZ 12
BSSZ 1
FILENAM DATA 6LOUTPUT
VFD 60/56*100
DATA 0
STATUS DATA 1
FIRST VFD 60/BUFF
IN VFD 60/BUFF
OUT VFD 60/BUFF
LIMIT VFD 60/BUFF+SIZE
* MINIMUM BUFFER SIZE IS 80 WORDS.
SIZE EQU 100
STATUSP
FIRSTP
INP
OUTP
LIMITP
BUFF BSSZ SIZE
WRITE VFD 18/3LCIO,2/1,40/STATUS
VFD 18/3LCIO,42/STATUS
RECALL DATA 3LRCL
NUMBLK BSSZ 1
LAST BSSZ 4
LASTADR BSSZ 1
FIRSTL BSSZ 1
MESSG DIS 2,LINES THROUGH
BSSZ 1
DIS 5, ARE IDENTICAL WITH THE PREVIOUS LINE
DIS 5,
TEMP BSSZ 2
TITLE REGISTER AREA
PR
BR0
BR1
BR2
BR3
BR4
BR5
BR6
BR7
AR0
AR1
AR2
AR3
AR4
AR5
AR6
AR7
XR0
XR1
XR2
XR3
XR4
XR5
XR6
XR7
TITLE TRACE SECTION
SNAPONLY IF -DEF,SNAPASSM
* TRACE PROGRAM
* WRITTEN 6/1/68 BY KARL MALBRAIN
* REGISTER USAGE IN THE TRACE SECTION:
* B1 1
* B2 WORK
* B3 PARCEL COUNTER
* B4 WORK
* B5 K OPREG NO.
* B6 J OPREG NO.
* B7 I OPREG NO.
* A0 CURRENT OP CODE
* X0 CURRENT INSTRUCTION WORD
* X1 OPERAND 1
* X2 OPERAND 2
* X3 WORK
* X4 NEXT 15 BITS OF INSTRUCTION
* X5 NEXT INSTRUCTION WORD
* X6 WORK
* X7 RESULT OPERAND
SPREAD MACRO
MX4 1
LX4 8
AX4 X4,B4
ENDM
EVAL MACRO Q
IFC EQ,*Q*K*,2
"ANS"X SET 0
"ANS" SET 0
IFC EQ,*Q*A*,2
"ANS"X SET 1
"ANS" SET AR0
IFC EQ,*Q*B*,2
"ANS"X SET 2
"ANS" SET BR0
IFC EQ,*Q*X*,2
"ANS"X SET 3
"ANS" SET XR0
IFC EQ,*Q*N*,2
"ANS"X SET 0 NO REGISTER
"ANS" SET BR0
ENDM
OPCODE MACRO A,Y,Z
ANS MICRO 1,,*I=*
EVAL A
ANS MICRO 1,,*J=*
EVAL Y
ANS MICRO 1,,*K=*
EVAL Z
M= SET 0
IFEQ K=,0,1
M= SET 1
VFD 1/M=,1/0,2/I=X,2/J=X,2/K=X,22/J=,30/K=
ENDM
SUB MACRO
LOCAL EXIT
SA1 PR
SA3 X1+1 GET SNAP CALL
SA4 CMREFIN
BX6 X3
SA3 CMREFLMT
SA1 CMREF
MX7 1
LX7 31
SA6 X4
IX7 X1+X7
SX6 X4+B1
IX4 X6-X3
SA6 A4
SA7 A1
NZ X4,EXIT
SA1 CMREFFST
BX6 X1
SA6 A4
EXIT BSS 0
ENDM
X MACRO
SA7 X3+B7
EQ TRAP
ENDM
TITLE CMREF STOP HANDLING
CMREF DATA 0
RJ SAVEREG
SUB
RJ RESTORE
EQ CMREF
TITLE TRACER
TRACE DATA 0
RJ SAVEREG
SB1 B2
SB3 60
RJ RNI
TLLOOP RJ GETPARCL GET NEXT PARCEL
SX6 B0
SA6 BR0
SX1 X4
AX1 9
SA0 X1 SAVE OP CODE
SA3 OPCODE+A0 PICK UP INFO ON OPCODE
MX2 57
BX6 -X2*X4 GET K
SB5 X6
AX4 3
BX6 -X2*X4 GET J
SB6 X6
AX4 3
BX6 -X2*X4
SB7 X6 GET I
PL X3,NOK SENSE NO K FIELD
RJ GETPARCL GET K FIELD
SX6 B5
LX6 57
AX6 42
BX1 X6+X4 PUT TOGETHER K FIELD
SB5 X1 REGENERATE K IN B5
EQ CONT
NOK SA1 X3+B5
CONT AX3 30
SA2 X3+B6 GET J OPERAND
SB4 A0
SX3 XR0
SB2 AR0
JP *+1+B4 CALL PROCESSOR
EQ PS
EQ RJ
EQ JP
EQ XRT
SA1 BR0+B7
EQ BREQ
SA1 BR0+B7
EQ BRNE
SA1 BR0+B7
EQ BRGE
SA1 BR0+B7
EQ BRLT
TRAPS BX7 X2 10
SA7 X3+B7
EQ TRAP
BX7 X1*X2
SA7 X3+B7
EQ TRAP
BX7 X1+X2
X
BX7 X1-X2 13
X
BX7 -X1 14
X
BX7 -X1*X2 15
X
BX7 -X1+X2 16
X
BX7 -X1-X2 17
X
SA1 X3+B7 20
EQ LXJK
SA1 X3+B7
EQ AXJK
SB4 X2 22
LX2 X1,B4
EQ TRAPS
SB4 X2
AX2 X1,B4
EQ TRAPS
NX7 X1,B4
SA7 X3+B7
EQ TRAPN
ZX7 X1,B4
SA7 X3+B7
EQ TRAPN
UX7 X1,B4
SA7 X3+B7
EQ TRAPN
SB4 X2
PX2 X1,B4
EQ TRAPS
FX7 X1+X2 30
X
FX7 X2-X1
X
DX7 X1+X2 32
X
DX7 X2-X1 33
X
RX7 X1+X2
X
RX7 X2-X1 35
X
IX7 X1+X2 36
X
IX7 X2-X1 37
X
FX7 X1*X2 40
X
RX7 X1*X2 41
X
DX7 X1*X2
X
EQ MXJK 43
FX7 X2/X1
X
RX7 X2/X1 45
X
EQ TRAP NO OPERATION
CX7 X1
SA7 X3+B7
EQ TRAP
DUP 2,3
IX7 X1+X2 50
SX7 X7
EQ TRAPG
DUP 2,3
SB4 X2
SX7 X1+B4
EQ TRAPG
IX7 X1+X2 54
SX7 X7
EQ TRAPG
IX7 X2-X1 55
SX7 X7
EQ TRAPG
IX7 X1+X2 56
SX7 X7
EQ TRAPG
IX7 X2-X1 57
SX7 X7
EQ TRAPG
DUP 2,3
IX7 X1+X2 60
SX7 X7
EQ TRAPSB
DUP 2,3
SB4 X2 62
SX7 X1+B4
EQ TRAPSB
DUP 2,6
IX7 X1+X2 64
SX7 X7
EQ TRAPSB
IX7 X2-X1 65
SX7 X7
EQ TRAPSB
DUP 2,3
IX7 X1+X2 70
SX2 X7
EQ TRAPS
DUP 2,3
SB4 X2 72
SX2 X1+B4
EQ TRAPS
DUP 2,6
IX7 X1+X2 74
SX2 X7
EQ TRAPS
IX7 X2-X1
SX2 X7
EQ TRAPS
TRAPSB SA7 BR0+B7
EQ TRAP
TRAPG SA7 AR0+B7 STORE A REGISTER
ZR B7,TRAP SENSE A 0 INVOLVED
RJ CKFL
SX1 B7-6
PL X1,TRAPP
SA1 X7
BX7 X1 MAKE MEMORY REFERENCE
SA7 XR0+B7 STORE IN THE X REGISTER
EQ TRAP
TRAPP SA1 XR0+B7
BX6 X1
SA6 X7 STORE X REGISTER IN MEMORY
EQ TRAP
TRAPN SX7 B4
SA7 BR0+B6
EQ TRAP
RJ SX7 B5
RJ CKFL
SA1 PR
SX7 B5+B1
SA7 A1
SX6 X1
MX1 1
LX1 57
LX6 30
BX6 X6+X1
SA6 B5
SX1 SNAP
SX7 B5
IX1 X7-X1
ZR X1,SNAPCALL
SX1 X7-TRACE
ZR X1,TRCECALL
SX1 X7-UNTRACE
ZR X1,UNTRCALL
SX1 X7-CMREF
ZR X1,CMREFC
EQ ABTWORD
JP SA1 BR0+B7
SX7 X1+B5
SA7 PR CHANGE SEQUENCE COUNTER
EQ ABTWORD
XRT SA1 TSTSKEL
SX7 B7
LX7 21
BX7 X7+X1
SA7 XRJ
+ NO
+ NO
XRJ DATA 0
EQ TRAP
TSTSKEL NO
NO
ZR X2,EQ
EQ SX7 B5
SA7 PR
ABTWORD SB3 60
SA1 PR
SX7 X1
RJ CKFL
SA5 X7
EQ TRAP
BREQ IX7 X1-X2
SX7 X7
ZR X7,EQ
EQ TRAP
BRNE IX7 X1-X2
SX7 X7
NZ X7,EQ
EQ TRAP
BRGE SB2 X1
SB4 X2
GE B2,B4,EQ
EQ TRAP
BRLT SB2 X1
SB4 X2
LT B2,B4,EQ
EQ TRAP
LXJK SX2 B6
LX2 3
SB5 B5+X2
LX7 X1,B5
SA7 A1
EQ TRAP
AXJK SX2 B6
LX2 3
SB5 B5+X2
AX7 X1,B5
SA7 A1
EQ TRAP
MXJK SX2 B6
LX2 3
SB5 B5+X2
SB4 B5-B1
SX7 B0
NG B4,MXST
MX7 1
AX7 X7,B4
MXST SA7 X3+B7
EQ TRAP
PS SX1 B3-30
NZ X1,PRCSOPT
SA1 .PRG.
SA2 .STOP.
ABORTT BX6 X1
LX7 X2
SA6 LINE+1
SA7 LINE+2
RJ SAVE
RJ GETFET
RJ PRINTL
MX4 24
RJ SNAPPRCS
RJ RENTER
+ RJ SNAP
- VFD 6/1,24/0
VFD 30/77B,30/0
SX6 3RABT
LX6 42
SA6 1
PS
TRAP SA3 DETAIL
ZR X3,TLLOOP
SA3 A0+OPCODE
MX1 58
LX3 4
SB4 B7
MX6 1
SB7 B0
TRAPX BX2 -X1*X3
SB2 X2
JP *+1+B2
EQ CONTLUP
EQ AFL
EQ BFL
EQ XFL
AFL SPREAD
LX4 36
BX6 X6+X4
LX4 8
BX6 X6+X4
EQ CONTLUP
BFL SPREAD
LX4 52
BX6 X6+X4
EQ CONTLUP
XFL SPREAD
LX4 36
BX6 X6+X4
CONTLUP LX3 2
SB7 B7+B1
JP *+B7
SB4 B6
EQ TRAPX
SB4 B5
EQ TRAPX
BX4 X6
BX6 X0
SA6 CURRENTI
BX7 X5
SX6 B3
SA7 RNICON
SA6 PARCOUNT
SX1 A0
OCTBCD X1
MX1 48
SA2 .BLNK8.
BX7 -X1*X7
BX7 X7+X2
LX7 12
SA7 LINE
RJ SNAPPRCS
SA1 PARCOUNT
SA2 CURRENTI
SA5 RNICON
BX0 X2
SB3 X1
EQ TLLOOP
TITLE TRACE SUBROUTINES
RNI DATA 0
SA1 PR
SX7 X1+1
SA7 A1
RJ CKFL
SA5 X7
EQ RNI
GETPARCL DATA 0
SX1 B3-60
NZ X1,GO1
BX0 X5 GET PREVIOUS WORD
SB3 B0
GO1 SX1 B3-15
NZ X1,GO2
RJ RNI
GO2 LX4 X0,B3
LX4 15
MX1 45
BX4 -X1*X4
SB3 B3+15
EQ GETPARCL
CKFL DATA 0
SA1 FL
NZ X1,CKX
+ SA1 1
NZ X1,*
SA1 REQFL
BX6 X1
SA6 B1
+ SA1 1
NZ X1,*
SA1 FL
CKX AX1 30
SX7 X7
NG X7,ARITHERR
IX1 X7-X1
NG X1,CKFLB SNESE NO ARITH ERROR
ARITHERR SA1 .ARITH.
SA2 .MODE.
EQ ABORTT
CKFLB SA1 CMREFFST
CKFLL ZR X1,CKFL
BX1 X1-X7
SX1 X1
ZR X1,CMSTOP
SA1 A1+1
EQ CKFLL
CMSTOP SA7 TEMPT
SA2 .MEMRY.
SA3 .REF.
BX6 X2
LX7 X3
SA3 .SNAP.
SA6 LINE+1
SA7 LINE+2
BX6 X3
SA6 A7+B1
SA4 A1
LX4 6
RJ SAVE
RJ GETFET
RJ PRINTL
RJ PRINTL PRINT BLANK LINES
RJ SNAPPRCS
RJ RENTER
SA3 TEMPT
SX7 X3
EQ CKFL
SAVE BSSZ 1
BX6 X0
SA6 CURRENTI
BX7 X5
SA7 RNICON
SX6 B3
SA6 PARCOUNT
SX7 B5
SX6 B6
SA7 OP1
SA6 OP2
SX7 B7
SX6 A0
SA7 OP3
SA6 OPCDE
BX7 X1
BX6 X2
SA7 OPR1
SA6 OPR2
EQ SAVE
SNAPPRCS DATA 0
MX1 24
BX4 X1*X4
SX7 B0
SA7 NUMBLK
RJ GETFET
SA1 RTNI
BX6 X1
SA6 SNAPQ
SB3 B0
SB4 B0
NZ X4,SNAPL
RTNADR EQ SNAPPRCS
RENTER DATA 0
SA1 OPCDE
SA2 OP1
SA3 OP2
SA4 OP3
SA5 RNICON
SA0 X1
SB5 X2
SB6 X3
SB7 X4
SA1 PARCOUNT
SA3 CURRENTI
SA4 NXTPAR
SB3 X1
BX0 X3
SA1 OPR1
SA2 OPR2
EQ RENTER
RTNI EQ RTNADR
REGI RJ RESTORE
SNAPCALL RJ SAVE
RJ GETFET
SA1 RTNIB
BX6 X1
SA6 SNAPQ
EQ SNAPY
RTNIB EQ *+1
SA1 REGI
BX6 X1
SA6 SNAPQ
RJ RENTER
TRCECALL BSS 0
TRACALL SB3 60
EQ TRAP
UNTRCALL RJ RESTORE RESTORE REGISTERS
EQ UNTRACE RETURN TO CALLING PROGRAM
CMREFC SB2 B1
SUB
EQ TRACALL
PRCSOPT SX7 B5
SA7 DETAIL
EQ TRACALL
UNTRACE DATA 0
EQ *-1
TITLE OPCODE TABLE
* TABLE OF OPCODE FORMS
OPCODE BSS 0
OPCODE N,N,K PS
OPCODE N,N,K RJ
OPCODE B,N,K JP
OPCODE N,X,K X REG TEST
DUP 4,1
OPCODE B,B,K BREG TEST
OPCODE X,X,N TWO REG BOOL
DUP 3,1
OPCODE X,X,X THREE REG BOOL
OPCODE X,N,X
DUP 3,1
OPCODE X,X,X
OPCODE X,N,N LXJK
OPCODE X,N,N AXJK
DUP 6,1
OPCODE X,B,X AX X,B
DUP 8,1
OPCODE X,X,X ADD UNITS
DUP 3,1
OPCODE X,X,X MULT UNIT
OPCODE X,N,N MXJK
DUP 2,1
OPCODE X,X,X DIVIDE UNIT
OPCODE N,N,N NOP
OPCODE X,N,X CX
OPCODE A,A,K
OPCODE A,B,K
OPCODE A,X,K
OPCODE A,X,B
DUP 2,1
OPCODE A,A,B
DUP 2,1
OPCODE A,B,B
OPCODE B,A,K
OPCODE B,B,K
OPCODE B,X,K
OPCODE B,X,B
DUP 2,1
OPCODE B,A,B
DUP 2,1
OPCODE B,B,B
OPCODE X,A,K
OPCODE X,B,K
OPCODE X,X,K
OPCODE X,X,B
DUP 2,1
OPCODE X,A,B
DUP 2,1
OPCODE X,B,B
TITLE TEMPORARIES
CMREFFST VFD 60/BFR
CMREFIN VFD 60/BFR
CMREFLMT VFD 60/BFR+200B
BFR BSSZ 200B
FL DATA 0
REQFL VFD 18/3RMEM,2/1,40/FL
DETAIL BSSZ 1
TEMPT BSSZ 1
CURRENTI BSSZ 1
RNICON BSSZ 1
PARCOUNT BSSZ 1
OP1 BSSZ 1
OP2 BSSZ 1
OP3 BSSZ 1
OPCDE BSSZ 1
OPR1 BSSZ 1
OPR2 BSSZ 1
NXTPAR BSSZ 1
SNAPONLY ENDIF
*
*
LIST L,R
.ONE. DATA 1.0
.TO. DATA 4L TO
.DMPFR. DATA 10HDUMP FROM
.BLNK4. DATA 4L
.A. DATA 1LA
.PRG. DATA 10HPROGRAM
.STOP. DATA 10HSTOP
.BLNK8. DATA 8L
.ARITH. DATA 10HARITH ERRO
.MODE. DATA 10HR MODE 1.
.MEMRY. DATA 10HMEMORY
.REF. DATA 10HREFERENCE
.SNAP. DATA 10HSNAPSHOT
TRCQ BSS 0
TRACE ENDIF
TITLE RUN - TIME COMPILATION
QCMPL SX5 X5-1 . STANDARD PROCEDURE COMPILE
NZ X5,ERR20
SA0 2 . MAKE SURE THERE IS ENOUGH CORE
RJ RESERVE
SB6 B6-2
SA1 B6
AX1 55 . ERROR IF PARAMETER
NZ X1,ERR29 . IS NOT A STRING
RJ GRBCOLL . GARBAGE COLLECT
SB1 1
SX7 CTY
SA1 B6-B1 . SVD OF STRING PARAMETER
LX7 55
SX6 A5 . SAVE MICROINSTR COUNTER
SX2 B1+B1
BX7 X7+X2 . PREPARE CODE TYPE
SA7 B6 . ENTRY IN THE STACK
SA6 B6-B1
SX7 X1
SA7 FRSTWRD
SA7 NXTWRD
SA2 STAKTOP
SA3 MAXSTAK
SA4 MINSTAK
IX6 X2-X4 . PUSH STACK TO HIGH CORE
SA6 A2 . AS FAR AS IT GOES
SB3 B0-B6 . TO MAKE ROOM FOR THE
SB3 X3+B3 . COMPILATION
SB2 X4
QCMPL1 SA1 B2
BX7 X1
SA7 A1+B3
SB2 B2+B1
GE B6,B2,QCMPL1
SX6 X4+B3 . INITIALIZE PRGBASE
BX7 X7-X7
SA6 PRGBASE
SA7 X6-1
SB6 A7
SX6 B7 . SAVE B7
SA7 ARROWD . CLEAR ERROR FLAG
SA6 COMPB7
SX6 B1
SB6 B0-B6 . INITIALIZE B6 OF COMPILER
SA7 VARLINK . ZERO TO VARLINK
SA6 LBLLINK . END OF LIST TO LBLLINK
SX7 PRIORJ
LX7 36
SA5 BGP3STK . PASS3 STACK POINTER
SA0 BGP2STK . PASS 2 TACK POINTER
SA7 A5
SB7 B0 . NO OPERAND TO OPSIT
SB1 ST1 . INITIAL STATE
EQ PRE4 . START COMPILATION
*
CMPLQ BSS 0
TITLE MACROS FOR STANDARD PROCEDURE AND VARIABLE DESCRIPTORS
COUNT MACRO STRING . SET COUNT := NO. OF CHARS IN STRING
COUNT SET 0
DUP 9999
COUNT SET COUNT+1
MIC MICRO COUNT+1,1,$STRING$
IFC EQ,$"MIC"$$,1
STOPDUP
ENDD
ENDM
WDCNT MACRO LENGTH . SET WDCNT = LENGTH // 7
WDCNT SET LENGTH/7
IFNE LENGTH-WDCNT*7,0,1
WDCNT SET WDCNT+1
ENDM
BCD MACRO STRING . PUT STRING INTO LINKED FORMAT
ST MICRO 1,,$STRING$
DUP 9999
TEMPMIC MICRO 1,7,$"ST"$
ST MICRO 8,,$"ST"$
LOC SET *+1
IFC EQ,$"ST"$$,2
LOC SET 0
STOPDUP
VFD 42/0L"TEMPMIC",18/LOC
ENDD
ENDM
PATTERN MACRO NAME . STANDARD PATTERN VALUE DESCRIPTION
COUNT NAME . COUNT := NO. OF CHARS
WDCNT COUNT . WDCNT := NO. OF WORDS
VFD 5/VARTYP,19/COUNT,18/WDCNT+2,18/0
VFD 1/1,59/NAME_PM
BCD NAME
FREELEN$ SET FREELEN$+1 . RESERVE FSL SPACE
ENDM
PROC MACRO NAME,ENDQ,ENTRY,LAST . STANDARD PROCEDURE DESCRIPTION
COUNT NAME . COUNT := NO. OF CHARS IN NAME
WDCNT COUNT . WDCNT := NO. OF WORDS IN NAME
VFD 5/CALLTYP,19/COUNT,18/WDCNT+2,18/0
IFC NE,$ENTRY$$,2
QNAME MICRO 1,,$ENTRY$
IFNE ,,1
QNAME MICRO 1,,$Q_NAME$
IFC EQ,$LAST$$,2
VFD 1/1,1/1,22/ENDQ,18/*-STTBASE+WDCNT+2,18/"QNAME"
IFNE ,,1
VFD 1/1,1/0,22/ENDQ,18/*-STTBASE+WDCNT+2,18/"QNAME"
BCD NAME
ENDM
TITLE INITIALIZATION
DATA 0
STTBASE EQU *-1
DATA 0
PIXREL EQU 0
SIXREL EQU 1
STNDREL EQU 2
XWDREL EQU 0
*
FREELEN$ SET 5 . SPACE FOR START OF FSL, STACK, AND
. CODE AREA
*
VFD 5/VARTYP,19/5,18/3,18/0 INPUT
VFD 5/INTY,19/80,18/INFET-1,18/0 STANDARD ASSOCIATION
DATA 5LINPUT
FREELEN$ SET FREELEN$+1 . NULL FOR INPUT
VFD 5/VARTYP,19/6,18/3,18/0 OUTPUT
VFD 5/OUTTY,19/1R ,18/OUTFET-1,18/0 STANDARD ASSOCIATION
DATA 6LOUTPUT
FREELEN$ SET FREELEN$+1 . NULL FOR OUTPUT
VFD 5/LBLTYP,19/6,18/3,18/0
VFD 1/1,41/0,18/-MARK+2
DATA 6LRETURN
VFD 5/LBLTYP,19/7,18/3,18/0
VFD 1/1,41/0,18/-MARK+1
DATA 7LFRETURN
VFD 5/LBLTYP,19/7,18/3,18/0
VFD 1/1,41/0,18/-MARK
DATA 7LNRETURN
PATTERN ABORT
PATTERN ARB
PATTERN BAL
PATTERN FAIL
PATTERN FENCE
PATTERN REM
STNPRL EQU *-STTBASE
PROC COMPILE,CMPLQ,QCMPL
IFNE TRCFLG,0,1
PROC TRC,TRCQ
PROC FREEZE,FREEZEQ
PROC ALPHABET,ALPHAQ,QALPHA
PROC STLIMIT,MAXLNQ
PROC STCOUNT,MAXLNQ
PROC MAXLNGTH,MAXLNQ,QMAXLN
PROC DATA,DATAQ
PROC LGT,LGTQ
PROC FNCLEVEL,FLVQ,QFLV
PROC DATATYPE,DTQ,QDT
PROC EORLEVEL,EORLQ,QEORL
PROC ENDGROUP,EFRWQ,QENDFILE
PROC CLOSE,EFRWQ
PROC UNLOAD,EFRWQ
PROC REWIND,EFRWQ
PROC DETACH,IOQ
PROC INPUT,IOQ
PROC OUTPUT,IOQ
PROC EOI,EOIQ
PROC CLOCK,TDCQ
PROC DATE,TDCQ
PROC TIME,TDCQ
IFNE TSS,0,1
PROC IN,INQ
IFNE TSS,0,2
PROC OUT,REMARKQ,QREMARK
IFNE ,,1
PROC REMARK,REMARKQ
PROC ARRAY,ARRAYQ
PROC CONVERT,CNVTQ,QCNVT
PROC UNSTAR,UNSTARQ,QUNSTAR
PROC STAR,STARQ,QSTAR
PROC IDENT,COMPQ
PROC DIFFER,COMPQ
PROC DEFINE,DEFINEQ
PROC ARBNO,ARBNOQ
PROC ANCHOR,ANCHORQ
PROC TRIM,TRIMQ
PROC ANY,ANYQ
PROC NOTANY,ANYQ
PROC EQ,EQQ
PROC NE,EQQ
PROC GT,EQQ
PROC GE,EQQ
PROC LT,EQQ
PROC LE,EQQ
PROC BREAK,ANYQ
PROC SPAN,ANYQ
PROC RTAB,PATQ
PROC TAB,PATQ
PROC RPOS,PATQ
PROC POS,PATQ
PROC LEN,PATQ
PROC SIZE,SIZEQ
PROC IF,IFQ,,LAST
BUFFBASE EQU *
EJECT
SNOBOL SB7 B0 TERMINATOR FLAG FOR CONTROL CARD SCAN
BX6 X6-X6
SA6 100B
SX6 A0
SA6 FIELDLN
SA1 70B START OF IMAGE
MX0 6 ONE CHAR MASK
RJ GN IGNORE PROGRAM NAME
CC1 RJ GN GET PARAM IN X6
BX3 X6
BX6 X6-X6
SX4 X2-1R= SEE IF SEPERATOR IS =
NZ X4,CC2 NO
RJ GN
CC2 BX2 X0*X3 FIRST CHAR
LX2 6
SX4 X2-1RI
ZR X4,CC3 INPUT FILE
SX4 X2-1RL
ZR X4,CC4 OUTPUT FILE/LIST FLAG
SX4 X2-1R*
ZR X4,CC7 SPECIAL PARAM
SX4 X2-1RQ
ZR X4,CC12
SX4 X2-1RT
NZ X4,CC1 UNKNOWN OPTION, IGNORE
SA2 P2TRCS TURN ON TRACE
SA3 P3TRCS
BX6 X2
BX7 X3
SA6 P2TRCT
SA7 P3TRCT
SA2 P4TRCS
BX6 X2
SA6 P4TRCT
EQ CC1
CC3 SB3 INFET
EQ CC5
CC4 BX4 X0*X6
LX4 6
SX4 X4-1R0
ZR X4,CC6 L=0, TURN OFF LIST
SB3 OUTFET
CC5 ZR X6,CC1 NULL FILENAME IMPLIES DEFAULT
RJ VALID X6 RETURNED 0 IF INVALID FILENAME
ZR X6,CCERROR
SA6 B3 STORE INTO CORRECT FET
EQ CC1
CC6 SX6 0
SA6 P1ERFLG
EQ CC1
CC7 LX3 6
BX2 X0*X3
LX2 6
BX7 X7-X7 BINARY FORM OF PARAM
CC8 BX5 X0*X6
ZR X5,CC9 FINISHED CONVERTING
LX5 6
BX6 -X0*X6
LX6 6
LX7 3 OLD TOTAL * 8
SX5 X5-1R0
NG X5,CCERROR ALPHABETIC CHAR
SX4 X5-1R8+1R0
PL X4,CCERROR SPECIAL CHAR
IX7 X5+X7
EQ CC8
CC9 SX4 X2-1RB
NZ X4,CC11 . NOT BUFFER SIZE
SX6 X7-65 BUFFER SIZE .LT. 65 IGNORED
NG X6,CC1
SA7 BUFFSIZE
EQ CC1
CC11 SX4 X2-1RF
NZ X4,CC1
SA7 FLDLM
EQ CC1
IFEQ TRCFLG,0,2
CC12 EQU CC1
TRC IFNE ,,
CC12 RJ TRACE
NO
VFD 30/1
+ EQ CC1
TRC ENDIF
FILEWD VFD 6/1,6/0,6/0,1/1,41/0
GN DATA 0
NZ B7,PRE1
SX6 0
SB2 60 60-CHAR.COUNT*6
GN1 BX2 X0*X1 NEXT CHAR
NZ X2,GN2
SA1 A1+1
BX2 X0*X1
GN2 BX1 -X0*X1
LX1 6
LX2 6
SB1 X2-1R+
GE B1,B0,GN4
GN3 LX6 6
BX6 X2+X6
SB2 B2-6
EQ GN1
GN4 SB1 X2-1R IS THERE AN IMBEDDED BLANK
ZR B1,GN1 ZOUNDS, THERE IS.....
SB1 X2-1R* HOW ABOUT AN ASTERISK(*B,*F,...)
ZR B1,GN3 * IS LEGAL PARAM CHAR
LX6 B2,X6 LEFT JUSTIFY
SB1 X2-1R.
ZR B1,GN5
SB1 X2-1R)
ZR B1,GN5
EQ GN
GN5 SB7 1
EQ GN
CCERROR SA1 1
NZ X1,*
SA2 ECALL
BX6 X2
SA6 A1
+ SA1 1
NZ X1,* . WAIT FOR RA+1 TO LCEAR
JP .ABT. . JSUT ISSUE ABT REQUEST
ECALL VFD 18/3LMSG,42/CCERRM
CCERRM DATA 10HSNOBOL CON
DATA 10HTROL CARD
DATA 6LERROR.
PRE1 SB1 PRE2
JP CALENDR . GET DATE IN X6
PRE2 SA6 DATE . SET UP COMPILER TITLE
SB1 PRE2.1
JP TOD
PRE2.1 SA6 TIME . TIME-OF-DAY FOR COMPILER TITLE
SA1 BUFFSIZE LENGTH OF ONE BUFFER
IX2 X1+X1
SB7 1 . CONSTANT 1
SX5 B7 LOAD X5 WITH A 1
SX2 X2+B7 BUFFER LENGTH * 2 + 1
SX6 SPCTYP
LX6 37
BX6 X2+X6
LX6 18
SA6 BUFFBASE BYPASS WORD
SX6 BUFFBASE+1 STARTING ADDERSS FOR BUFFERS
LX5 18
BX7 X5+X6
SA7 INFET+1
SA6 A7+B7
SA6 A6+B7 OUT
IX6 X1+X6 FIRST+LENGTH=LIMIT
SA6 A6+B7
BX7 X5+X6
SA7 OUTFET+1
SA6 A7+B7 IN
SA6 A6+B7 OUT
IX6 X1+X6
SA6 A6+B7 LIMIT
SX6 X6+FREELEN$-1 . FL NEEDED
SB1 X6
SB1 A0-B1
GE B1,B0,PRE2.5
SA1 FLDLM
IX1 X1-X6
NG X1,CCERROR . MAX FIELD LENGTH HAS BEEN EXCEEDED
SA6 FIELDLN
LX6 30
IFNE TRCFLG,0,1
SA6 FL
SA6 FLDSTAT
SA2 FLDCALL . REQUEST LARGER FIELD LENGTH
BX7 X2
SA7 B7 . RA+1
+ SA1 1
NZ X1,*
PRE2.5 SB2 INFET
RJ OPEN
SB2 OUTFET
RJ OPEN
EJECT
PRE3 SA2 FIELDLN
SB1 -1
SB7 X2
SA4 MINSTAT
SB4 X4+STNDREL
INIT1 SA1 B4 . LOOP TO FIND HASH CODES FOR
BX0 X1 . STANDARD VARIABLES AND PROCEDURES
AX1 18
SX5 A1
SB4 X1+B4
AX1 18
SB5 A1+2 . FWA OF THE NAME
SB3 X1
EQ B3,B0,INIT4
RJ SEARCH
BX7 X5+X2
SA7 A2
AX0 55
SX0 X0+1 . BRANCH IF FUNCTION OR LABEL
NZ X0,INIT1
SA1 X5+1
NG X1,INIT3 . BRANCH IF ARB, BAL, REM ETC.
BX7 X7-X7
SB7 B7+B1
SA7 B7
SX0 SSTY
SX6 B7
LX0 55 . INPUT OR OUTPUT INITIALIZED TO
LX6 18 . A NULL STRING VALUE
SX7 B7
BX7 X7+X6
SB7 B7+B1
BX7 X7+X0
SX6 B7
SA7 B7
BX6 X6+X1
INIT2 SA6 A1
EQ INIT1
INIT3 SB7 B7-1
MX0 12
LX1 48
BX7 X0*X1
SA7 B7
SX6 B7
SX7 B7
LX6 18
SX0 PSTY
LX0 55
BX6 X7+X6
BX6 X0+X6
EQ INIT2
INIT4 SX7 B4
SA7 MAXSTAT
SX7 B7+B1
BX6 X6-X6
SA7 COMPB7
SA6 X7 . END OF THE FREE WORD CHAIN
SX7 X7+B1
SA7 MAXSTAK
SA6 X7 . FIRST WORD IN THE STACK
SA7 PRGBASE . BASE FOR THE OBJECT PROGRAM
SX7 X7+B1
SA6 X7 . FIRST WORD OF THE OBJECT PROGRAM
*
SB6 X7
SX7 PRIORJ
LX7 36
SB6 B0-B6
SA5 BGP3STK
SA0 BGP2STK
SA7 A5
SB7 B0 . INITIALIZE PASS 2 OPSIT
SB1 ST1
SX7 1
SA7 LBLLINK
SA1 P1ERFLG
ZR X1,PRE4
EQ PRE5
USE *
RTERROR SB3 A5
NG B5,ERROR40 . COMPILATION ERROR
SA1 CODELINK
SB4 1
ERROR01 SA2 X1 . PICK UP CODE HEADER
SX1 X2+0 . LINK TO NEXT
AX2 18
SB2 X2-1 . WORDCOUNT = BYPASS - 1
SB1 A2+B2 . ADDRESS OF FIRST MICRO INSTRUCTION
ERROR02 EQ B1,B3,ERROR10
SA3 B1+0
PL X3,ERROR03 . NOT END OF RULE
SB4 B4+1
ERROR03 SB2 B2-1
SB1 B1-1
GT B2,B0,ERROR02
NZ X1,ERROR01
ERROR10 SB2 0
SA1 STAKTOP
ERROR11 SA2 X1 . NEXT STACK HEADER
SB1 X2 . BYPASS
ZR X2,ERROR20 . BOTTOM OF STACK
PL X2,ERROR12
SB2 B2+1
ERROR12 SB1 -B1
SX1 X1+B1
EQ ERROR11
ERROR20 SX1 B4 . RULE NUMBER
MX5 6
RJ ICX1X6
SX7 1R
LX7 36
LX5 42
ERROR205 BX1 X5*X6
NZ X1,ERROR206
BX6 X6+X7
LX5 6
LX7 6
EQ ERROR205
ERROR206 MX0 42
LX6 18
SA1 TERMESS+2
BX7 -X0*X6
BX7 X1+X7
SA7 A1
MX0 6
BX7 X0*X6
SA1 A1+1
BX7 X1+X7
SA7 A1
SX1 B2 . RECURSION LEVEL
RJ ICX1X6
SX7 1R
BX6 X6+X7
LX6 54
SA6 TERMESS+4
SB2 OUTFET
SB1 TERMESS-MESSTER . WORD COUNT
ERROR21 SA1 MESSTER+B1
SB1 B1+1
BX6 X1
RJ PB
NG B1,ERROR21
SA1 TERMESS
SX0 61B
LX0 54
BX6 X0-X1
SA6 A1
SA2 MCALL
BX7 X2
SA7 1
+ SA2 A7
NZ X2,*
ERROR30 SA1 ERRORD+B5 . DIRECTORY ENTRY
SB1 X1 . FWA ERROR MESSAGE
MX5 48
ERROR31 SA2 B1
BX6 X2
RJ PB
BX6 -X5*X6
SB1 B1+1
NZ X6,ERROR31
JP ABT . FLUSH BUFFERS AND ABORT
ERROR40 SB5 -B5
SB2 OUTFET
EQ ERROR30
MCALL VFD 18/3LMSG,42/TERMESS
TERMESS DATA 10H1ERROR TER
DATA 10HMINATION I
DATA 7LN RULE
DATA 9R AT LEVEL
DATA 0
MESSTER BSS 0
MACRO *,LABEL,TEXT
LABEL DIS ,$ TEXT$
ENDM
ERRORD BSS 0
VFD 60/E0
VFD 60/E1
VFD 60/E2
VFD 60/E3
VFD 60/E4
VFD 60/E5
VFD 60/E6
VFD 60/E7
VFD 60/E8
VFD 60/E9
VFD 60/E10
VFD 60/E11
VFD 60/E12
VFD 60/E13
VFD 60/E14
VFD 60/E15
VFD 60/E16
VFD 60/E17
VFD 60/E18
VFD 60/E19
VFD 60/E20
VFD 60/E21
VFD 60/E22
VFD 60/E23
VFD 60/E24
VFD 60/E25
VFD 60/E26
VFD 60/E27
VFD 60/E28
VFD 60/E29
VFD 60/E30
VFD 60/E31
VFD 60/E32
VFD 60/E33
VFD 60/E34
VFD 60/E35
VFD 60/E36
VFD 60/E37
VFD 60/E38
VFD 60/E39
VFD 60/E40
VFD 60/E41
VFD 60/E42
VFD 60/E43
VFD 60/E44
VFD 60/E45
VFD 60/E46
VFD 60/E47
VFD 60/E48
VFD 60/E49
VFD 60/E50
VFD 60/E51
VFD 60/E52
VFD 60/E53
VFD 60/E54
VFD 60/E55
VFD 60/E56
E0 DIS ,$ LEXICOGRAPHICAL END OF PROGRAM ENCOUNTERED DURING
,EXECUTION.$
E1 DIS ,$ ILLEGAL OPERAND TYPE IN AN ARITHMETIC OPERATION (+
,, -, *, /, **).$
E2 DIS ,$ STRING USED IN ARITHMETIC OPERATION DOES NOT CONFO
,RM TO NUMBER SYNTAX.$
E3 DIS ,$ DIVISION BY ZERO WAS ATTEMPTED.$
E4 DIS ,$ VARIABLE TO THE LEFT OF A [ DOES NOT CONTAIN AN AR
,RAY VALUE.$
E6 DIS ,$ THERE WERE TOO MANY SUBSCRIPTS IN AN ARRAY REFEREN
,CE.$
E7 DIS ,$ TOO FEW SUBSCRIPTS APPEARED IN AN ARRAY REFERENCE.
,$
E5 DIS ,$ THE VALUE OF AN ARRAY INDEX MUST BE OF INTEGER TYP
,E.$
E9 DIS ,$ A FAILURE OCCURRED IN THE EVALUATION OF THE GO-TO
,PART.$
E10 DIS ,$ AN ATTEMPT WAS MADE TO JUMP TO AN UNDEFINED LABEL.
,$
E11 DIS ,$ ILLEGAL COMBINATION OF OPERAND TYPES FOR CONCATENA
,TION.$
E12 DIS ,$ FORBIDDEN OPERAND TYPE FOR ALTERNATION.$
E13 DIS ,$ THE DATA TYPE USED MAY ONLY BE CONCATENATED WITH T
,HE NULL STRING.$
E14 DIS ,$ THE CONSTRUCTION IMPLIED A CALL OF A FUNCTION WHIC
,H HAS NOT BEEN DEFINED.$
E15 DIS ,$ THE LEFT OPERAND FOR A PATTERN MATCH MUST BE A STR
,ING.$
E16 DIS ,$ THE RIGHT OPERAND FOR A PATTERN MATCH MUST BE A PA
,TTERN.$
E17 DIS ,$ THE MAXIMUM FIELD LENGTH HAS BEEN EXCEEDED.$
E18 DIS ,$ THE MAXIMUM STRING LENGTH HAS BEEN EXCEEDED.$
E19 DIS ,$ THE STATEMENT LIMIT HAS BEEN EXCEEDED.$
E20 DIS ,$ TOO MANY ACTUAL PARAMETERS WERE GIVEN IN A STANDAR
,D PROCEDURE CALL.$
E8 DIS ,$ TOO MANY ACTUAL PARAMETERS WERE GIVEN IN A FUNCTIO
,N CALL.$
E21 DIS ,$ THE PARAMETER FOR A FIELD FUNCTION WAS NOT A DATA
,REFERENCE.$
E22 DIS ,$ NO SUCH FIELD IN THE REFERENCED DATA STRUCTURE.$
E23 DIS ,$ A RETURN WAS ATTEMPTED FROM THIS LOW LEVEL.$
E25 DIS ,$ AN -NRETURN- WAS EXPECTED FROM THE PROCEDURE CALLE
,D.$
E26 DIS ,$ A PROCEDURE RETURNING BY -NRETURN- MUST SUPPLY A N
,AME AS ITS VALUE.$
E27 DIS ,$ INDIRECT REFERENCE TO THE NULL STRING.$
E28 DIS ,$ TYPE ERROR, DATA FUNCTION CANNOT SUPPLY A NAME.$
E29 DIS ,$ PARAMETER TYPE ERROR IN STANDARD PROCEDURE CALL.$
E30 DIS ,$ SYNTAX ERROR IN DATA DEFINITION.$
E31 DIS ,$ DUPLICATE NAMES IN DATA DEFINITION.$
E32 * (STRING ARITHMETIC NOT YET IMPLEMENTED.)
E35 * (A STANDARD I/O PROCEDURE REFERENCED A NONEXISTENT FILE.)
, FILE.$
E36 DIS ,$ AN ATTEMPT WAS MADE TO DETACH A VARIABLE WHICH WAS
, NOT ASSOCIATED WITH ANY FILE.$
E37 * (REAL ARITHMETIC OVERFLOW.)
E38 * (TYPE MISMATCH IN ARITHMETIC OPERATION.)
E39 DIS ,$ ILLEGAL CHARACTER APPEARED IN ARRAY PROTOTYPE.$
E40 DIS ,$ AN ILLEGAL FILENAME WAS SPECIFIED TO AN I/O ASSOCI
,ATION PROCEDURE.$
E41 DIS ,$ AN ATTEMPT WAS MADE TO I/O ASSOCIATE A VARIABLE WH
,ICH WAS ALREADY ATTACHED.$
E43 DIS ,$ SYNTAX ERROR IN ARRAY PROTOTYPE.$
E48 DIS ,$ AN ARRAY LOWER BOUND MUST BE LESS THAN THE CORRESP
,ONDING UPPER BOUND.$
E49 DIS ,$ A BOUND IN AN ARRAY PROTOTYPE WAS TOO LARGE.$
E50 DIS ,$ A DIMENSION IN AN ARRAY PROTOTYPE WAS TOO LARGE.$
E24 * (OPERAND FOR UNARY * IS NOT STRING OR PATTERN.)
E33 * (TYPE ERROR, INDIRECT IMPOSSIBLE.)
E34 * (TYPE ERROR IN GO TO PART.)
E42 * (ERRONEOUS PARAMETER FOR PATTERN FUNCTION (LEN, POS, RPOS, TAB, RT
,AB).)
E44 * (SYNTAX ERROR IN PROCEDURE HEADING.)
E45 * (TYPE ERROR IN THE PATTERN REFERENCE.)
E46 * (ONLY A STRING MAY BE ASSIGNED HERE.)
E47 * (TYPE ERROR IN ARITHMETIC CONTEXT.)
E51 * (SYNTAX ERROR IN STRING TO BE COMPILED.)
E52 * (ONLY STRINGS MAY BE OUTPUT.)
E53 * (INCORRECT SYNTAX FOR STRING TO BE CONVERTED TO REAL.)
E54 * (CONGRATULATIONS, YOU HAVE DISCOVERED THE ONLY LIMITATION IN SNOBO
,L, PLEASE SIMPLIFY THE ABOVE CONSTRUCTION.)
E55 * (AN ATTEMPT WAS MADE TO READ PAST AN END-OF-INFORMATION.)
E56 * (A STRING TO BE DISPLAYED WAS TOO LONG.)
END SNOBOL