File: LIBN.PA of Tape: Sources/Focal/s6
(Source file text)
/&0
/DEFINITIONS OF FOC AND FLT IF NEEDED
IFNZRO FFNASS <
GOSWIT=7157
P=10
L=0
T=20
V=10
PROC=610
XINTEG=7166
ICHARF=6172
PRINTC=4552
EVAL=1607
HORD=45
FLTONE=2402
FLAC=44
MMINSK=1162
FLARG=7514
MGETC=1411
BUFR=60
PGETLN=2371
ENDERR=0
TERMER=1156
NMBSGN=3251
EXCLA=3257
QUOTS=3265
INPUTX=232
>
IFNZRO LIBLST <XLIST>
IFZERO LTNASS <
EJECT OS-8 FOCAL IN-OUT AND UTILITY
/&1
FIELD 0
*1 /INTERRUPT SERVICE ROUTINE
JMP I .+1
INTSTO
DRONE=JMS I .
XIDLE
0
0 /FOR OD
0
*7
TSORTJ=JMS I .
MSORTJ
AUTO1, 0 /AUTO-INDEX REGISTERS...ACTUALLY USE SOME
AUTO2, 0
AUTO3, 0
AUTO4, 0
AUTO5, 0 /COMPARE
AUTO6, 0 /COMPARE
AUTO7, 0
AUTO8, 0
XCNTR, 0 /GENERAL COUNTER-
USR, 7700 /POINTER TO MONITOR (200 IF IN CORE)
INFLG, 0
INECH, 0
OUTFLG, 0 /IN-OUT FLAGS
OUTECH, 0
ERRCOD, 0
NAMLOC, ZBLOCK 3 /USED BY NAME
EXTENS, 0 /"FC", "FD", OR "FN"
DEVHLD, 0 /OOPEN:DEV. NO. FOR CLOSE
NEWDEV, ZBLOCK 2 /USED BY NAME
TEM7, 0
ATEM, 0 /KEEP HERE : TPOPF NEWDEV
/DEFINE LOWER FIELD INSTRUCTIONS . . .
TGETC=JMS I .
XGETC
TPOPA=JMS I .
MPOPA
TPUSHA=JMS I .
MPUSHA
TPUSHF=JMS I .
MPUSHF
TPOPF=JMS I .
MPOPF
TPUSHJ=JMS I .
MPUSHJ
TPOPJ=JMP I .
MPOPJ
/&2
COMFLG, 0 /1:WRITE;0:READ
ECHFLG, 0 /-1:NO ECHO
OPNFLG, 0 /OOPEN:-1;OCLOSE:0
IPNFLG, 0 /IOPEN:-1;EOF:0
FLNGTH, 0 /SET BY OPEN
STBLK, 0 /SET BY OPEN
DEVNO, 0 /SET BY HANDAD
LIBBLK, 0 /FOR DEVICE NAME
0
7200 /LOAD POINT
0 /FOR DEVICE #
LIBHND, 0 /HANDLER ENTRY
TESTRM=JMS I .
MSORTC
TINTEG=JMS I .
MINTEG
ERROR1=JMS I .
ERROL
CHAR, 0 /FOR OBSCURE FAKING REASONS
INBLK, 0
0
6600
0
INHND, 0
OUTBLK, 0
0
6200
0
OUTHND, 0
DERR, ERROR1 /DEVICE ERROR
64 /DE=DEV.ERR.
COHLD, 0
TSPNOR=JMS I .
XTSPNOR
LIBFIL, 0 /STARTING BLOCK OF SAVED PROG;UNSAVED = 0
DCHAR, CHAR
CLNGTH, 0 /SET BY COMMON
SETBLK, 0 /THE RELATIVE BLOCK IN USE
COWRIT, 1 /WRITE:1 READ:0
PAGE
/&3
/OS/8 FILE ROUTINES
JMP I .+5 /MAIN ENTRY POINT
CONTIN, CIF CDF P /OVERLAY OR CHAIN ENTRY POINT
ION
JMP I .+1
PROC
RECOVR
RESTORE,TSPNOR /'OPEN RESTORE' COMMAND
TAD CHAR /SAVE COMMAND CHAR (3 WORD COMMAND!)
TPUSHA
TGETC
TESTRM /GO TO END OF COMMAND WORD
SKP CLA
JMP .-3
CLA CLL CMA /INITIALIZE ECHO SWITCH
DCA ECHFLG
JMS I [NAME /JUST TO SET ECHO MODE
TPOPA
TAD [-"I /OPEN RESTORE INPUT?
SNA
JMP I [IRST /YES
TAD ["I-"O /NO, MUST BE OUTPUT
SZA CLA
ERROR1 /NEITHER ONE!
202 /IC=ILL. COMMAND
JMP I [ORST
OCLOSE, 0 /CLOSE THE OPEN OUTPUT FILE
TAD OPNFLG
SNA CLA /DON'T BOTHER IF IT ISN'T OPEN
JMP I OCLOSE
TAD [232 /WRITE '^Z'
JMS I [NOCHAR
TAD OPTR1 /PAD BUFFER WITH ZEROS
TAD (-OUTBUF /(AND WRITE IT OUT)
SZA CLA
JMP .-4
TAD DEVHLD /SAVED DEVICE #
IOF
CIF 10
JMS I USR
4 /CLOSE
ONMTMP /POINTER TO SAVED NAME
BLKCNT, 0 /FILE LENGTH (BLOCKS);ZEROED BY OOPEN
JMP DERR /HUH?
DCA OPNFLG /CLEAR 'FILE OPEN' FLAG
ION
DCA OUTFLG /RESTORE TELETYPE OUTPUT ROUTINE
JMP I OCLOSE /DO WHATEVER ELSE NEEDS TO BE DONE
/&4
/OS/8 3/2 BUFFERED CHARACTER OUTPUT
NOCHAR, 0
AND (377 /MASK OUT GARBAGE
ISZ O3 /WHICH CHAR OF THREE?;-3 INITIALLY
JMP O2 /STRAIGHT PACKING
JMS RT /HALF WORD PACKING - PACK FIRST HALF
TAD ATEM /GET SAVED ARG
JMS RT /PACK SECOND HALF
CLA CLL CMA RTL /RESET 3-WAY SWITCH
DCA O3
ISZ OCHCT /BUFFER CAN ONLY BE FILLED WITH 3RD CHAR OF 3
JMP I NOCHAR
JMS I [PUTDEV /TELL THE MONITOR THIS HANDLER'S IN CORE
OUTHND-1 /POINTER TO DEVICE # AND ENTRY
CLA CLL
TAD OLNGTH /-MAXIMUM ALLOWABLE LENGTH
TAD BLKCNT /LENGTH SO FAR
SZL CLA /HAS HE GONE TOO FAR?
JMP OOVER /YES, KILL HIM
IOF
JMS I OUTHND /WRITE ONE BLOCK BUFFER
4200
OUTBUF
OBLK, 0 /SET BY OOPEN
JMP DERR /DEVICE ERROR
ISZ OBLK /BUMP OUTPUT BLOCK
ISZ BLKCNT /AND COUNT OF BLOCKS SO FAR
JMS OSETUP /RESET POINTERS FOR NEXT BUFFER
ION
JMP I NOCHAR
O2, DCA I OPTR1 /NORMAL PACKING IS EASY!
ISZ OPTR1 /BUMP POINTER
JMP I NOCHAR
/&5
O3=. /WHY NOT?
RT, 0 /HALF-WORD PACK ROUTINE
CLL RTL
RTL
DCA ATEM /SAVE FOR SECOND HALF
TAD ATEM
AND [7400
TAD I OPTR2 /ADD IN CHARACTER IN RIGHT HALF
DCA I OPTR2 /PACK IT
ISZ OPTR2 /BUMP POINTER AGAIN
JMP I RT
OOVER, DCA OPNFLG /HE BLEW IT - KILL THE FILE!!
TAD DEVHLD
IOF
CIF 10
JMS I USR
4
ONMTMP
0 /LENGTH OF ZERO TO DELETE
O7600, 7600 /IGNORE ERRORS
ERROR1 /BECAUSE WE ALREADY KNOW ABOUT THEM
345 /OF=OUTPUT FULL
OSETUP, 0 /RESET ALL THE POINTERS (WHAT FUN!)
TAD OBLK-1
DCA OPTR1
TAD OBLK-1
DCA OPTR2
CLA CLL CMA RTL
DCA O3
TAD O7600
DCA OCHCT
JMP I OSETUP
OPTR1, 0
OPTR2, 0
OLNGTH, 0 /SET BY OOPEN
OCHCT, 0
PAGE
/&6
OOPEN, JMS I [IOWAIT /WAIT FOR TELETYPE TO FINISH (DECTAPES ARE SLOW!)
JMS I [OPEN /CALL USR, HANDLER; ENTER OUTPUT FILE
YINT, OUTBLK-1/OUTPUT HANDLER BLOCK
3 /MONITOR 'ENTER' CODE
JMP TTYOUT /'OPEN OUTPUT TTY:'
JMP I (OCLCHK /SEE IF FILE OPEN
JMS I [DISMISS /KICK USR OUT
TPUSHF /SAVE NAME AND EXTENSION
NAMLOC
TPOPF
ONMTMP
TAD STBLK /STARTING BLOCK
DCA I (OBLK /IN NOCHAR
TAD FLNGTH /-MAXIMUM ALLOWABLE LENGTH
DCA I (OLNGTH /IN NOCHAR
JMS I (OSETUP /SET UP PACKING POINTERS
CLA CLL CMA /THERE'S A FILE OPEN!
DCA OPNFLG
TAD DEVNO /SAVE FOR CLOSE
DCA DEVHLD
DCA I (BLKCNT /DITTO
ORST, JMS I [IOWAIT
TAD OPNFLG /ENTRY FOR 'OPEN RESTORE OUTPUT'
SNA CLA /IF 'OPEN OUTPUT', FLAG IS ALREADY SET
ERROR1 /NO OUTPUT FILE TO RESTORE
325 /NF=NO FILE
CLA IAC /SET OUTPUT TO NOCHAR
TTYOUT, DCA OUTFLG /SET OUTPUT TO TTY (INTERRUPT)
TAD ECHFLG
DCA OUTECH /SET OUTPUT ECHO
JMP I [CONTIN /FINISH THE LINE
MINTEG, 0 /INTEGER FAKE
CIF CDF P
JMS I [XINTEG
JMP I MINTEG
/&7
ICHAR, 0 /GET A CHARACTER FROM A FILE
CLA CLL /MAKE SURE
ISZ INCHT /DO WE NEED ANOTHER BUFFER?;-1 INITIALLY
JMP I RDPTR /NO, UNPACK THE CHARACTER
IOF
JMS I INHND /YES, GO GET IT
0200
INBUFF
IBLK, 0 /SET BY IOPEN
SMA CLA /ONLY BOTHER WITH FATAL ERRORS
SKP CLA /REFERENCED!
JMP DERR /WE'VE GOT ONE
ION
ISZ IBLK /BUMP TO NEXT BLOCK
TAD IBLK-1 /AND RESTORE POINTERS
DCA IPNTR
TAD [7200
DCA INCHT
ICHAR1, TAD I IPNTR /STRAIGHTFORWARD UNPACK ROUTINE
JMS RDPTR /DO COMMON CRAP
ICHAR2, TAD I IPNTR /SAVE LEFT HALF FOR LATER
AND [7400
DCA ITEMP
ISZ IPNTR /INCREMENT TO NEXT WORD
TAD I IPNTR /ANOTHER EASY ONE
JMS RDPTR
ICHAR3, TAD I IPNTR /THIS IS THE TRICKY ONE!
ISZ IPNTR /GET LOW-ORDER HALF
AND [7400
CLL RTR /SHIFT RIGHT
RTR
TAD ITEMP /GET HIGH-ORDER HALF (REMEMBER?)
RTR /SHIFT SOME MORE
RTR
JMS RDPTR /GOT IT!
JMP ICHAR1 /1-2-3-1-2-3-1-2-3 ...
RDPTR, 0 /IF YOU DIDN'T KNOW, THIS IS A COROUTINE!
AND [177 /ISN'T THAT AMAZING?
SNA /IGNORE NULLS AND PARITY
JMP ICHAR+1
TAD (-32 /END OF FILE? (^Z)
SZA
JMP .+4 /NO
DCA IPNFLG /YES, CLEAR OPEN FILE FLAG
CLA CMA /PREVENT AN
DCA INFLG /'ATTEMPT-TO-READ-PAST-EOF'!
TAD [232 /PASS ^Z TO PROGRAM (MIGHT COME IN HANDY)
JMP I ICHAR
/&8
ITEMP, 0
IPNTR, 0
INCHT, 0 /SET TO -1 BY IOPEN
ONMTMP, ZBLOCK 4
FILEST, TAD (604 /HERE'S WHERE FILES START!
DCA EXTENSION /SET '.FD' ASSUMED EXTENSION
TSPNOR /SKIP SPACES
TAD CHAR /SAVE COMMAND CHAR
TPUSHA
TGETC
TESTRM /GO TO END OF COMMAND WORD
SKP CLA
JMP .-3
TPOPA
TSORTJ /GO DO COMMAND
FILIST-1
FILGO-FILIST
ERROR1 /OOPS - BAD 'O' COMMAND
36 /BO=BAD OPEN COMMAND
OCLOSR, JMS I [OCLOSE /CLOSE OUTPUT FILE
JMP I [CONTIN
FILIST, "I /INPUT
"O /OUTPUT
"C /CLOSE
"R /RESTORE
"A /ARRAY=COMMON
"T /TERMINATE(COMMON)
SAVER, JMS I [NAME /GET NAME FOR SAVE
JMS I (SAVPR /DO IT
EXITOS, JMS I [DISMIS /NORMAL RETURN FOR OS/8 COMMANDS
ION
CDF CIF 10
JMP I .+1
GOSWITCH-3
PAGE
/&9
IOPEN, JMS I [IOWAIT /WAIT FOR TELETYPE (DECTAPES ARE STILL SLOW!)
JMS I [OPEN /CALL THAT AMAZING GENERAL-PURPOSE SUBROUTINE
INBLK-1
2 /MONITOR 'LOOKUP'
JMP TTYIN /'OPEN INPUT TTY:'
JMP IRST+3 /WHOOPS - FILE NOT FOUND
JMS I [DISMISS /BOOT THE USR OUT
TAD STBLK /SET POINTERS AND OTHER CRAP
DCA I (IBLK /IN ICHAR
CLA CLL CMA
DCA IPNFLG
CLA CLL CMA
DCA I (INCHT /IN ICHAR
IRST, JMS I [IOWAIT
TAD IPNFLG /'OPEN RESTORE INPUT' COMES HERE
SNA CLA /FLAG IS SET ALREADY IF 'OPEN INPUT'
ERROR1 /NO INPUT FILE TO RESTORE
330 /NI=NO INPUT FILE
CLA IAC /SET I/O POINTERS
TTYIN, DCA INFLG
TAD ECHFLG /AND ECHO MODE
DCA INECH
JMP I [CONTIN
FLD0=CLA CLL /PDL SATELLITES;FIELD 0
MPOPA, 0
MQL
FLD0
CIF T
JMS I .+1
ZPOPA
MPUSHA, 0
MQL
FLD0
CIF T
JMS I .+1
ZPUSHA
MPUSHF, 0
MQL
FLD0
CIF T
JMS I .+1
ZPUSHF
/&10
MPOPF, 0
MQL
FLD0
CIF T
JMS I .+1
ZPOPF
MPUSHJ, 0
MQL
FLD0
CIF T
JMS I .+1
ZPUSHJ
MPOPJ, CIF CDF T
JMP I .+1
ZPOPJ
/THE FOLLOWING CODE WILL RECOGNIZE FOR EX.L C DATA(X)
/AND LOOK FOR DATA99 IF X=99
NAMEVL, TAD I (NAMECT /CHECK NUMBER OF CHARS
SNA /AT LEAST ONE ASCII IN FRONT
JMP EVLERR
TAD [-4 /AND AT MOST 4
SMA SZA CLA
JMP EVLERR
DCA TENS /CLEAR TEN COUNTER
CDF P /GO TO EVAL
TPUSHJ /'('READY,DUMP ')'
EVAL
TINTEG
TAD (-144 /.LT. 100 (DEC)
SZL /NOW WE HAVE X-100
EVLERR, ERROR1
135 /FN=FILE NAME ERROR
TAD [12 /X-100+TENS*10
ISZ TENS
SPA
JMP .-3
MQL /OVERFLOW IS LOW ORDER
TAD TENS /TENS IS 10 - HIGH ORDER
CIA /HIGH ORDER - 10
TAD [12 /HIGH ORDER
SNA /IS IT ZERO?
JMP .+3 /YES!WRITE ONLY ONE DIGIT
TAD [60 /6-BIT ASCII
JMS I (NAMSTO
MQA /LOW ORDER AGAIN
TAD [60
JMS I (NAMSTO
JMP I (NAMEC+1
TENS, 0
/&11
XSGN, CDF P /REAL SIGNUM FUNCTION
TAD I [HORD
SNA CLA
TPOPJ /FSGN(0)=0
TPUSHF /DF P!
FLTONE
CDF P
TPOPF
FLAC
XABS, CDF V /TAKE ABS OF FLAC
TAD I FLARGH
SMA CLA
TPOPJ
CDF P
TPUSHJ
MMINSK
TPOPJ
FLARGH, FLARG+1
DCWBM, 7757
GETDEV, 0 /GET DEVICE TYPE FROM MONITOR TABLE
TAD DCWBM /DCB-1
TAD DEVNO
DCA TENS
CDF P
TAD I TENS
CDF L
JMP I GETDEV
FOCTXT, FILENAME FOCAL.TM /USED BY GOSUB
TTYTXT, DEVICE TTY
PAGE
/&12
/LIBRARY COMMAND PROCESSOR
/****** STORAGE ALLOCATION MAP ******
/***** *****
/* 200 RESTORE,OCLOSE,NOCHAR
/* 400 OOPEN,ICHAR,FILEST
/* 600 IOPEN,POPUS,NAMEVL,XABS,XSGN
/* 1000 NAME,GTMON,DISMISS
/* 1200 HANDAD,COMPARE,LOADER,XTSPNO
/* 1400 LOWLIB,SAVER,RETOUR
/* 1600 CHAINER,FETCHER,GOSUB
/* 2000 OPEN,BUMP,INTERRUPT (DEVICES)
/* 2200 XCOM,CORITE,CCLOSE
/* 2400 ARRAY
/* 2600 INTRPT,XIN,XOUT,IOWAIT,ERROL
/* 3000 ERROL,LOWIN,LOWOUT,TERMNL
COMBUF=3200
OUTBUF=5200
INBUFF=5600
/* 6200 OUTPUT HANDLER
/* 6600 INPUT HANDLER
/* 7200 LIBRARY AND COMMON HANDLER
/***** *****
/************************************
NAME, 0 /READ A DEV:FILENAME.EX STRING INTO 'NAMLOC' & 'NEWDEV'
JMS DISMIS /'GETC' WON'T WITH THE USR IN CORE
TAD (5723 /CODE FOR 'DSK:'
DCA NEWDEV /(DEFAULT DEVICE)
DCA NEWDEV+1
JMS GNAME /GET FIRST PART (MIGHT BE DEVICE)
TAD ["A-": /WAS IT A DEVICE?
SZA CLA
JMP I NAME /NO, ALL SET UP
TGETC /YES, MOVE PAST ':'
TAD NAMLOC /MOVE TO DEVICE AREA
DCA NEWDEV
TAD NAMLOC+1
JMP NAME+4 /GET FILENAME
GNAME, 0 /READ A NAME INTO 'NAMLOC'
DCA NAMLOC /CLEAR NAME AREA
DCA NAMLOC+1 /(DON'T CLEAR ASSUMED EXTENSION)
DCA NAMLOC+2
TAD [NAMLOC /INITIALIZE POINTERS
DCA NMBASE
CLA CMA
DCA PERDSW
DCA NAMECT
TSPNOR
SKP
/&13
NAMEC, TGETC /MAIN LOOP
TAD CHAR /LOWER FIELD COPY, OF COURSE
TAD [-"( /FILENUMBER TO EVALUATE?
SNA
JMP I (NAMEVL /GO DO IT
TAD ["(-". /EXTENSION?
SNA
JMP PERD /YES, CLEAR DEFAULT EXTENSION
TAD [".-", /COMMA?
SNA CLA
JMP ECHCHK /YES, CHECK FOR ECHO
ECHGO, JMS DECODE /MUST BE A-Z, 0-9
JMP I GNAME /IT WASN'T, MUST BE END OF NAME
SZL /RESTORE CHARACTER
TAD [57
IAC /6-BIT ASCII
JMS NAMSTO
JMP NAMEC /CONTINUE LOOP
NAMSTO, 0
DCA DECODE /TEMPORARY STORAGE
TAD NAMECT /NO MORE THAN 6 CHARACTERS/NAME
TAD [-6
US7700, SMA CLA
JMP NAMEC
TAD NAMECT /BUILD POINTER TO CHARACTER POSITION
CLL RAR
TAD NMBASE
DCA TT
TAD DECODE /LEFT OR RIGHT HALF?
SNL
BSW /LEFT, SHIFT OVER
TAD I TT /ADD IN OTHER HALF
DCA I TT
ISZ NAMECT /BUMP COUNT
JMP I NAMSTO
PERD, TAD NAMLOC /FOUND A PERIOD IN STRING
SZA CLA
ISZ PERDSW
ERROR1 /DOUBLE PERIODS OR NO FILE NAME
35 /BN=BAD NAME IN FILES
DCA EXTENSION /CLEAR EXTENSION
TGETC /MOVE PAST PERIOD
ISZ NMBASE /FAKE OUT POINTERS
TAD [4
JMP NAMEC-3
/&14
ECHCHK, TGETC /MOVE PAST COMMA
TSPNOR
TAD CHAR /MUST BE FOLLOWED BY 'ECHO'
TAD [-"E
SZA CLA
JMP I GNAME
DCA ECHFLG /SET ECHO FLAG
TGETC /MOVE TO END OF WORD
JMS DECODE
JMP I GNAME
CLA CLL
JMP .-4
DECODE, 0 /CHECK FOR A-Z, 0-9
TAD CHAR /IF YES ISZ RETURN
TAD [-"9-1
CLL
TAD ["9+1-"0
SZL
JMP DCDYES /NUMBER;CHAR-260;L=1
TAD ["0-"Z-1
CLL CML
TAD ["Z-"A+1
SNL
DCDYES, ISZ DECODE /ALPHA;CHAR-301;L=0
JMP I DECODE
NMBASE, 0
PERDSW, 0
NAMECT, 0
TT, 0
/&15
XGETC, 0 /FAKE
CDF P
TPUSHJ
MGETC
JMP I XGETC
GTMON, 0 /LOCK THE USR IN CORE
IOF /(NOP IF ALREADY IN CORE)
CDF L
CIF P
JMS I USR
10
TAD [200 /SET POINTER FOR LATER CALLS
DCA USR
JMP I GTMON
DISMIS, 0 /IF THE USR IS IN, KICK IT OUT
CLA CLL
IOF
CDF L /MAKE SURE
TAD USR /CHECK POINTER TO FIND OUT
SPA CLA
JMP I DISMIS
CIF P
JMS I USR
11
TAD US7700 /RESET POINTER
DCA USR
JMP I DISMIS
PAGE
/&16
/HANDAD CALL: HANDAD
/SLOT
/SETS DEVNO; DEVICE NO. IN SLOT; ENTRYPOINT IN SLOT
HANDAD, 0 /LOADS HANDLER INTO PROPER SLOT
TAD I HANDAD /WHICH SLOT?
ISZ HANDAD
DCA SLOT
JMS COMPARE /IF THE HANDLER HAS THE SAME NAME,
-2 /DON'T LOAD IT AGAIN
SLOT, 0
NEWDEV-1
JMP NOTEQ /DIFFERENT NAMES, LOAD NEW HANDLER
ISZ AUTO5
TAD I AUTO5 /(SET BY 'COMPARE')
DCA DEVNO /MOVE DEVICE # (FOR SAVE AND CLOSE)
TAD AUTO5 /POINTS TO DEVICE #
DCA .+2
JMS I [PUTDEV /SO USR KNOWS IT'S IN CORE
0
JMP I HANDAD
NOTEQ, ISZ SLOT /BUMP POINTER TO SAVE NAME
TAD NEWDEV /MOVE NEW DEVICE NAME TO TABLE
DCA I SLOT
ISZ SLOT
TAD NEWDEV+1
DCA I SLOT
ISZ SLOT
JMS I [GTMON /WE MUST CALL THE USR, MIGHT AS WELL LOCK IT IN
RETRY, TAD NEWDEV /MOVE DEVICE NAME FOR MONITOR CALL
DCA DEVC
TAD NEWDEV+1
DCA DEVC+1
TAD I SLOT /MOVE LOAD POINT
IAC /TWO PAGE HANDLER!
DCA DLOAD
CIF P
JMS I USR /CALL MONITOR (ALREADY IN CORE)
1 /FETCH BY NAME
DEVC, 0 /NAME
0 /RETURNS DEVICE NO.
DLOAD, 0 /RETURNS ENTRY POINT
ERROR1 /DEVICE NOT AVAILABLE
323 /ND=NO DEVICE
CLL
/&17
TAD DLOAD /ENTRY POINT FOR HANDLER
TAD [200 /IF THIS HANDLER IS IN PAGE 7600,
SZL CLA /DON'T BOTHER TO CHECK FOR LEGALITY
JMP HANDOK /SYSTEM HANDLER
TAD DLOAD /IF THE HANDLER WAS NOT LOADED
AND INTR76 /(7600)INTO THE PROPER PAGE, RELOAD IT!
CLL CIA
TAD I SLOT /PROPER LOADING ADDRESS
SNA CLA
JMP HANDOK /EVERYTHING'S ALL RIGHT
DCA DLOAD /CLEAR ENTRY POINT
JMS I [PUTDEV /TELL USR THE HANDLER IS NOT
DEVC+1 /IN CORE ANYMORE
JMP RETRY /LOAD IT THIS TIME
HANDOK, ISZ SLOT /BUMP POINTER TO DEVICE #
TAD DEVC+1 /SAVE IT
DCA I SLOT
ISZ SLOT /MOVE TO ENTRY POINT
TAD DLOAD /SAVE ENTRY
DCA I SLOT
TAD DEVC+1 /GET DEVICE #
DCA DEVNO /SAVE IT AND EXIT
JMP I HANDAD
COMPARE,0 /COMPARE TWO BLOCKS OF INDEFINITE LENGTH
TAD I COMPARE /CALLING SEQUENCE:
ISZ COMPARE /JMS COMPARE
DCA XCNTR / -# OF WORDS TO CHECK
TAD I COMPARE / FIRST-1
ISZ COMPARE / SECOND-1
DCA AUTO5 /RETURN IF NO MATCH
TAD I COMPARE /RETURN IF MATCH
ISZ COMPARE
DCA AUTO6
AGAIN, TAD I AUTO5 /COMPARE TWO WORDS
CIA
TAD I AUTO6
SZA CLA
JMP I COMPARE /NO MATCH
ISZ XCNTR /FINISHED?
JMP AGAIN /NO, CHECK NEXT TWO
ISZ COMPARE /YES, BUMP RETURN POINTER
JMP I COMPARE
/&18
LOADER, JMS I [IOWAIT /THIS IS FOR CHAINING TO ANOTHER PROGRAM
JMS I [NAME /OR FOR OVERLAYING FOCAL ITSELF(ST.ADD:00200)
TAD [2326 /EXTENSION "SV" IS FORCED ON
DCA EXTENSION /:IT HAS TO BE A SAVE FILE FOR USR CHAIN
JMS I [OCHK /DON'T FORGET TO CLOSE THE FILES
TAD [NAMLOC /POINTER TO NAME
DCA .+10
TAD [2
DCA .+5
IAC /USR CHAIN EXPECTS IT TO BE ON SYS: DEV.#1
IOF /MAKE DOUBLY SURE!
CIF P
JMS I USR
2 /LOOKUP RETURNS FILE START IN ARG.2
NAMLOC
0
ERROR1 /USR DID NOT FIND IT
47 /CH=CHAINING ERROR
DCA LIBBLK /KILL LIB HANDLER;CHAIN DOES RESET
TAD [6 /OK! CHANGE USR FUNCTION TO CHAIN = 6
DCA .-7
JMP .-13 /BY-BY!! WILL SEE YOU SOME OTHER TIME!
XTSPNO, 0 /DUPLICATE SPNOR
TAD CHAR
TAD [-240
SZA CLA
JMP I XTSPNO
TGETC
JMP XTSPNO+1
MSORTC, 0
CDF P
TPUSHJ
TERMER
ISZ MSORTC
JMP I MSORTC
COMLIST,"S /SAVE
"C /CALL
"R /RUN
"D /DELETE
"G /GOSUB
" /FAKE A 'LIBRARY RETURN' WITH A SPACE
"E /EXIT
"L /LOAD; CHAIN A PROGRAM
NTR76, 7600 /ENDS LIST
PAGE
/&19
/ACTUAL LIBRARY PROCESSOR
/STARTING WITH COMMAND DECODE:
LOWLIB, JMS I [IOWAIT
TAD CHAR /SAVE FOR COMMAND SORT
TPUSHA
TAD [603 /'.FC' ASSUMED EXTENSION
DCA EXTENSION
SKP CLA /MIGHT BE A TERMINATOR ALREADY
TGETC /MOVE TO END OF COMMAND WORD
TESTRM
SKP
JMP .-3
TPOPA /RESTORE COMMAND CHAR
TSORTJ /AND BRANCH TO APPROPRIATE ROUTINE
COMLIST-1
COMPO-COMLIST
ERROR1 /SORRY, CHARLIE!
270 /LI=LIBRARY COMMAND ERROR
COMPO, SAVER
FETCHER
CHAINER
BUMP
GOSUB
RETOUR
C7600, 7600
LOADER
SAVPR, 0 /CALLED BY 'SAVER' AND 'GOSUB'
JMS I [OCHK /CLOSE OUTPUT FILE TO AVOID TROUBLE
TAD [NAMLOC /POINTER TO NAME
DCA SAVEPT
TPUSHF
NAMLOC
CDF T
TPOPF /GET NAME TO PROGRAM TITLE
LINE0+3
CDF P
TAD I [BUFR
DCA BLOCK /SAVE TEMP. PROGRAM LENGTH
TAD I (7666 /GET SYSTEM DATE
SNA /IF BOOTED THEN 1974
CLA CLL IAC RTL
AND [7
TAD (6760 /'70'
MQL
TAD I (7666 /AGAIN FOR MONTHS
AND [7400
BSW
RAR
TAD (MONAME /ADRESS OF NULL MONTH NAME
DCA RECORD
CDF T
TAD I RECORD /GET MONTH NAME
DCA I (LINE0+7 /SAVE IN TITLE
ISZ RECORD
TAD I RECORD /SECOND HALF
DCA I (LINE0+10
MQA
DCA I (LINE0+12 /SAVE YEAR
TAD BLOCK
DCA I (LINE0-1 /SAVE PROGRAM LENGTH
TAD (4040
DCA I (LINE0+6 /KILL EXTENSION
JMS I [GTMON /GET USR;RESETS DF
JMS I [HANDAD /AND GET HANDLER
LIBBLK-1
/&20
TAD BLOCK
AND C7600 /MASK OFF
CLL RAR /CONVERT TO PAGES
DCA BLOCK /FOR HANDLER
TAD BLOCK /ROUND UP TO BLOCKS
TAD [100
AND C7600
CLL RTR
RAR
DCA RECORD /FOR MONITOR 'ENTER':BITS 0-7
TAD RECORD /GET DESIRED LENGTH
TAD DEVNO /(SET BY 'HANDAD')
CIF P
JMS I USR /ENTER OUTPUT FILE
3
SAVEPT, NAMLOC
0
ERROR1 /NO ROOM ON DEVICE
65 /DF=DEVICE FULL
TAD RECORD /SHIFT FOR CLOSING LENGTH
CLL RTR
RTR
DCA SAVBLK
TAD DEVNO /CLOSE THE FILE BEFORE WE WRITE IT!
CIF 10 /(SURE, IT'S CHEATING, BUT
JMS I USR /IT SAVES TIME!)
4 /CLOSE
NAMLOC
SAVBLK, 0 /NO. OF BLOCKS
JMP DERR /IMPOSSIBLE ERROR!
TAD SAVBLK /SAVE THIS CRAP TO REMEMBER
CIA /WHERE THIS PROGRAM IS
DCA LIBLEN /IN CASE WE WANT TO GOSUB
TAD SAVEPT
DCA LIBFIL
TAD NEWDEV
DCA LIBDEV
TAD NEWDEV+1
DCA LIBDEV+1
TAD SAVEPT /MOVE STARTING BLOCK FOR WRITE
DCA POINT4
TAD (4021 /GET FUNCTION WORD
TAD BLOCK /HOW MUCH TO WRITE
DCA BLLL
JMS I LIBHND
BLLL, 0 /WRITE (BLOCK) BLOCKS FROM FIELD 2
200 /FROM 200 UP
POINT4, 0
JMP DERR /GO COMPLAIN ABOUT DEVICE
JMP I SAVPR
/&21
LIBLEN, 0 /SAVED LENGTH
LIBDEV, ZBLOCK 2
RECORD, 0
BLOCK, 0
PAGE
/&22
/LOOKUP AND LOAD ROUTINES
CHAINER,IAC /THESE ALL DO THE SAME THING
GOSUB1, IAC /AND THEN GO TO DIFFERENT PLACES
FETCHER,IAC
CDF 10
DCA I [GOSWITCH
CDF
LOAD, JMS I [OPEN /CALL THE HANDLER AND LOOKUP THE FILE
LIBBLK-1
2
JMP .+5 /TTY: NOT A DIRECTORY DEVICE
ERROR1
337 /NP=NO PROGRAM FOUND
JMS I [DISMISS
JMS I (GETDEV /GET DEVICE TYPE
SMA CLA
ERROR1 /NOT A DIRECTORY DEVICE
63 /DD=NOT A DIR. DEV.
CDF P
TPUSHJ
PGETLN /SOME COMMANDS HAVE LINE NUMBERS
LOADGO, JMS I [DISMISS /ONLY USED BY 'RETURN'
TAD STBLK /BLOCK TO READ FROM
DCA POINT6
CDF T
TAD I (PDLXR /BOTTOM OF PDL
TAD MIN200
AND MIN200 /PAGES
BSW
CLL RTR /BLOCKS
TAD FLNGTH /NOW COMPARE WITH LENGTH OF FILE
SPA CLA
ERROR1 /PROGRAM TOO LONG
373 /PL=PROGRAM LENGTH ERROR
CDF 10
CLA CLL CMA RAL /(=-2)
TAD I [GOSWITCH /IS THIS A GOSUB?
SZA CLA
JMP .+7 /NO, SKIP THIS GARBAGE
TAD I DCHAR /YES, SAVE PROGRAM NAME, ETC.
CDF
TPUSHA /PDL NOW CONTAINS:
TAD [215 /CHAR,DEVICE,FILE LENGTH,START BLOCK
CDF 10
DCA I DCHAR
CDF
TAD FLNGTH /COMPUTE FUNCTION WORD
CIA
BSW
CLL CML RAL /SET TO SEARCH FORWARD
TAD (20 /FIELD 2
DCA LENF1
JMS I LIBHND /GET THE PROGRAM
LENF1, 1221
200
POINT6, 0
JMP DERR
/&23
TAD NEWDEV /SAVE THIS STUFF SO WE
DCA I (LIBDEV /KNOW WHERE WE ARE
TAD NEWDEV+1
DCA I (LIBDEV+1
TAD STBLK
DCA LIBFIL
TAD FLNGTH
DCA I (LIBLEN
CIF CDF T
TAD CODENU
TAD I (PC0+2
DCA MSORTJ
TAD I (PC0+2
SZA
JMP I MSORTJ
TAD I (LINE0-1
CDF P
DCA I [BUFR
CIF CDF L
JMP I [EXITOS
GOSUB, TAD LIBFIL /CHECK FOR CURRENT PROGRAM
SZA
JMP NOSAVE /NO NEED TO SAVE CORE
TPUSHF /MOVE 'FOCAL.TM' TO NAME AREA
FOCTXT
TPOPF
NAMLOC
TAD (5723 /DEVICE 'DSK' FOR SAVE
DCA NEWDEV
DCA NEWDEV+1
JMS I (SAVPR /SAVE FILE (THIS WILL LEAVE USR IN CORE)
TAD [603 /RESET EXTENSION TO 'FC'
DCA EXTENSION
TAD LIBFIL /STARTING BLOCK
NOSAVE, TPUSHA /'LIBFIL' STILL IN AC
TAD I (LIBLEN
TPUSHA
TPUSHF
LIBDEV
JMP GOSUB1
/&24
RETOUR, TPOPA /GET BACK ALL THE JUNK WE SAVED
CDF 10 /FOR THE LAST GOSUB
DCA I DCHAR /IN-LINE CHARACTER
CDF
TPOPF /DEVICE NAME
NEWDEV
TPOPA /FILE LENGTH
DCA FLNGTH
TPOPA /STARTING BLOCK
DCA STBLK
JMS I [HANDAD /GET THE HANDLER BACK
LIBBLK-1
JMP LOADGO /LOAD THE PROGRAM
PAGE
/&25
/MISCELLANEOUS GENERAL-PURPOSE ROUTINES
/THIS IS THE GENERAL OPEN SUBROUTINE
/CALLNG SEQUENCE:
/JMS I [OPEN
/HANDLER BLOCK
/MONITOR CALL CODE
/RETURN IF TTY: IS DEVICE
/ERROR RETURN
/NORMAL RETURN
/SETS STBLK, FLNGTH ON PAGE ZERO
OPEN, 0
CLA CLL CMA /INITIALIZE ECHO FLAG TO OFF
DCA ECHFLG
JMS I [NAME /GET DEVICE AND FILENAME
JMS I [COMPARE /DEVICE 'TTY:' IS SPECIAL
-2
NEWDEV-1
TTYTXT-1
JMP OTHER /DEVICE OTHER THAN TTY
ISZ OPEN /INCREMENT TO PROPER RETURN
ISZ OPEN
JMP I OPEN
OTHER, TAD I OPEN /GET HANDLER BLOCK TO USE
DCA HND
ISZ OPEN
TAD [NAMLOC /POINTER TO NAME
DCA NAMPT
JMS I [GTMON
JMS I [HANDAD /GET THE HANDLER
HND, 0 /SET TO HANDLER BLOCK
TAD I OPEN /GET MONITOR CALL CODE (2 OR 3)
ISZ OPEN
DCA CALL
DCA LNGTH /FOR MONITOR KLUDGE (IT FALLS THROUGH ON ERROR)
TAD DEVNO /DO THE CALL
CIF 10 /DEV # IN AC
JMS I USR /2: LOOKUP
CALL, 0 /3: ENTER
NAMPT, NAMLOC /POINTER TO NAME;RETURNS START BLOCK
LNGTH, 0 /RETURNS -FILE LENGTH IN BLOCKS;TENTATIVE FOR ENTER
JMP OTHER-2 /LET THE CALLING ROUTINE DECIDE ERROR PROCEDURE
TAD LNGTH /MOVE PARAMETERS TO PAGE ZERO
DCA FLNGTH
TAD NAMPT
DCA STBLK
JMP OTHER-3 /AND TAKE NORMAL RETURN
/&26
BUMP, JMS I [NAME /DELETE IS AN EASY ONE (THANK GOD!)
JMS I [GTMON
JMS I [HANDAD
LIBBLK-1
JMS I [OCHK /CLOSE ANY OPEN OUTPUT FILE
CIF 10 /DELETE THE FILE
TAD DEVNO
JMS I USR
4
NAMLOC
0
ERROR1
123 /FD=FILE DELETION ERROR
DCA LIBFIL /IN CASE HE JUST DELETED THIS PROGRAM
JMP I [EXITOS
OCLCHK, TAD OPNFLG
SNA CLA
ERROR1
344 /OE=OPEN OUTPUT ERROR
JMS I [OCLOSE
TAD (YINT
DCA OPEN
JMP OTHER
PUTPNT, 0
PUTDEV, 0 /TELL THE MONITOR A HANDLER IS IN OR OUT
TAD I PUTDEV /GET POINTER TO DEV# AND ENTRY
DCA ERROR
TAD I ERROR /DEVICE#
ISZ ERROR /BUMP POINTER TO ENTRY
TAD (7646 /MONITOR TABLE
DCA PUTPNT /POINTER TO 'HANDLER IN CORE' FLAG
TAD I ERROR /FLAG IS HANDLER ENTRY
CDF P /TABLE IS IN FIELD ONE
DCA I PUTPNT
CDF L
ISZ PUTDEV
JMP I PUTDEV
/&27
FILGO, IOPEN
OOPEN
OCLOSR
RESTOR
ARRAY
CCLOSR
MSORTJ, 0 /ANOTHER DUPLICATE
CIA
DCA ATEM
TAD I MSORTJ
ISZ MSORTJ
DCA AUTO4
TAD I AUTO4
SPA
JMP MSEX
TAD ATEM
SZA CLA
JMP .-5
TAD AUTO4
TAD I MSORTJ
DCA ATEM
TAD I ATEM
DCA ATEM
JMP I ATEM
MSEX, ISZ MSORTJ
MIN200, 7600
JMP I MSORTJ
CODENU, 0
MORE1, NOP /SKIP1
JMP MORE2 /VAR. FLD STILL ON
DCA I XNMBSG /CLEARS HORD VAR "#"
NOP /CLEAR1
JMP I (INTEXI
MORE2, NOP /SKIP2
JMP MORE3
DCA I XEXCLA /VARIABLE "!"
NOP /CLEAR2
JMP I (INTEXI
MORE3, NOP /SKIP3
JMP NOMORE
DCA I XQUOTS /VARIABLE """
NOP /CLEAR3
JMP I (INTEXI
NOMORE, CAF
ISZ IZER
JMP .-1
JMP I (INTEXI
IZER, 0
XNMBSG, NMBSGN
XEXCLA, EXCLA
XQUOTS, QUOTS
PAGE
/&28
XCOM, TINTEG /COMMON FOR 2048 4-W. VARIABLES
DCA BLKTMP
TAD BLKTMP
AND (377 /ADRESS IN BUFFER
CLL RTL /*4 : 4-WORD
TAD I (COSTA /START OF BUFFER
TPUSHA
TAD BLKTMP
AND [7400 /EFFECTIVELY AND 3400:8 BUFFERS
BSW /OF 4 BLOCKS EACH
TPUSHA /STORE RECURSIVELY
TPUSHJ /PUT OR GET?
ARG
CLA CMA /GET
DCA GEPUSW /PUT
TPOPA /GET BLOCK #
TPUSHJ
COMEXT /GET BLOCK
ISZ GEPUSW
JMP COMPUT
TPOPA /NOW GET ADRESS
DCA GEPUSW
TPUSHF
GEPUSW, COMBUF
CDF P
TPOPF
FLAC
TPOPJ
COMPUT, TPOPA
DCA BLKTMP
CDF P
TPUSHF
FLAC
TPOPF
BLKTMP, COMBUF
IAC
DCA COWRIT
TPOPJ
ARG, TAD CHAR
TAD [-",
SZA CLA
TPOPJ
CDF P
TPUSHJ
EVAL-1
IAC
TPOPJ
/&29
COMEXT, DCA THSBLK /ASKED FOR BLOCK
TAD THSBLK
CIA
TAD SETBLK /IS IT ALLREADY HERE?
SNA CLA
TPOPJ /YES.EXIT
CLL CML IAC RAL /+3 SO THAT WE DON'T WRITE ON ANOTHER FILE
TAD THSBLK
TAD CLNGTH /SET TO 0 BY CCLOSE
SMA CLA
ERROR1 /WE ARE ASKING FOR TO MUCH!
4 /AE=ARRAY EXCEEDING CORE LIMITS
JMS CORITE /WRITE OUT IF ANY MODIFICATIONS OR ZEROING
TAD COMFLG /IN OR OUT?
SNA CLA
JMP COINPT
TAD COCNT /LARGEST SO FAR
CIA
TAD THSBLK
SPA CLA
JMP COINPT /THSBLK .LT. COCNT;ALREADY OUT
TAD COCNT
DCA SETBLK /SET TO WRITE AND CLEAR NEXT BUFFER
JMP COMEXT+1
COINPT, CLA CLL /LNK=0 FOR READ
TAD THSBLK /READ ASKED FOR BLOCK
MQL
JMS I (COHNDL
TAD THSBLK
DCA SETBLK /NOW RESET
DCA COWRIT /CLEAR WRITE FLAG
TPOPJ
/&30
CORITE, 0 /ALSO CALLED BY CCLOSE
TAD COWRIT
SNA CLA /ONLY WRITE IF NEW DATA
JMP I CORITE
CLA CLL CML /LNK=1 FOR WRITE
TAD SETBLK /WRITE BLOCK IN CORE
MQL
JMS I (COHNDL
CLA CMA /NOW CLEAR BUFFER
TAD I (COSTA
DCA AUTO3
TAD [-2000
DCA XCNTR
DCA I AUTO3
ISZ XCNTR
JMP .-2
TAD SETBLK
CIA
TAD COCNT /CHECK IF LAST BUFFER
SZA CLA
JMP I CORITE
CLA CLL IAC RTL /4
TAD COCNT
DCA COCNT /UPDATE COCNT
JMP I CORITE
CCLOSE, 0 /SUBROUTINE CALLED BY 'OPEN TERMINATE' AND 'OCHK'
ISZ COWRIT /FORCE A LAST WRITE
JMS CORITE
TAD COMFLG
SNA CLA
JMP CLOOUT /ONLY CLOSE INTERNALLY
JMS I [IOWAIT
TAD COHLD /DEVICE NUMBER
IOF
CIF P
JMS I USR
4 /CLOSE
CNMTMP
COCNT, 0
ERROR1
2 /AC=ARRAY CLOSE ERROR
ION
CLOOUT, DCA CLNGTH
DCA SETBLK
JMP I CCLOSE
THSBLK, 0
PAGE
/&31
COHNDL, 0 /SUB FOR READING OR WRITING ARRAY BUFFER
SZL
JMP .+6 /WRITE
TAD SETBLK /READ
TAD [12 /IF LAST WRITTEN BLOCK+4+7
CMA
TAD I (THSBLK /IS SMALLER THAN ASKED FOR BLOCK
CLA RTL /THEN ROTATE LINK FOR SEARCH FORWARD
TAD [2000 /HERE LNK=0:READ;1:WRITE
RAR /5000:WRITE;1000:READ;8 PAGES
DCA COARG /1001:READ FORWARD
MQA /BLOCK
TAD CBLOCK /FIRST OF FILE
DCA COSTA+1
JMS I [IOWAIT
TPUSHF
COMDEV
TPOPF
NEWDEV /GET HANDLER BACK
JMS I [HANDAD
LIBBLK-1
JMS I [DISMISS
IOF
JMS I LIBHND
COARG, 0
COSTA, COMBUF
0
SMA CLA /ONLY FATAL ERRORS
SKP CLA
JMP DERR
ION
JMP I COHNDL
CBLOCK, 0
CNMTMP, ZBLOCK 4
REDFLG, 0
/&32
ARRAY, JMS I [IOWAIT /"OPEN ARRAY"
TAD CLNGTH
SZA CLA /FILE STILL OPEN?
JMS I [CCLOSE /YES.CLOSE IT
TAD (0601 /ASSUMED EXTENSION .FA
DCA EXTENS
JMS I [OPEN
LIBBLK-1
2 /FIRST DO A LOOKUP
JMP NODIR /IT'S DIFFICULT TO READ FROM THE TTY
SKP /THERE WAS'NT ANY FILE OF THAT NAME
JMP COMON /FOUND IT!
TAD ARPNT /FAKE 'OPEN' FOR ENTER
DCA I [OPEN
JMP I (OTHER
LIBBLK-1
3 /ENTER
ARPNT, .-2 /IT CAN'T COME HERE;ALREADY TESTED
ERROR1 /DEFINITELY AN ERROR
5 /AF=ARRAY FULL
CLA CLL CML IAC RAL /3
COMON, DCA REDFLG /SET TEMP FLAG
JMS I [DISMIS
JMS I [GETDEV /STILL WORSE FROM A DISPLAY
SMA CLA
NODIR, ERROR1
3 /AD=ARRAY DEVICE ERROR
TPUSHF /EVERYTHING IS OK
NAMLOC
TPOPF
CNMTMP /SAVE NAME FOR CLOSE
TAD NEWDEV
DCA COMDEV
TAD NEWDEV+1
DCA COMDEV+1
TAD DEVNO
DCA COHLD
TAD STBLK
DCA CBLOCK /SAVE FIRST BLOCK
CLL
TAD FLNGTH
TAD [100 /IS LENGTH GREATER THAN 100BLOCKS?
SNL
CLA CLL /YES;IGNORE
TAD NODIR-1 /-100
DCA CLNGTH /STORE LENGTH .LE. 100 (NEG)
TAD REDFLG
CLL RAR /SET LINK IF OUT
DCA COMFLG
DCA I (THSBLK
SZL
JMP .+3
TPUSHJ
COINPT /READ FIRST BUFFER IF INPUT
DCA I (COCNT
JMP I [CONTIN
COMDEV, ZBLOCK 2
/&33
OCHK, 0 /IF ANY FILE EXISTS CLOSE IT
TAD COMFLG
SZA CLA
JMS I [CCLOSE
JMS I [OCLOSE
JMP I OCHK
CCLOSR, TAD CLNGTH
SZA CLA
JMS I [CCLOSE
JMP I [CONTIN
PAGE
/&34
*COMBUF
ZBLOCK 2000
/GET OUT THE PAGE 0 LITERALS
>
FIELD 2
IFNZRO LIBLST <XLIST>