&[~ REDBUILD.BAK REDBUILD.BAK,BACKUP D:[SAOSTOIC...] REDBUILD.BAK/SAVE/LOG ROGER A@DsV3.5 _GPVAX::  8 _DRC0: V3.5 ~ *[SAOSTOIC]AAAREADME.LIS;14+,./A 4O- 0123K56C"%7 %89GAHJ= RED, STOIC, and CALC: Installation and Maintenance1. Before You Start.Before performing installation or maintenance,Cset your default directory to this one and type "@ASSIGN" to create.logical names for the maintenance directories.2. Trying Them OutH(N.B.: If they don't work, read item 3.5, do item 4 and then try again.)5The easist way to try out RED, STOIC or CALC is to do $ @ASSIGN7as above, then define the following symbols as desired:$ RED :== $SAO$RED:RED RED$ STOIC :== $SAO$RED:RED$ CALC :== $SAO$RED:RED FLODEFDTyping "STOIC" will then start STOIC, and typing "RED filename" will@start RED with the given input file (or "RED" by itself to startAwithout loading a file). CALC is a floating-point reverse-polishCcalculator. It is slightly documented and still under development;2however, it works. For example, the command line:*$ CALC 2. .SQRT 2. ./ .ASIN 4. .* .= CR ;F;will calculate the value of PI as four times the arcsine ofCthe square root of two over two, type the result, start a new line, then exit."3. Installing the RED/STOIC Image3A single image is contains both STOIC and RED. Type@INSTALLGto copy the image to SYS$SYSTEM and install it in VMS. Installation isEnot necessary, but makes RED/STOIC more efficient, which is useful onGheavily loaded systems. RED/STOIC is totally re-entrant and installing4the image allows VMS to take advantage of this fact.)Symbolic names for commands would then be$ RED :== $STOIC RED$ STOIC :== $STOIC$ CALC :== $STOIC FLODEF,3.5 A Possible Problem (and it's solution).IIf "quota exceeded" messages appear while running RED, RED may be sendingNmore characters per write to the screen than your configuration of VMS allows.FExamine the constant near the beginning of source file OBUF in the REDLdirectory (one level below this directory) and change it if necessary. As aJnote in that file explains, it should be at least 52 less than your SYSGENOparameter MAXBUF. DEC says that it only needs to be 16 less but our experienceMis otherwise. If your system has a large value for MAXBUF you could increaseLthe size of RED's OBUF for increased efficiency. The default value for OBUFDis 1000 which is 56 less than DEC's default SYSGEN value for MAXBUF.#4. Building RED/STOIC from ScratchNTo generate STOIC and RED from scratch, set default to this directory and typeL"@STOBUILD". (If you type "@STOBUILD MAC" it will first assemble all modulesOmaking up the STOIC kernel; this is normally not necessary.) STOBUILD will linkOthe STOIC kernel,producing RKERNEL.EXE. It createsa copy of RKERNEL.EXE calledLHEAD0.EXE which is used later in creating images of fullblown STOIC and RED.>STOBUILD then compiles the rest of STOIC and creates the imageSAO$STOIC:STOIC.EXE.@STOBUILD then compiles RED and creates the image SAO$RED:RED.EXE,To run STOIC and RED, define symbols such as+$ STOIC :== $STOIC.EXE-$ RED :== $RED.EXE RED5. Miscellaneous Information>The command procedure ASSIGN.COM will assign the logical namesDSAO$KERNEL, SAO$STOIC, and SAO$RED to sub-directories of the currentCdirectory. The SAO$KERNEL logical name is necessary when using the/image creation facility (to create .EXE files)..6. New RED Feature, not Documented in RED.MEM;There is a new RED command, ",", i.e., the "comma" command.>This commands causes RED to enter input mode and for the words="INPUT MODE" to be written in the command area of the screen.DAlthough bulk input (typing in lots of text at one time) can be doneKconveniently from IMMEDIATE MODE, some users have found it to be expensive,Csince RED does one QIO per keystroke in IMMEDIATE mode. INPUT MODEHdoes one QIO per RETURN or DELETE. Cursor movement and INSTANT COMMANDSHare not available from INPUT mode; otherwise it is the same as IMMEDIATE0MODE. INPUT MODE is exited by typing LINE-FEED.GMuch the same efficiency gain could be obtained by more intelligent useGof the terminal driver in IMMEDIATE MODE. This may be implemented in afuture release.G7. Information on changes for previous STOIC users from Jonathan Mark:EThis version of SAO STOIC/RED has been modified to work under versionF3.0 of VMS. The old non-re-entrant version failed to work on at leastGone system running version 3.0 because of a problem with RMS buffers inCthe P0 region. That problem has been fixed by the inclusion of theFIOSEGMENT value in the options files RKERNEL.OPT and HEAD0.OPT. PartsDof some screen handling routines also failed to work under version 3Ain the old version, notably when RED was first started up and theFANSI_CRT terminal parameter was set. These have been fixed by trivialFchanges to TYIO.MAR (enabling GETMODE and SETMODE to examine and alterCthe new extended terminal characteristics field) and to E (changingCthe lengths of the arrays for terminal characteristics from 8 to 12Cbytes), and a slightly larger change to the EDV module, causing REDEto reset the ANSI_CRT parameter on startup (the parameter is returnedto its original value on exit).HThis version is also able to operate as a batch job. Previous versions,Fwhen run non-interactively, failed with a repeating error message whenDSTOIC attempted to do QIO output to the log file. When this versionAof STOIC is started up, it calls a routine ("outinit", defined inDTYIO.MAR) to determine whether the job is interactive and define theBTYO and TYPE output words accordingly, using RMS for the output ifthe job is not interactive.Later implementation note:FTwo changes to the STOIC link/create-images procedure were found to beGnecessary for proper operation under VMS 3.0. It is now only necessaryEto link one executable image, instead of two as in the old re-entrantGversion. This image, RKERNEL.EXE, is then copied into HEAD0.EXE. ThisDprevents discrepancies that came up between the kernel image and theHprototype header image, when one was linked read/write and the other wasJlinked read-only. The kernel is now linked read/write, making it possibleGto write over the code when running RKERNEL.EXE; however, STOIC-createdGimages are set up to contain only read-only image sections and are safe,from demolition by misguided STOIC programs.DThe other change was to RKERNEL.OPT (now the only options file): theISTOIC object modules are now combined (and isolated) in their own clusterC(named STOIC). This prevents a problem that came up when librariesBand other object modules (such as FORTRAN subroutines) were linkedBwith STOIC: the alien code would appear in STOIC's image sections,Econfusing the image creation routine. With the STOIC code in its owncluster, this does not happen. -Jonathan MarkE8. The efficiency improvement to IMMEDIATE mode suggested in note 6,Fabove has nom been implemented. I.e., IMMEDIATE mode is now much more?efficient when inserting text at the end of a line or insertingBnew lines of text. When inserting text into the middle of a line,CIMMEDIATE mode is as (in)efficient as ever, due to the fact that it=must refresh the rest of the line after each character typed. -Roger Hauck*[SAOSTOIC]ASSIGN.COM;13+,./A 4%"- 0123K56`+՞C7@U՞C89GAHJ#$ PREFIX := 'F$LOGICAL("SYS$DISK")'#$ PREFIX := 'PREFIX''F$DIRECTORY()'$ LM1 = 'F$LENGTH(PREFIX)' - 1%$ PREFIX := 'F$EXTRACT(0,LM1,PREFIX)'$$ ASSIGN 'PREFIX'.KERNEL] SAO$KERNEL#$ ASSIGN 'PREFIX'.STOIC] SAO$STOIC!$ ASSIGN 'PREFIX'.RED] SAO$RED$ STOIC :== $SAO$STOIC:STOIC*[SAOSTOIC]COMPILE.COM;1+,2./A 47F- 0123K56 s7y!s89GAHJ$ SET DEF SAO$STOIC$ TYPE SYS$INPUT!Loading the STOIC definitions ...7$ @STOIC.CRE !load STOIC input files; create STOIC.EXE$ SET DEF SAO$RED$ TYPE SYS$INPUTLoading RED ... $ @RED.CRE$ TYPE SYS$INPUT/Finished; current default directory is SAO$RED.6To create the INFOTON version now, type "@ORANGE.CRE".*[SAOSTOIC]KERNEL.DIR;1+, ./A 4- 0123 K56@us7s89GAHJI CONTROLC.OBJCRTL.OBJ DTINIT.OBJ EXTEND.OBJ KERLINK.COM RKERNEL.MAP- RKERNEL.OBJ RKERNEL.OPTRMS.OBJSS.OBJTTIO.OBJTYIO.OBJ*[SAOSTOIC.KERNEL]CONTROLC.OBJ;2+,./A 4- 0123K56Q/7@b/89GAHJ3CONTROLC02 5-APR-1984 09:42 VAX-11 Macro V03-00/LIS CONTROLC): generalized CTRL-C interrupt handlerY LIB$SIGNAL SYS$ASSIGN SYS$DASSGN SYS$GETCHNSYS$QIOW SYS$TRNLOG . ABS . . BLANK .P$ABS$ PP ABSKERNEL"PSYS$COMMANDQ Q    ENABLE_CTRL_C&ЬSЬO^^RQP}P?bb?b SYS$TRNLOGP P LIB$SIGNAL둢b|~?cb SYS$ASSIGNP P LIB$SIGNAL\|~^R^~~~?7T >89GAHJ@$ link/map=rkernel.map/notrace rkernel/options ! link the kernel=$ copy rkernel.exe head0.exe ! copy to the header prototype*[SAOSTOIC.KERNEL]RKERNEL.MAP;1+,-./A 4- 0123K56s7 s89GAHJ. RKERNEL 17-JAN-1985 17:04 VAX-11 Linker V03-05 Page 1G +------------------------+G ! Object Module Synopsis !G +------------------------+lModule Name Ident Bytes File Creation Date Creatorl----------- ----- ----- ----- ------------- -------uDTINIT 0 65 D:[SAOSTOIC.KERNEL]DTINIT.OBJ;4 5-APR-1984 09:42 VAX-11 Macro V03-00uCRTL 0 954 D:[SAOSTOIC.KERNEL]CRTL.OBJ;2 5-APR-1984 09:42 VAX-11 Macro V03-00uCONTROLC 02 250 D:[SAOSTOIC.KERNEL]CONTROLC.OBJ;2 5-APR-1984 09:42 VAX-11 Macro V03-00uSYSTEM 0 2361 D:[SAOSTOIC.KERNEL]SS.OBJ;3 5-APR-1984 09:43 VAX-11 Macro V03-00uRMS 0 2293 D:[SAOSTOIC.KERNEL]RMS.OBJ;2 5-APR-1984 09:44 VAX-11 Macro V03-00uTYIO 01 1087 D:[SAOSTOIC.KERNEL]TYIO.OBJ;2 5-APR-1984 09:46 VAX-11 Macro V03-00uTERMINAL 0 1105 D:[SAOSTOIC.KERNEL]TTIO.OBJ;2 5-APR-1984 09:47 VAX-11 Macro V03-00uKERNEL 0 9457 D:[SAOSTOIC.KERNEL]RKERNEL.OBJ;3 5-APR-1984 09:48 VAX-11 Macro V03-00uEXTEND 0 176640 D:[SAOSTOIC.KERNEL]EXTEND.OBJ;2 5-APR-1984 09:53 VAX-11 Macro V03-00H +--------------------------+H ! Program Section Synopsis !H +--------------------------+kPsect Name Module Name Base End Length Align Attributesk---------- ----------- ---- --- ------ ----- ----------DATINIT 00000200 0000F690 0000F491 ( 62609.) PAGE 9 NOPIC,USR,CON,REL,LCL, SHR, EXE, RD, WRT,NOVECP DTINIT 00000200 00000201 00000002 ( 2.) BYTE 0P CRTL 00000202 0000020D 0000000C ( 12.) BYTE 0P SYSTEM 0000020E 00000229 0000001C ( 28.) BYTE 0P RMS 0000022A 00000309 000000E0 ( 224.) BYTE 0P TYIO 0000030A 00000385 0000007C ( 124.) BYTE 0P KERNEL 00000386 00000690 0000030B ( 779.) BYTE 0P EXTEND 00000691 0000F690 0000F000 ( 61440.) BYTE 0DICTIONARY 0000F800 0001FB05 00010306 ( 66310.) PAGE 9 NOPIC,USR,CON,REL,LCL, SHR, EXE, RD, WRT,NOVECP CRTL 0000F800 0000FA66 00000267 ( 615.) BYTE 0P SYSTEM 0000FA67 00010107 000006A1 ( 1697.) BYTE 0P TERMINAL 00010108 0001047F 00000378 ( 888.) BYTE 0P KERNEL 00010480 00011705 00001286 ( 4742.) BYTE 0P EXTEND 00011706 0001FB05 0000E400 ( 58368.) BYTE 0KERNEL 0001FC00 0002FB0C 0000FF0D ( 65293.) PAGE 9 NOPIC,USR,CON,REL,LCL, SHR, EXE, RD, WRT,NOVECP DTINIT 0001FC00 0001FC3E 0000003F ( 63.) BYTE 0P CRTL 0001FC3F 0001FD85 00000147 ( 327.) BYTE 0P CONTROLC 0001FD86 0001FE7F 000000FA ( 250.) BYTE 0P SYSTEM 0001FE80 000200FB 0000027C ( 636.) BYTE 0P RMS 000200FC 00020910 00000815 ( 2069.) BYTE 0P TYIO 00020911 00020CD3 000003C3 ( 963.) BYTE 0P TERMINAL 00020CD4 00020DAC 000000D9 ( 217.) BYTE 0P KERNEL 00020DAD 00021D0C 00000F60 ( 3936.) BYTE 0P EXTEND 00021D0D 0002FB0C 0000DE00 ( 56832.) BYTE 0C +-----------------+C ! Symbols By Name !C +-----------------+~Symbol Value Symbol Value Symbol Value Symbol Value~------ ----- ------ ----- ------ ----- ------ -----.D FFFF8118 ABORT FFFF807C ASSEMBLER FFFF803C B_GLOBAL FFFF80D0 .M FFFF811C ADDRESS_STORAGE FFFF8000 BLK_CHAN FFFF8128 B_KERNEL FFFF80CC  D:[SAOSTOIC.KERNEL]RKERNEL.EXE;1 17-JAN-1985 17:04 VAX-11 Linker V03-05 Page 2~Symbol Value Symbol Value Symbol Value Symbol Value~------ ----- ------ ----- ------ ----- ------ -----CHANNEL_LIST FFFF8134 JUMP_TO_ME 00000000 TTIO_TTIO 00010469-R _MAPOPEN 000201E1-R CHANNEL_PROT 000002EA-R K_END 0002FB0D-R TTNAME FFFF813C _NAME 0000032F-R CHECK FFFF8068 K_START 0001FC00-R TTNAME0 0000030A-R _OPEN 0002019C-R CMDDESC FFFF8138 LAST_GLOBAL 000116F1-R TYINAME 00020FD7-R _PROMPT 000203DC-R CODE_0 FFFF80B8 LAST_KERNEL 000116ED-R TYIODATA 0000030A-R _PUT 0002030F-R CODE_PNTR FFFF80A0 LINE_BUFFER FFFF80F4 TYIOSIZE 00000001 _RANDOGET 000203EC-R COMPILE FFFF8054 LITERAL FFFF8070 TYOADDR FFFF812C _RANDOPUT 00020413-R COMPILE_BYTE 00000008 LOOKUP FFFF8050 TYONAME 00020FE2-R _RCREATE 000201C5-R COMPILE_ERROR FFFF8088 LOOKUP_DISPATCH 00000679-R TYPEADDR FFFF8130 _READ 00020327-R COMP_BUF_0 FFFF8058 L_STACK_0 FFFF8024 USER_CODE FFFF80B0 _REMSTART 00020B18-R COMP_BUF_PNTR FFFF805C MSG_CHANNEL FFFF8120 USER_DATA FFFF80C4 _REMTYPE 00020CAB-R COND_CODE FFFF8084 NADDR FFFF814C USER_DICTIONARY FFFF80AC _RMSTYO 000208F7-R COND_HANDLER FFFF8008 NLEN FFFF8148 USER_INIT FFFF80E4 _RMSTYPE 000208E6-R CONSIZE 0000000B NSTORE FFFF8150 UT_END 00000691-R _ROPEN 000201BC-R CONSOLE 000200FC-R OUTINIT 00020968-R UT_START 000004F9-R _SAVE 000207CF-R CRTLGLOB 0000FA53-R OUT_CONV_STACK FFFF8038 U_CBP FFFF805C _SETMODE 00020AF5-R CRTL_CRTL 0000FA4F-R PROMPT FFFF80DC U_FLOAT FFFF8110 _TYI 000209DC-R CTRL_C_FLAG FFFF8014 PROMPT0 0000049A-R U_IFI FFFF80E8 _TYO 00020A6A-R CTRL_C_HANDLER FFFF8018 PROTO_FAB 0000026E-R U_IFM FFFF80EC _TYOPEN 00020911-R CTRL_C_TEMP FFFF800C PROTO_RAB 0000022A-R U_IFT FFFF80F0 _TYPE 00020A95-R CURRENT FFFF80D4 PROTO_XAB 000002BE-R U_MAG FFFF8108 _TYPE_GETLINE 00020A03-R DATA_0 FFFF80BC PUSH_THIS_WORD 0000000C U_RAD FFFF8114 _TYPE_TYI 00020A3B-R DATA_END FFFF80C0 PUSH_VOCAB 00000010 U_SGN FFFF8104 _WOPEN 0002020E-R DATE FFFF808C P_STACK_0 FFFF801C VARIABLE_LIST FFFF80C8 _WOPEN_FTN 00020255-R DATE_ERROR FFFF8094 RABLEN 00000044 VOCAB_SP FFFF8034 _WOPEN_NCR 00020232-R DAT_END 00000691-R RANDOCHAN FFFF8124 V_STACK_0 FFFF802C _WRITE 0002036B-R DAT_FIN 0000F691-R RDTERM 0000036E-R WORD_BUFFER FFFF8100 _WRTBLK 00020610-R DAT_START 00000200-R READLINE FFFF8078 XABLEN 0000002C _XLOAD 00020675-R iDICT_0 FFFF80B4 REST_OF_LINE FFFF80F8 _APPEND 00020276-R 0iDICT_BASE FFFF80A8 RMAST 00020C34-R _CLOSE 000202A1-R iDICT_END 0001FB06-R RMBUF FFFF817C _DO_MAPOPEN 000201EB-R BiDICT_PNTR FFFF80A4 RMICHAN FFFF815C _ERASE 00020185-R EiDICT_START 0000F800-R RMINAME FFFF8154 _FCLOSE 0002057A-R :iDISABLE_CTRL_C 0001FE66-R RMOCHAN FFFF8170 _FCREATE 00020477-R iDISPATCH_ADR FFFF804C RMONAME FFFF8168 _FGET 00020534-R iDISP_TO_R11 00000014 RMSDATA 0000022A-R _FIL_EBK 00020137-R aiENABLE_CTRL_C 0001FD92-R R_STACK_0 FFFF8020 _FIL_FFB 00020146-R eiEND_OF_CMND FFFF8060 SSBYTE 0000001C _FIL_FSZ 00020155-R -iEND_OF_LINE FFFF8064 SSDATA 0000020E-R _FIL_MRS 0002015D-R IiENTER FFFF809C SSGLOB 000100F8-R _FIL_RAT 0002016D-R EiERRCHK FFFF8074 SSSIZE 00000001 _FIL_RFM 00020165-R iERROR_PC FFFF8080 SS_CALLS 000200F8-R _FOPEN 00020442-R iEXECUTE FFFF806C SS_KERNEL 000100F4-R _FPUT 00020562-R 0iFABLEN 00000050 START 00020DAE-RU _FREAD 000204AC-R iFLOAT FFFF8048 STOIC FFFF8040 _FWRITE 000204F0-R iFLOAT_TO_STRING 0001FC40-R STRING_TO_FLOAT 0001FC4E-R _GET 000202E1-R 1iFRAME_0 FFFF8030 SYSERR 000211A4-R _GETBLK 000205ED-R iF_STACK_0 FFFF8028 TIME_STRING FFFF8098 _GETFAB 0002011A-R 0iGET_BLOCK 0001FC00-R TTCHAN FFFF8140 _GETMODE 00020AD2-R 0iGLOBAL FFFF80D8 TTCHAN0 0000031D-R _IO_CTRL_C 00020AC0-R iHERE_ON_CTRL_C 00021A7E-R TTIO FFFF8044 _MAKBLK 000205AC-R iIMMEDIATE 00000004 TTIOGLOB 0001046D-R _MAPCLOSE 000202C9-R  D:[SAOSTOIC.KERNEL]RKERNEL.EXE;1 0H|~ REDBUILD.BAK- [SAOSTOIC.KERNEL]RKERNEL.MAP;1 17-JAN-1985 17:04 VAX-11 Linker V03-05 Page 30~Symbol Value Symbol Value Symbol Value Symbol Value~------ ----- ------ ----- ------ ----- ------ -----$ Key for special characters above: +------------------+ ! * - Undefined ! ! U - Universal ! ! R - Relocatable ! ! X - External ! +------------------+ 0D:[SAOSTOIC.KERNEL]RKERNEL.EXE;1 17-JAN-1985 17:04 VAX-11 Linker V03-05 Page 4 C +----------------+ C ! Image Synopsis ! C +----------------+ hVirtual memory allocated: 00000200 0002FDFF 0002FC00 (195584. bytes, 382. pages)AStack size: 20. pages TImage header virtual block limits: 1. 1. ( 1. block)UImage binary virtual block limits: 2. 37. ( 36. blocks) ;Image name and identification: RKERNEL 0 ;Number of files: 13.8;Number of modules: 13.L;Number of program sections: 13.0;Number of global symbols: 855.b;Number of image sections: 14. :User transfer address: 00020DAE;Number of code references to shareable images: 28. =Image type: EXECUTABLE.-bMap format: DEFAULT in file D:[SAOSTOIC.KERNEL]RKERNEL.MAP;1<Estimated map length: 76. blocksE +---------------------+ E ! Link Run Statistics ! E +---------------------+_SPerformance Indicators Page Faults CPU Time Elapsed Time-S---------------------- ----------- -------- ------------ U Command processing: 51 00:00:00.47 00:00:02.02 U Pass 1: 201 00:00:02.40 00:00:21.04FU Allocation/Relocation: 28 00:00:00.06 00:00:00.69 U Pass 2: 66 00:00:03.76 00:00:26.90 U Map data after object module synopsis: 21 00:00:00.47 00:00:01.22 U Symbol table output: 2 00:00:00.00 00:00:01.09PUTotal run values: 369 00:00:07.16 00:00:52.961XUsing a working set limited to 500 pages and 320 pages of data storage (excluding image)6Total number object records read (both passes): 1078X of which 53 were in libraries and 182 were DEBUG data records containing 75350 bytes6Number of modules extracted explicitly = 01 with 2 extracted to resolve undefined symbolsR?0 library searches were for symbols not in the library searchedM4A total of 0 global symbol table records was written(/MAP=RKERNEL.MAP/NOTRACE RKERNEL/OPTIONSNIT FFFF80E4 _RMSTYPE 000208E6-R CONSIZE 0000000B NSTORE FFF*[SAOSTOIC.KERNEL]RKERNEL.OBJ;3+,.h/A 4hhR- 0123K56 ƁW07E189GAHJl0KERNEL0 5-APR-1984 09:48 VAX-11 Macro V03-00/LIS RKERNELfor SAO VAX/VMS STOIC.D.M|ABORTADDRESS_STORAGE< ASSEMBLER(BLK_CHANЀB_GLOBAL̀B_KERNEL4 CHANNEL_LIST CHANNEL_PROThCHECK8CMDDESCCODE_0 CODE_PNTRTCOMPILE COMPILE_BYTE COMPILE_ERRORX COMP_BUF_0\ COMP_BUF_PNTR COND_CODE COND_HANDLERCONSIZECONSOLE CRTL_CRTL CTRL_C_FLAGCTRL_C_HANDLER CTRL_C_TEMPԀCURRENTDATA_0DATA_ENDDATE DATE_ERROR  DAT_ENDDAT_FIN DAT_STARTDICT_0 DICT_BASEDICT_END DICT_PNTR DICT_STARTL DISPATCH_ADR DISP_TO_R11 ENABLE_CTRL_C` END_OF_CMNDd END_OF_LINEENTERtERRCHKERROR_PClEXECUTEFABLENHFLOAT0FRAME_0( F_STACK_0 GET_BLOCK؀GLOBAL IMMEDIATE JUMP_TO_MEK_ENDK_START q LAST_GLOBAL m LAST_KERNEL LIB$SIGNALLIB$SIG_TO_RETLIB$STOP LINE_BUFFERpLITERALPLOOKUP LOOKUP_DISPATCH$ L_STACK_0 MSG_CHANNELLNADDRHNLENPNSTOREOUTINIT8OUT_CONV_STACK܀PROMPT PROMPT0 PROTO_FAB PROTO_RAB PROTO_XAB PUSH_THIS_WORD PUSH_VOCAB P_STACK_0RABLEN$ RANDOCHANxREADLINE REST_OF_LINE|RMBUF\RMICHANTRMINAMEpRMOCHANhRMONAMERMSDATA R_STACK_0 SS$_RESIGNALSSBYTESSDATASSSIZESS_CALLS SS_KERNEL@STOICSTRING_TO_FLOAT SYS$ASCTIM SYS$CRETVA SYS$DELTVA SYS$UNWIND SYSERR TIME_STRING@TTCHANTTCHAN0DTTIOTTIOGLOB TTIO_TTIO<TTNAMETTNAME0 *TYINAMETYIODATATYIOSIZE,TYOADDR 5TYONAME0TYPEADDR USER_CODEĀ USER_DATAUSER_DICTIONARY USER_INIT  UT_END sUT_START\U_CBPU_FLOATU_IFIU_IFMU_IFTU_MAGU_RADU_SGNȀ VARIABLE_LIST4VOCAB_SP, V_STACK_0 WORD_BUFFERXABLEN_APPEND_CLOSE_ERASE_FCLOSE_FCREATE_FGET_FIL_EBK_FIL_FFB_FIL_FSZ_FIL_MRS_FIL_RAT_FIL_RFM_FOPEN_FPUT_FREAD_FWRITE_GET_GETMODE _IO_CTRL_C _MAPCLOSE_MAPOPEN_NAME_OPEN_PROMPT_PUT _RANDOGET _RANDOPUT_RCREATE_READ _REMSTART_REMTYPE_RMSTYO_RMSTYPE_ROPEN_SAVE_SETMODE|_TYI_TYO_TYPE _TYPE_GETLINE _TYPE_TYI_WOPEN _WOPEN_FTN _WOPEN_NCR_WRITE_XLOAD . ABS . . BLANK .P$ABS$ PPP`KERNELP DICTIONARYwP SS_KERNEL DICT_START44TTIOGLOB DICT_START44NULLQQ%K_START44&PP START&P RP RP RP RP QFABLEN5RABLEN53XABLEN53463P s DAT_START433R[VQSS(RABLENFABLEN3& PROTO_RABcPP  DICT_START44 DICT_START44ACQQ%Q>K_START44&>Pz%z/PQSP/P DICT_START44# DICT_START44LOOKUP_ATTRIBUTEQQ%QSK_START44&SPԀPPQPQzMPQfPMP/ DICT_START443 DICT_START44I_LOOKUPQQ%QfK_START44&fP}TV4VV,ІzzЎV}TzzЎVcPQ)Pкjjj zjcPQGPcPM DICT_START44Q DICT_START44MATCHQQ%QK_START44&PjQPPT )PaezzvPQPvPc DICT_START44g DICT_START44I_JUMP_TO_MEQ Q %QK_START44&P\PȀXjP\PQPPv DICT_START44z DICT_START44I_COMPILE_BYTEQQ%QK_START44&P\\PQ PP DICT_START44 DICT_START44I_PUSH_THIS_WDQQ%QK_START44&P\PЀЊzP\PQPP DICT_START44 DICT_START44I_DISP_TO_R11Q Q %QK_START44&P\PހˀzP\PQPP DICT_START44 DICT_START44QQ%QEK_START44&PЎQ\S(acS\aPQ1P DATINITPQQQQQQQ 0> QQQ Q(2PP DICT_START44 DICT_START44PREOPENQQ%Q2K_START44&2PЊPz֪֪PzPQHPP DICT_START44 DICT_START44SETUP_FABSQ Q %QHK_START44&HP4PȏDР PwPb DICT_START44f DICT_START44WORDQQ%Q> K_START44&> P}P}PR; Pa; Pa; PaPR;"PaPR :"Pa;"Pa&;%PaPR :%Pa;%Pa: Pa}PT: RcPT}TP}PPRzTRTzRz(RcdzPQu PPw DICT_START44{ DICT_START44COUNTQQ%Q K_START44& P<zPQ  PP DICT_START44 DICT_START44TYPEQQ%Q K_START44& P0PQ PP DICT_START44 DICT_START44RMSTYPEQQ%Q K_START44& P_RMSTYPEPQ PP DICT_START44 DICT_START44QIOTYPEQQ%Q K_START44& P_TYPEPQ PP DICT_START44 DICT_START44MSGQQ%Q K_START44& PPQ PP DICT_START44 DICT_START44TYIQQ%Q K_START44& P_TYIPQ  PP DICT_START44 DICT_START44TYPE_GETLINEQ Q %Q K_START44& P _TYPE_GETLINE PQ  PP DICT_START44 DICT_START44TYPE_TYIQQ%Q K_START44& P _TYPE_TYI*PQ  P*P DICT_START44 DICT_START44TYOQQ%Q K_START44& P,;P* DICT_START44. DICT_START44RMSTYOQQ%Q K_START44& P_RMSTYOOPQ POP; DICT_START44? DICT_START44QIOTYOQQ%Q K_START44& P_TYOcPQ PcPO DICT_START44S DICT_START44IO_CTRL_CQ Q %Q K_START44& P _IO_CTRL_CzPQ PzPc DICT_START44g DICT_START44GETMODEQQ%Q K_START44& P_GETMODEPQ  PPz DICT_START44~ DICT_START44SETMODEQQ%Q K_START44& P_SETMODEPQ & PP DICT_START44 DICT_START44CRQQ%Q& K_START44&& P z zPQ 3 PP DICT_START44 DICT_START44SPACEQQ%Q3 K_START44&3 P zPQ: PP DICT_START44 DICT_START44=QQ%Q: K_START44&: PTYUЊSQSPSP{TPPRR 0Ru7RuPS-uUzUYz@PQC} PP DICT_START44 DICT_START44SHOW_TIMEQ Q %Q} K_START44&} Pjժ+ SYS$ASCTIMP PLIB$STOP}z0 Zz0PQBM PTPT3Q P   ENABLE_CTRL_C  HERE_ON_CTRL_C&ЬV V[P`P DICT_START44 DICT_START44I_CTRL_C_HNDLRQQ%Q K_START44& P]PѠ   Р P PQ P P DICT_START44 DICT_START44OCONSTACKQ Q %Q K_START44& P8z PQ P P DICT_START44 DICT_START44CONSTANTQQ%Q K_START44& Pz %zPЊP6 PQ' P6 P DICT_START44$ DICT_START44DATA_ADDRESSQ Q %Q' K_START44&' Pz%zP[PP PQA PP P6 DICT_START44: DICT_START44SYSTEM_SERVICESQQ%QA K_START44&A PSS_CALLSzm PQI Pm PP DICT_START44T DICT_START44MOATQQ%QI K_START44&I PÏz PQ T P Pm DICT_START44q DICT_START44P_STACKQQ%QT K_START44&T Pz PQZ P P DICT_START44 DICT_START44L_STACKQQ%QZ K_START44&Z P$z PQ` P P DICT_START44 DICT_START44F_STACKQQ%Q` K_START44&` P(z P DICT_START44 DICT_START44V_STACKQQ%Qf K_START44&f P,z PQl P P DICT_START44 DICT_START44B,QQ%Ql K_START44&l PPP PQz P P DICT_START44 DICT_START44,QQ%Qz K_START44&z PPЊP PQ P P DICT_START44 DICT_START44ISOLATE_BLOCKQ Q %Q K_START44& P GET_BLOCK PQ P P DICT_START44 DICT_START44BRANCHQQ%Q K_START44& Pz%z! PQ P! P DICT_START44 DICT_START44I_PUSH_VOCABQ Q %Q K_START44& PH z; PQ P; P! DICT_START44% DICT_START44V_PUSHQQ%Q K_START44& P4PЊpP4O PQ PO P; DICT_START44? DICT_START44>QQ%Q K_START44& P4^ PQ P^ PO DICT_START44S DICT_START44DEFINITIONSQ Q %Q K_START44& P4Ԁw PQ Pw P^ DICT_START44b DICT_START44ASSEMBLERACADDRESS_STORAGE ALPH  APPEND< ASSEMBLER  ASSEMBLER_LA l BCOMMA(BLK_CHAN  BRANCH BRANCH_EMPTYЀB_GLOBAL̀B_KERNEL =CEQ4 CHANNEL_LIST hCHECK ; CLOSECLPLACE8CMDDESC CODE_0 CODE_PNTR TCOLON z COMMATCOMPILE COMPILE_BYTE COMPILE_ERRORX COMP_BUF_0COMP_BUF_LENGTH\ COMP_BUF_PNTR COMP_ERR_MSG COMP_ERR_MSG1COMP_LITCOMP_POP COND_CODE COND_HANDLER CONSTANT  COUNT 4CPOP *CPUSH & CR CTRL_C_FLAGCTRL_C_HANDLER  CTRL_C_TEMPԀCURRENT\ CUR_DATE_MSG DATA_0'  DATA_ADDRESSDATA_END DATA_INIT DATE DATE_ERROR; DATE_ERR_MSG DAT_END DEFER_COLON DEFER_SEMI  DEFINITIONS` DICTIONARY DICT_0 DICT_BASEDICT_CUR DICT_PNTR DIGITL DISPATCH_ADR DISP_TO_R11 DONE  ENAB_CTRL_C` END_OF_CMNDd END_OF_LINE ENTER : EQ_SGN ERASE tERRCHKERROR_PClEXECUTE FAB$B_BID> FAB$B_BKS FAB$B_BLN5 FAB$B_DNSJ FAB$B_DSBMSK FAB$B_FAC4 FAB$B_FNS? FAB$B_FSZ FAB$B_ORG FAB$B_RAT FAB$B_RFM FAB$B_RTV FAB$B_SHR FAB$C_BIDP FAB$C_BLN FAB$C_FIX0 FAB$C_HSH  FAB$C_IDX FAB$C_MAXRFM FAB$C_RELFAB$C_RFM_DFLT FAB$C_SEQ FAB$C_STM FAB$C_STMCR FAB$C_STMLF FAB$C_UDF FAB$C_VAR FAB$C_VFCP FAB$K_BLN FAB$L_ALQ FAB$L_CTX@ FAB$L_DEV0 FAB$L_DNA, FAB$L_FNA FAB$L_FOP  FAB$L_JNL8 FAB$L_MRN( FAB$L_NAMD FAB$L_SDC FAB$L_STS  FAB$L_STV$ FAB$L_XAB  FAB$M_BIO FAB$M_BLK@ FAB$M_BRO  FAB$M_CBT FAB$M_CIFFAB$M_CR FAB$M_CTG FAB$M_DEL  FAB$M_DFW FAB$M_DLT FAB$M_DMO FAB$M_ESC FAB$M_EXE FAB$M_FTN FAB$M_GET FAB$M_INP@ FAB$M_JNL@ FAB$M_KFO FAB$M_MSE FAB$M_MXV FAB$M_NAM FAB$M_NEF FAB$M_NFS  FAB$M_NIL  FAB$M_OFP FAB$M_POS FAB$M_PPF@ FAB$M_PPF_IND? FAB$M_PPF_RAT FAB$M_PRN FAB$M_PUT FAB$M_RCK FAB$M_RWC FAB$M_RWO@ FAB$M_SCF FAB$M_SHRDEL FAB$M_SHRGET FAB$M_SHRPUT FAB$M_SHRUPD  FAB$M_SPL@ FAB$M_SQO FAB$M_SUP FAB$M_TEF FAB$M_TMD FAB$M_TMP FAB$M_TRN FAB$M_UFM FAB$M_UFO FAB$M_UPD@ FAB$M_UPI FAB$M_WCK FAB$S_ORG FAB$S_PPF_RAT FAB$V_BIO FAB$V_BLK FAB$V_BRO FAB$V_CBT FAB$V_CIFFAB$V_CR FAB$V_CTG FAB$V_DEL FAB$V_DFW FAB$V_DLT  FAB$V_DMO FAB$V_ESC FAB$V_EXE FAB$V_FTN FAB$V_GET FAB$V_INP FAB$V_JNL FAB$V_KFO FAB$V_MSE FAB$V_MXV FAB$V_NAM  FAB$V_NEF FAB$V_NFS FAB$V_NIL FAB$V_OFP FAB$V_ORG FAB$V_POS FAB$V_PPF FAB$V_PPF_IND FAB$V_PPF_RAT FAB$V_PRN FAB$V_PUT FAB$V_RCK  FAB$V_RWC FAB$V_RWO FAB$V_SCF FAB$V_SHRDEL FAB$V_SHRGET FAB$V_SHRPUT FAB$V_SHRUPD  FAB$V_SPL FAB$V_SQO FAB$V_SUP FAB$V_TEF FAB$V_TMD FAB$V_TMP FAB$V_TRN FAB$V_UFM FAB$V_UFO FAB$V_UPD FAB$V_UPI  FAB$V_WCK< FAB$W_BLS FAB$W_DEQH FAB$W_GBC FAB$W_IFI6 FAB$W_MRSK  FAB_COUNT FATALv FIL_EBK} FIL_FFB FIL_FSZ FIL_MRSo FIL_RAT FIL_RFM HFLOAT FLOAT_LA FOOFOUND_DP FP_STACK_SIZE0FRAME_0` F_STACK( F_STACK_0  GET GETMODE  GET_STRING ؀GLOBALqGLOBLINKJICOMPILEILITERAL IMMEDIATE  INCHs INT_COLON INT_INLINE  IO_CTRL_C  ISOLATE_BLOCKI_ABORT I_COMPILEI_COMPILE_BYTEI_COMPILE_ERRORI_COND_HANDLER I_CTRL_C_HNDLR I_DATE_ERROR I_DISP_TO_R11I_ENTER1I_ERRCHKG I_EXECUTE I_IMMEDIATE I_JUMP_TO_ME I_LINE_BUFFER5 I_LITERALfI_LOOKUPI_PUSH_THIS_WD  I_PUSH_VOCAB  I_READLINET I_TIME_STRING I_USER_INIT I_WORD_BUFFER JUMP_TO_ME  KEND mKERNEL \KPLACE+ LASTINCHq LAST_GLOBALm LAST_KERNEL  LEFT_ANGLE LEN LINE_BUFFER LINE_BUF_SIZEpLITERALSLKP_ATTR 4 LOAD  LOAD_RESET  LOC PLOOKUPLOOKUP_DISPATCH LOOKUP_LOSE LT_LENGTHZ L_STACK$ L_STACK_0 L_STACK_SIZEMAPCLOSEMAPOPEN MATCH I MOAT  MSG  MSG_CHANNEL LNADDR  NEWPROMPT NEXTINCH  NI_ERR HNLENNOMATCH NOT_DIGIT PNSTORE NUME  OCONSTACKOC_PROT PONEADR OPEN OP_ABSOLUTEz OP_AUTO_DEC OP_JSBOP_MOVALOP_MOVL OP_RSB8OUT_CONV_STACK PMTLEN2PREOPEN ܀PROMPTPROMPT0 PUSH_THIS_WORD PUSH_TRUE PUSH_VOCAB  PUTT P_STACK P_STACK_0 P_STACK_SIZE  QIOTYO QIOTYPE RAB$B_BID RAB$B_BLN5 RAB$B_KRF4 RAB$B_KSZ7 RAB$B_MBC6 RAB$B_MBF4 RAB$B_PSZ RAB$B_RAC RAB$B_ROP1 RAB$B_ROP2 RAB$B_ROP3 RAB$B_TMO RAB$C_BIDD RAB$C_BLN RAB$C_KEY RAB$C_RFA RAB$C_SEQ RAB$C_STMD RAB$K_BLN8 RAB$L_BKT RAB$L_CTX8 RAB$L_DCT< RAB$L_FAB0 RAB$L_KBF0 RAB$L_PBF( RAB$L_RBF RAB$L_RFA0, RAB$L_RHB RAB$L_ROP RAB$L_STS  RAB$L_STV$ RAB$L_UBF RAB$M_ASY RAB$M_BIO RAB$M_CCO RAB$M_CVT RAB$M_EOF@ RAB$M_FDL RAB$M_HSH  RAB$M_KGE@ RAB$M_KGT@ RAB$M_LIM  RAB$M_LOA RAB$M_LOC  RAB$M_MAS RAB$M_NLK RAB$M_NXR@ RAB$M_PMT@ RAB$M_PPF_IND? RAB$M_PPF_RAT  RAB$M_PTA RAB$M_RAH RAB$M_REA RAB$M_RLK RAB$M_RNE RAB$M_RNF RAB$M_RRL RAB$M_TMO RAB$M_TPT RAB$M_UIF RAB$M_ULK RAB$M_WAT RAB$M_WBH RAB$S_PPF_RAT RAB$S_RFA RAB$V_ASY  RAB$V_BIO RAB$V_CCO RAB$V_CVT RAB$V_EOF RAB$V_FDL RAB$V_HSH RAB$V_KGE RAB$V_KGT RAB$V_LIM  RAB$V_LOA RAB$V_LOC RAB$V_MAS RAB$V_NLK RAB$V_NXR RAB$V_PMT RAB$V_PPF_IND RAB$V_PPF_RAT RAB$V_PTA  RAB$V_RAH RAB$V_REA RAB$V_RLK RAB$V_RNE RAB$V_RNF RAB$V_RRL RAB$V_TMO RAB$V_TPT RAB$V_UIF RAB$V_ULK RAB$V_WAT  RAB$V_WBH RAB$W_ISI RAB$W_RFA RAB$W_RFA4" RAB$W_RSZ  RAB$W_STV0 RAB$W_STV2  RAB$W_USZW  RAB_COUNT$ RANDOCHAN RANDOGET RANDOPUT  READxREADLINE( REMSTART3 REMTYPEvRESET_REGISTERS REST_OF_LINE |RMBUF\RMICHANTRMINAMEpRMOCHANhRMONAMERMS$V_STVSTATUSRMS$_ABORMS$_ACCRMS$_ACSZRMS$_ACTRMS$_AIDRMS$_ALNRMS$_ALQ RMS$_ANIRMS$_AOPRMS$_ATRRMS$_ATWRMS$_BESRMS$_BKS$RMS$_BKZ,RMS$_BLNRMS$_BOF4RMS$_BUGD RMS$_BUG_DAP< RMS$_BUG_DDIL RMS$_BUG_XX2T RMS$_BUG_XX3\ RMS$_BUG_XX4d RMS$_BUG_XX5l RMS$_BUG_XX6t RMS$_BUG_XX7| RMS$_BUG_XX8 RMS$_BUG_XX9RMS$_CAARMS$_CCFRMS$_CCRRMS$_CDARMS$_CHGRMS$_CHKRMS$_CHNRMS$_CODQ RMS$_CONTROLC  RMS$_CONTROLO RMS$_CONTROLYRMS$_CRC RMS$_CRE RMS$_CREATEDi RMS$_CRE_STML RMS$_CRMPRMS$_CURRMS$_DACRMS$_DANԇ RMS$_DEADLOCKbRMS$_DELĄRMS$_DEVlRMS$_DFL̄RMS$_DIRԄRMS$_DME܄RMS$_DNAJRMS$_DNFrRMS$_DNR:RMS$_DPERMS$_DTPRMS$_DUPRMS$_DVI4RMS$_ENQRMS$_ENT$RMS$_ENVzRMS$_EOFRMS$_ESARMS$_ESLRMS$_ESS܇ RMS$_EXENQLM‚RMS$_EXP"RMS$_EXT RMS$_FABRMS$_FACRMS$_FEXRMS$_FLGRMS$_FLK$RMS$_FNA*RMS$_FNDRMS$_FNF,RMS$_FNM<RMS$_FOP4RMS$_FSZćRMS$_FTMDRMS$_FUL̇RMS$_GBCLRMS$_IALTRMS$_IANTRMS$_IBF|RMS$_IBKRMS$_IDR\RMS$_IDX$RMS$_IFAdRMS$_IFIdRMS$_IFLlRMS$_IMXtRMS$_IOP|RMS$_IRCRMS$_ISIRMS$_KBFRMS$_KEY1RMS$_KFFtRMS$_KNMRMS$_KRFRMS$_KSIRMS$_KSZRMS$_LANRMS$_LBLRMS$_LEXRMS$_LNEąRMS$_LOC4RMS$_MBC2RMS$_MKD̅RMS$_MRNԅRMS$_MRS܅RMS$_NAMRMS$_NEFLRMS$_NET< RMS$_NETFAILRMS$_NIDʂRMS$_NMFRMS$_NOD RMS$_NORMALRMS$_NPK9 RMS$_OK_ALKA RMS$_OK_DEL RMS$_OK_DUP RMS$_OK_IDXQ RMS$_OK_LIMY RMS$_OK_NOP! RMS$_OK_RLKI RMS$_OK_RNF) RMS$_OK_RRLa RMS$_OK_WATRMS$_ORD RMS$_ORGRMS$_PBF  RMS$_PENDINGȁRMS$_PESRMS$_PLG,RMS$_PLV$RMS$_POS,RMS$_PRMRMS$_PRV4RMS$_QUO<RMS$_RABDRMS$_RACLRMS$_RATTRMS$_RBF\RMS$_REFRMS$_RERRMS$_REX\RMS$_RFAdRMS$_RFMlRMS$_RHBtRMS$_RLFRMS$_RLKRMS$_RMVRMS$_RNFRMS$_RNL|RMS$_ROPRMS$_RPLRMS$_RRVڂRMS$_RSA<RMS$_RSLRMS$_RSSRMS$_RSTRMS$_RSZRMS$_RTBRMS$_RVURMS$_SEGRMS$_SEQRMS$_SHRRMS$_SIZRMS$_SNERMS$_SPEBRMS$_SPLĆRMS$_SQO RMS$_STALL̆RMS$_STKRMS$_STRRMS$_SUC҂RMS$_SUP1RMS$_SUPERSEDED RMS$_SUPPORTԆRMS$_SYN RMS$_SYSj RMS$_TEMP1RMS$_TMORMS$_TNS܆RMS$_TRERMS$_TYPRMS$_UBFRMS$_UPIRMS$_USZRMS$_VERRMS$_VOL,RMS$_WBERMS$_WCCRMS$_WERDRMS$_WLDRMS$_WLKRMS$_WPLRMS$_WSF RMS$_XAB  RMSTYO RMSTYPE  ROPEN RUN_SLITERAL  R_STACK_0 < SAVEr SAVE_DATE_MSGSCOMPILE  SEMIF SEMI_COLON SETMODEH SETUP_FABS}  SHOW_TIME SIGNSLITERAL 3 SPACE @STOIC STOIC_LA SYNTAX_ERROR SYNTAX_MSG SYSERRA SYSTEM_SERVICES TABLE_OFFSET TIME_KERNEL TIME_STRING_TOP_LOOP TRY_BRANCH @TTCHAN DTTIO TTIO_LA <TTNAME  TYI*TYINAME  TYO,TYOADDR5TYONAME  TYPE0TYPEADDR  TYPE_GETLINE TYPE_TYI UNDEF_MSG USER_CODEĀ USER_DATAUSER_DICTIONARY USER_INIT  UT_ENDsUT_START \U_CBPU_FLOAT U_IFI U_IFM U_IFT U_MAG U_RAD U_SGNȀ VAR IABLE_LIST4VOCAB_SP  V_PUSHf V_STACK, V_STACK_0 V_STACK_SIZEAWELCOME  WOPEN > WORD WORD_BUFFER WORD_DISP  WRITEc  XAB_COUNT & XLOADX . BLANK .KERNEL` DICTIONARYDATINIT *[SAOSTOIC.KERNEL]RKERNEL.OPT;2+,./A 4GD- 0123K56"L7U"L89GAHJGCLUSTER=STOIC,,,SAO$KERNEL:DTINIT,SAO$KERNEL:CRTL,SAO$KERNEL:CONTROLC,-? SAO$KERNEL:SS,SAO$KERNEL:RMS,SAO$KERNEL:TYIO,SAO$KERNEL:TTIO,-% SAO$KERNEL:RKERNEL,SAO$KERNEL:EXTENDUNIVERSAL=STARTPSECT_ATTR=KERNEL,WRT,SHR,PAGEPSECT_ATTR=DATINIT,WRT,SHR,PAGE"PSECT_ATTR=DICTIONARY,WRT,SHR,PAGEIOSEGMENT=128,NOP0BUFS*[SAOSTOIC.KERNEL]RMS.OBJ;2+,.!/A 4!!V- 0123K56@/7Q089GAHJ-RMS0 5-APR-1984 09:44 VAX-11 Macro V03-00 /LIS RMSdriver for SAO VAX/VMS STOIC.D.MADDRESS_STORAGE CHANNEL_LIST  CHANNEL_PROT CODE_PNTR CONSIZE CONSOLEDATE DATE_ERRORDAT_END DICT_PNTRPFABLENLIB$STOP MSG_CHANNELOUTINIT D PROTO_FAB  PROTO_RAB  PROTO_XABDRABLEN RANDOCHAN RMSDATA SYS$CLOSE SYS$CONNECT SYS$CREATE SYS$DASSGNSYS$DISCONNECT SYS$ERASE SYS$EXPREGSYS$FINDSYS$GETSYS$OPENSYS$PUTSYS$READ SYS$UPDATE SYS$WRITESYSERR USER_CODE USER_DATAUSER_DICTIONARYUT_STARTU_IFIVOCAB_SP,XABLEN z_APPEND _CLOSE  _DO_MAPOPEN _ERASE ~_FCLOSE {_FCREATE 8_FGET ;_FIL_EBK J_FIL_FFB Y_FIL_FSZ a_FIL_MRS q_FIL_RAT i_FIL_RFM F_FOPEN f_FPUT _FREAD _FWRITE _GET _GETBLK _GETFAB _MAKBLK  _MAPCLOSE _MAPOPEN _OPEN _PROMPT _PUT  _RANDOGET  _RANDOPUT _RCREATE +_READ _RMSTYO _RMSTYPE _ROPEN _SAVE _WOPEN Y _WOPEN_FTN 6 _WOPEN_NCR o_WRITE _WRTBLK y_XLOAD . ABS . . BLANK .P$ABS$ PPPDATINITPDQBQQQQPQNQQQPP,Q*QQ$KERNELPsys$commandЊR CHANNEL_LISTBRТ FAB$B_BKS FAB$B_BLN5 FAB$B_DNSJ FAB$B_DSBMSK FAB$B_FAC4 FAB$B_FNS? FAB~ REDBUILD.BAK [SAOSTOIC.KERNEL]RMS.OBJ;2!L. $B_FSZ FAB$B_ORG FAB$B_RAT FAB$B_RFM FAB$B_RTV FAB$B_SHR FAB$C_BIDP FAB$C_BLN FAB$C_FIX0 FAB$C_HSH  FAB$C_IDX FAB$C_MAXRFM FAB$C_RELFAB$C_RFM_DFLT FAB$C_SEQ FAB$C_STM FAB$C_STMCR FAB$C_STMLF FAB$C_UDF FAB$C_VAR FAB$C_VFCP FAB$K_BLN FAB$L_ALQ FAB$L_CTX@ FAB$L_DEV0 FAB$L_DNA, FAB$L_FNA FAB$L_FOP  FAB$L_JNL8 FAB$L_MRN( FAB$L_NAMD FAB$L_SDC FAB$L_STS  FAB$L_STV$ FAB$L_XAB  FAB$M_BIO FAB$M_BLK@ FAB$M_BRO  FAB$M_CBT FAB$M_CIFFAB$M_CR FAB$M_CTG FAB$M_DEL  FAB$M_DFW FAB$M_DLT FAB$M_DMO FAB$M_ESC FAB$M_EXE FAB$M_FTN FAB$M_GET FAB$M_INP@ FAB$M_JNL@ FAB$M_KFO FAB$M_MSE FAB$M_MXV FAB$M_NAM FAB$M_NEF FAB$M_NFS  FAB$M_NIL  FAB$M_OFP FAB$M_POS FAB$M_PPF@ FAB$M_PPF_IND? FAB$M_PPF_RAT FAB$M_PRN FAB$M_PUT FAB$M_RCK FAB$M_RWC FAB$M_RWO@ FAB$M_SCF FAB$M_SHRDEL FAB$M_SHRGET FAB$M_SHRPUT FAB$M_SHRUPD  FAB$M_SPL@ FAB$M_SQO FAB$M_SUP FAB$M_TEF FAB$M_TMD FAB$M_TMP FAB$M_TRN FAB$M_UFM FAB$M_UFO FAB$M_UPD@ FAB$M_UPI FAB$M_WCK FAB$S_ORG FAB$S_PPF_RAT FAB$V_BIO FAB$V_BLK FAB$V_BRO FAB$V_CBT FAB$V_CIFFAB$V_CR FAB$V_CTG FAB$V_DEL FAB$V_DFW FAB$V_DLT  FAB$V_DMO FAB$V_ESC FAB$V_EXE FAB$V_FTN FAB$V_GET FAB$V_INP FAB$V_JNL FAB$V_KFO FAB$V_MSE FAB$V_MXV FAB$V_NAM  FAB$V_NEF FAB$V_NFS FAB$V_NIL FAB$V_OFP FAB$V_ORG FAB$V_POS FAB$V_PPF FAB$V_PPF_IND FAB$V_PPF_RAT FAB$V_PRN FAB$V_PUT FAB$V_RCK  FAB$V_RWC FAB$V_RWO FAB$V_SCF FAB$V_SHRDEL FAB$V_SHRGET FAB$V_SHRPUT FAB$V_SHRUPD  FAB$V_SPL FAB$V_SQO FAB$V_SUP FAB$V_TEF FAB$V_TMD FAB$V_TMP FAB$V_TRN FAB$V_UFM FAB$V_UFO FAB$V_UPD FAB$V_UPI  FAB$V_WCK< FAB$W_BLS FAB$W_DEQH FAB$W_GBC FAB$W_IFI6 FAB$W_MRS PFABLEN GETFAB  GETRAB$ GETXAB_FHCD PROTO_FAB PROTO_RAB PROTO_XAB RAB$B_BID RAB$B_BLN5 RAB$B_KRF4 RAB$B_KSZ7 RAB$B_MBC6 RAB$B_MBF4 RAB$B_PSZ RAB$B_RAC RAB$B_ROP1 RAB$B_ROP2 RAB$B_ROP3 RAB$B_TMO RAB$C_BIDD RAB$C_BLN RAB$C_KEY RAB$C_RFA RAB$C_SEQ RAB$C_STMD RAB$K_BLN8 RAB$L_BKT RAB$L_CTX8 RAB$L_DCT< RAB$L_FAB0 RAB$L_KBF0 RAB$L_PBF( RAB$L_RBF RAB$L_RFA0, RAB$L_RHB RAB$L_ROP RAB$L_STS  RAB$L_STV$ RAB$L_UBF RAB$M_ASY RAB$M_BIO RAB$M_CCO RAB$M_CVT RAB$M_EOF@ RAB$M_FDL RAB$M_HSH  RAB$M_KGE@ RAB$M_KGT@ RAB$M_LIM  RAB$M_LOA RAB$M_LOC  RAB$M_MAS RAB$M_NLK RAB$M_NXR@ RAB$M_PMT@ RAB$M_PPF_IND? RAB$M_PPF_RAT  RAB$M_PTA RAB$M_RAH RAB$M_REA RAB$M_RLK RAB$M_RNE RAB$M_RNF RAB$M_RRL RAB$M_TMO RAB$M_TPT RAB$M_UIF RAB$M_ULK RAB$M_WAT RAB$M_WBH RAB$S_PPF_RAT RAB$S_RFA RAB$V_ASY  RAB$V_BIO RAB$V_CCO RAB$V_CVT RAB$V_EOF RAB$V_FDL RAB$V_HSH RAB$V_KGE RAB$V_KGT RAB$V_LIM  RAB$V_LOA RAB$V_LOC RAB$V_MAS RAB$V_NLK RAB$V_NXR RAB$V_PMT RAB$V_PPF_IND RAB$V_PPF_RAT RAB$V_PTA  RAB$V_RAH RAB$V_REA RAB$V_RLK RAB$V_RNE RAB$V_RNF RAB$V_RRL RAB$V_TMO RAB$V_TPT RAB$V_UIF RAB$V_ULK RAB$V_WAT  RAB$V_WBH RAB$W_ISI RAB$W_RFA RAB$W_RFA4" RAB$W_RSZ  RAB$W_STV0 RAB$W_STV2  RAB$W_USZ DRABLENRMS$V_STVSTATUSRMS$_ABORMS$_ACCRMS$_ACSZRMS$_ACTRMS$_AIDRMS$_ALNRMS$_ALQ RMS$_ANIRMS$_AOPRMS$_ATRRMS$_ATWRMS$_BESRMS$_BKS$RMS$_BKZ,RMS$_BLNRMS$_BOF4RMS$_BUGD RMS$_BUG_DAP< RMS$_BUG_DDIL RMS$_BUG_XX2T RMS$_BUG_XX3\ RMS$_BUG_XX4d RMS$_BUG_XX5l RMS$_BUG_XX6t RMS$_BUG_XX7| RMS$_BUG_XX8 RMS$_BUG_XX9RMS$_CAARMS$_CCFRMS$_CCRRMS$_CDARMS$_CHGRMS$_CHKRMS$_CHNRMS$_CODQ RMS$_CONTROLC  RMS$_CONTROLO RMS$_CONTROLYRMS$_CRC RMS$_CRE RMS$_CREATEDi RMS$_CRE_STML RMS$_CRMPRMS$_CURRMS$_DACRMS$_DANԇ RMS$_DEADLOCKbRMS$_DELĄRMS$_DEVlRMS$_DFL̄RMS$_DIRԄRMS$_DME܄RMS$_DNAJRMS$_DNFrRMS$_DNR:RMS$_DPERMS$_DTPRMS$_DUPRMS$_DVI4RMS$_ENQRMS$_ENT$RMS$_ENVzRMS$_EOFRMS$_ESARMS$_ESLRMS$_ESS܇ RMS$_EXENQLM‚RMS$_EXP"RMS$_EXT RMS$_FABRMS$_FACRMS$_FEXRMS$_FLGRMS$_FLK$RMS$_FNA*RMS$_FNDRMS$_FNF,RMS$_FNM<RMS$_FOP4RMS$_FSZćRMS$_FTMDRMS$_FUL̇RMS$_GBCLRMS$_IALTRMS$_IANTRMS$_IBF|RMS$_IBKRMS$_IDR\RMS$_IDX$RMS$_IFAdRMS$_IFIdRMS$_IFLlRMS$_IMXtRMS$_IOP|RMS$_IRCRMS$_ISIRMS$_KBFRMS$_KEY1RMS$_KFFtRMS$_KNMRMS$_KRFRMS$_KSIRMS$_KSZRMS$_LANRMS$_LBLRMS$_LEXRMS$_LNEąRMS$_LOC4RMS$_MBC2RMS$_MKD̅RMS$_MRNԅRMS$_MRS܅RMS$_NAMRMS$_NEFLRMS$_NET< RMS$_NETFAILRMS$_NIDʂRMS$_NMFRMS$_NOD RMS$_NORMALRMS$_NPK9 RMS$_OK_ALKA RMS$_OK_DEL RMS$_OK_DUP RMS$_OK_IDXQ RMS$_OK_LIMY RMS$_OK_NOP! RMS$_OK_RLKI RMS$_OK_RNF) RMS$_OK_RRLa RMS$_OK_WATRMS$_ORD RMS$_ORGRMS$_PBF  RMS$_PENDINGȁRMS$_PESRMS$_PLG,RMS$_PLV$RMS$_POS,RMS$_PRMRMS$_PRV4RMS$_QUO<RMS$_RABDRMS$_RACLRMS$_RATTRMS$_RBF\RMS$_REFRMS$_RERRMS$_REX\RMS$_RFAdRMS$_RFMlRMS$_RHBtRMS$_RLFRMS$_RLKRMS$_RMVRMS$_RNFRMS$_RNL|RMS$_ROPRMS$_RPLRMS$_RRVڂRMS$_RSA<RMS$_RSLRMS$_RSSRMS$_RSTRMS$_RSZRMS$_RTBRMS$_RVURMS$_SEGRMS$_SEQRMS$_SHRRMS$_SIZRMS$_SNERMS$_SPEBRMS$_SPLĆRMS$_SQO RMS$_STALL̆RMS$_STKRMS$_STRRMS$_SUC҂RMS$_SUP1RMS$_SUPERSEDED RMS$_SUPPORTԆRMS$_SYN RMS$_SYSj RMS$_TEMP1RMS$_TMORMS$_TNS܆RMS$_TRERMS$_TYPRMS$_UBFRMS$_UPIRMS$_USZRMS$_VERRMS$_VOL,RMS$_WBERMS$_WCCRMS$_WERDRMS$_WLDRMS$_WLKRMS$_WPLRMS$_WSF RMS$_XABRMSDATA  XAB$B_ATR XAB$B_BKZ XAB$B_BLN XAB$B_COD XAB$B_HSZ XAB$B_RFO XAB$C_FHC, XAB$C_FHCLEN, XAB$K_FHCLEN XAB$L_EBK  XAB$L_HBK XAB$L_NXT  XAB$L_RDT0 XAB$L_RDT4( XAB$L_SBN  XAB$Q_RDT XAB$S_RDT XAB$W_DXQ XAB$W_EBK0 XAB$W_EBK2 XAB$W_FFB XAB$W_GBC  XAB$W_HBK0 XAB$W_HBK2  XAB$W_LRL XAB$W_MRZ XAB$W_RVN&XAB$W_VERLIMIT ,XABLENz_APPEND _CLOSE _DO_MAPOPEN _ERASE~_FCLOSE{_FCREATE 8_FGET;_FIL_EBKJ_FIL_FFBY_FIL_FSZa_FIL_MRSq_FIL_RATi_FIL_RFM F_FOPEN f_FPUT _FREAD_FWRITE _GET_GETBLK_GETFAB_MAKBLK _MAPCLOSE_MAPOPEN _OPENk_POPSIZE_PROMPT] _PUSHSIZE _PUT _RANDOGET _RANDOPUT_RCREATE +_READI _RESTORE_DATA_RMSTYO_RMSTYPE _ROPEN _SAVE7 _SAVE_DATA _TYPE _WOPENY _WOPEN_FTN6 _WOPEN_NCR o_WRITE_WRTBLK y_XLOAD __MAPOPEN __OPENA . BLANK .DATINITKERNEL*[SAOSTOIC.KERNEL]SS.OBJ;3+,.B/A 4BB- 0123K56 $/7/89GAHJL0SYSTEM0 5-APR-1984 09:43 VAX-11 Macro V03-00 /LIS SS(-SERVICES driver for SAO VAX/VMS STOICCMDDESCDAT_END DICT_STARTK_STARTSSBYTE SSDATA SSGLOBSSSIZE xSS_CALLS  SS_KERNEL SYS$ASCTIM SYS$ASSIGN SYS$BINTIM SYS$CLREF SYS$CREPRC SYS$CRETVA SYS$CRMPSC SYS$DASSGN SYS$DELPRC SYS$DELTVA SYS$DGBLSCSYS$EXIT SYS$EXPREG SYS$GETCHN SYS$GETJPI SYS$GETMSG SYS$GETTIM SYS$MGBLSC SYS$NUMTIMSYS$QIOSYS$QIOW SYS$READEF SYS$SCHDWK SYS$SETIMR SYS$SETPRI SYS$SETPRN SYS$SETPRT SYS$TRNLOG SYS$UPDSEC SYS$WAITFRSYS$WAKE . ABS . . BLANK .P$ABS$PPPPP|KERNELP DICTIONARYPNULLQQ%K_START44&PPP DICT_START44 DICT_START44$READEFQQQK_START44&Pj SYS$READEFPj'PQ  P'P DICT_START44 DICT_START44$_WASCLRQQQ K_START44& Pz=PQP=P' DICT_START44+ DICT_START44$_WASSETQQQK_START44&P zSPQPSP= DICT_START44A DICT_START44$CLREFQQQK_START44&Pj SYS$CLREFPjgPQ PgPS DICT_START44W DICT_START44$WAITFRQQQK_START44&Pj SYS$WAITFRPj|PQ *P|Pg DICT_START44k DICT_START44$TRNLOGQQQ*K_START44&*Pj SYS$TRNLOGPjPQ 5PP| DICT_START44 DICT_START44$ASSIGNQQQ5K_START44&5Pj SYS$ASSIGNPjPQ @PP DICT_START44 DICT_START44$DASSGNQQQ@K_START44&@Pj SYS$DASSGNPjPQ KPP DICT_START44 DICT_START44$QIOQQQKK_START44&KPjSYS$QIOPjPQ VPP DICT_START44 DICT_START44$QIOWQQQVK_START44&VPjSYS$QIOWPjPQ aPP DICT_START44 DICT_START44$GETCHNQQQaK_START44&aPj SYS$GETCHNPjPQ lPP DICT_START44 DICT_START44IO$_READVBLKQ Q QlK_START44&lP1zPQpPP DICT_START44 DICT_START44IO$_READPROMPTQQQpK_START44&pP7z+PQtP+P DICT_START44 DICT_START44IO$_WRITEVBLKQ Q QtK_START44&tP0zFPQxPFP+ DICT_START44/ DICT_START44IO$_READLBLKQ Q QxK_START44&xP!z`PQ|P`PF DICT_START44J DICT_START44IO$_WRITELBLKQ Q Q|K_START44&|P z{PQP{P` DICT_START44d DICT_START44IO$_READPBLKQ Q QK_START44&P zPQPP{ DICT_START44 DICT_START44IO$_WRITEPBLKQ Q QK_START44&P zPQPP DICT_START44 DICT_START44IO$_SETCHARQ Q QK_START44&PzPQPP DICT_START44 DICT_START44IO$_SETMODEQ Q QK_START44&P#zPQPP DICT_START44 DICT_START44IO$_WRITEOFQ Q QK_START44&P(zPQPP DICT_START44 DICT_START44IO$_REWINDQ Q QK_START44&P$zPQPP DICT_START44 DICT_START44IO$_SENSEMODEQ Q QK_START44&P'z.PQP.P DICT_START44 DICT_START44IO$_SKIPFILEQ Q QK_START44&P%zHPQPHP. DICT_START442 DICT_START44IO$_SKIPRECORDQQQK_START44&P&zdPQPdPH DICT_START44L DICT_START44IO$M_NOECHOQ Q QK_START44&PЏ@z}PQP}Pd DICT_START44h DICT_START44IO$M_NOFILTRQ Q QK_START44&PЏzPQPP} DICT_START44 DICT_START44IO$M_TIMEDQ Q QK_START44&PЏzPQPP DICT_START44 DICT_START44IO$M_TRMNOECHOQQQK_START44&PЏzPQPP DICT_START44 DICT_START44IO$M_NOFORMATQ Q QK_START44&PЏzPQPP DICT_START44 DICT_START44IO$M_HANGUPQ Q QK_START44&PЏzPQPP DICT_START44 DICT_START44IO$M_DATACHECKQQQK_START44&PЏ@zPQPP DICT_START44 DICT_START44IO$M_INHRETRYQ Q QK_START44&PЏz6PQP6P DICT_START44 DICT_START44IO$M_NOWAITQ Q QK_START44&PЏzOPQPOP6 DICT_START44: DICT_START44$_NORMALQQQK_START44&PzePQPePO DICT_START44S DICT_START44$_TIMEOUTQ Q QK_START44&PЏ,z|PQP|Pe DICT_START44i DICT_START44$GETMSGQQQK_START44&Pj SYS$GETMSGPjPQ PP| DICT_START44 DICT_START44$CREPRCQQQK_START44&Pj SYS$CREPRCPjPQ PP DICT_START44 DICT_START44$DELPRCQQQK_START44&Pj SYS$DELPRCPjPQ PP DICT_START44 DICT_START44$WAKEQQQK_START44&PjSYS$WAKEPjPQ $PP DICT_START44 DICT_START44$SCHDWKQQQ$K_START44&$Pj SYS$SCHDWKPjPQ /PP DICT_START44 DICT_START44$EXITQQQ/K_START44&/PjSYS$EXITPjPQ :PP DICT_START44 DICT_START44$SETPRNQQQ:K_START44&:Pj SYS$SETPRNPj PQ EP P DICT_START44 DICT_START44$SETPRIQQQEK_START44&EPj SYS$SETPRIPj PQ PP P  DICT_START44 DICT_START44$GETJPIQQQPK_START44&PPj SYS$GETJPIPj5PQ [P5P  DICT_START44$ DICT_START44ACCOUNTQQQ[K_START44&[PЏzJPQcPJP5 DICT_START449 DICT_START44CPUTIMQQQcK_START44&cPЏz^PQkP^PJ DICT_START44N DICT_START44DIRIOQQQkK_START44&kP zqPQsPqP^ DICT_START44b DICT_START44FREP0VAQQQsK_START44&sPЏzPQ{PPq DICT_START44u DICT_START44GRPQQQ{K_START44&{PЏzPQPP DICT_START44 DICT_START44MEMQQQK_START44&PЏzPQPP DICT_START44 DICT_START44UICQQQK_START44&PЏzPQPP DICT_START44 DICT_START44$GETTIMQQQK_START44&Pj SYS$GETTIMPjPQ PP DICT_START44 DICT_START44$NUMTIMQQQK_START44&Pj SYS$NUMTIMPjPQ PP DICT_START44 DICT_START44$ASCTIMQQQK_START44&Pj SYS$ASCTIMPjPQ PP DICT_START44 DICT_START44$BINTIMQQQK_START44&Pj SYS$BINTIMPj PQ P P DICT_START44 DICT_START44$SETIMRQQQK_START44&Pj SYS$SETIMRPj"PQ P"P  DICT_START44 DICT_START44$EXPREGQQQK_START44&Pj SYS$EXPREGPj7PQ P7P" DICT_START44& DICT_START44$CRETVAQQQK_START44&Pj SYS$CRETVAPjLPQ PLP7 DICT_START44; DICT_START44$DELTVAQQQK_START44&Pj SYS$DELTVAPjaPQ PaPL DICT_START44P DICT_START44$CRMPSCQQQK_START44&Pj SYS$CRMPSCPjvPQ  PvPa DICT_START44e DICT_START44$UPDSECQQQ K_START44& Pj SYS$UPDSECPjPQ PPv DICT_START44z DICT_START44$MGBLSCQQQK_START44&Pj SYS$MGBLSCPjPQ  PP DICT_START44 DICT_START44$DGBLSCQQQ K_START44& Pj SYS$DGBLSCPjPQ +PP DICT_START44 DICT_START44$SETPRTQQQ+K_START44&+Pj SYS$SETPRTPjPQ 6PP DICT_START44 DICT_START44SEC$M_GBLQ Q Q6K_START44&6PzPQ:PP DICT_START44 DICT_START44SEC$M_CRFQ Q Q:K_START44&:PzPQ>PP DICT_START44 DICT_START44SEC$M_DZROQ Q Q>K_START44&>PzPQBPP DICT_START44 DICT_START44SEC$M_EXPREGQ Q QBK_START44&BPЏz*PQJP*P DICT_START44 DICT_START44SEC$M_WRTQ Q QJK_START44&JPzAPQNPAP* DICT_START44. DICT_START44SEC$M_PERMQ Q QNK_START44&NPЏ@zYPQVPYPA DICT_START44E DICT_START44SEC$M_PFNMAPQ Q QVK_START44&VPЏzsPQ^PsPY DICT_START44] DICT_START44SEC$M_SYSGBLQ Q Q^K_START44&^PЏzPQfPDATINITPQQQfPPs DICT_START44w DICT_START44GETCMDQQQfK_START44&fPCMDDESCCMDDESCP}`z SYSTEM $$ARGS $$T1 $CLI. $CLI.. UBIT... CLI$A_ABSACT CLI$A_ERRACT CLI$A_FLSACTCLI$A_IMGFILED CLI$A_IMGHDADRCLI$A_PROGXFER CLI$A_PRSACTCLI$A_QDVALADR CLI$A_QUALST  CLI$A_RQADDR  CLI$A_TRUACTCLI$A_UTILSERV CLI$B_BITNUM8 CLI$B_EFN CLI$B_FLAGSCLI$B_QDBLKSIZ CLI$B_QDCODE CLI$B_QDFLGS CLI$B_QDSTAT CLI$B_RQFLGS CLI$B_RQINDX CLI$B_RQSTAT CLI$B_RQTYPE CLI$C_QDBITS CLI$C_QUALDEF CLI$C_REQDESC< CLI$C_SRVDESCCLI$C_WORKAREAACLI$K_ASCIIVAL CLI$K_CLINT CLI$K_CLISERVSCLI$K_DCLPARSETCLI$K_DISPATCHRCLI$K_ENDPARSE0 CLI$K_ENDPRM11 CLI$K_ENDPRM22 CLI$K_ENDPRM33 CLI$K_ENDPRM4D CLI$K_FILSPEC CLI$K_GETCMD CLI$K_GETLINE CLI$K_GETOPT CLI$K_GETQUALQCLI$K_GETVALUE CLI$K_INITPRS CLI$K_INPSPEC CLI$K_INPUT1 CLI$K_INPUT2 CLI$K_INPUT3 CLI$K_INPUT4C CLI$K_KEYVALB CLI$K_KEYWORD@CLI$K_NUMERVAL  CLI$K_OUTPUT1! CLI$K_OUTPUT2" CLI$K_OUTPUT3# CLI$K_OUTPUT4 CLI$K_OUTSPEC CLI$K_PARDONEP CLI$K_PRESENT CLI$K_QDBITS CLI$K_QUALDEF CLI$K_REQDESC< CLI$K_SRVDESC CLI$K_UTILOPR CLI$K_VALCONVCLI$K_WORKAREA CLI$L_ARGLIST0 CLI$L_ASTADR4 CLI$L_ASTPRM CLI$L_CLIFLAGCLI$L_INIARGCNTCLI$L_LINKFLAG CLI$L_LSTSTATUSCLI$L_NEW_MASKCLI$L_OLD_MASK CLI$L_OUTPID CLI$L_PID  CLI$L_RQVALU CLI$L_USRVALCLI$L_WORKAREA CLI$M_ABSADRCLI$M_ALLOCCUR CLI$M_BATCHCLI$M_CONCATINP CLI$M_DBGEXCP CLI$M_DBGTRU CLI$M_DEBUG CLI$M_DUMMY CLI$M_EXPNAMCLI$M_INDIRECT CLI$M_KEYVALU CLI$M_LASTVAL CLI$M_MOREINPCLI$M_MOREVALSCLI$M_NOCLISYMCLI$M_NOLOGNAM CLI$M_NOWAIT CLI$M_PARMDEF CLI$M_PARMPRS CLI$M_PARMREQ CLI$M_QDEXPA CLI$M_QDUSRV CLI$M_QUALEXP CLI$M_QUALTRUCLI$M_TRMVRBLV CLI$M_VERIFY  CLI$M_VFYINP CLI$Q_CMDSTR CLI$Q_INPUT CLI$Q_NAMDESC  CLI$Q_OUTPUT( CLI$Q_PRCNAMCLI$Q_QDVALDESC CLI$Q_RQDESC  CLI$Q_VALDESC CLI$S_CMDSTR CLI$S_INPUT CLI$S_NAMDESC CLI$S_OUTPUT CLI$S_PRCNAM CLI$S_PRITYPCLI$S_QDVALDESC CLI$S_RQDESC CLI$S_SUBTYPCLI$S_TRMVRBLV CLI$S_VALDESCCLI$S_WORKAREA CLI$V_ABSADRCLI$V_ALLOCCUR CLI$V_BATCHCLI$V_CONCATINP CLI$V_DBGEXCP CLI$V_DBGTRU CLI$V_DEBUG CLI$V_DUMMY CLI$V_EXPNAMCLI$V_INDIRECT CLI$V_KEYVALU CLI$V_LASTVAL CLI$V_MOREINPCLI$V_MOREVALSCLI$V_NOCLISYMCLI$V_NOLOGNAM CLI$V_NOWAIT CLI$V_PARMDEF CLI$V_PARMPRS CLI$V_PARMREQ CLI$V_PRITYP CLI$V_QDEXPA CLI$V_QDUSRV CLI$V_QUALEXP CLI$V_QUALTRU CLI$V_SUBTYPCLI$V_TRMVRBLV CLI$V_VERIFY CLI$V_VFYINPCLI$W_QDVALSIZ CLI$W_RQSIZE CLI$W_SERVCODCLPLACEGLOBLINK IO$K_LOOPTEST  IO$K_PTPBSC IO$K_SRRUNOUT IO$M_ABORT IO$M_ACCEPT@ IO$M_ACCESS IO$M_ATTNAST@ IO$M_BINARY@ IO$M_CANCTRLO IO$M_CECYL IO$M_CLEARIO$M_CLR_COUNTIO$M_CNTRLENTRY@ IO$M_COMMOD IO$M_CREATE IO$M_CTRL IO$M_CTRLCAST IO$M_CTRLYAST IO$M_CVTLOW IO$M_CYCLE@IO$M_DATACHECK IO$M_DATAPATH@ IO$M_DELDATA IO$M_DELETEIO$M_DIAGNOSTIC IO$M_DMOUNT IO$M_DSABLMBXIO$M_DSABL_ALT IO$M_ENABLMBXIO$M_ENABL_ALT@ IO$M_ESCAPE IO$M_EXTEND? IO$M_FCODE@ IO$M_FORCE IO$M_HANGUP IO$M_INCLUDE IO$M_INHERLOGIO$M_INHEXTGAP IO$M_INHRETRY IO$M_INHSEEK IO$M_INTCLOCK@IO$M_INTERRUPT IO$M_INTSKIPIO$M_LASTBLOCK IO$M_LINE_OFF IO$M_LINE_ON IO$M_LOOP IO$M_LOOP_EXT  IO$M_LPBEXT@ IO$M_LPBINT@ IO$M_MAINTIO$M_MAINTLOOP@ IO$M_MORE IO$M_MOUNTIO$M_MOVETRACKD IO$M_MULTIPLE@IO$M_NOCTSWAITIO$M_NODSRWAIT@ IO$M_NOECHO IO$M_NOFILTR IO$M_NOFORMAT@ IO$M_NOMRSP@IO$M_NOW IO$M_NOWAIT IO$M_OPPOSITE IO$M_OUTBAND IO$M_PACKED IO$M_PURGEIO$M_QUALIFIED IO$M_RD_COUNT@ IO$M_RD_MEM IO$M_RD_MODEM IO$M_READATTN IO$M_READCSR@ IO$M_REDIRECT  IO$M_REFRESH IO$M_RESET@ IO$M_REVERSE IO$M_SETBSIZE IO$M_SETCUADRIO$M_SETENQCNT@ IO$M_SETEVF IO$M_SETFNCTIO$M_SETPOOLSZ IO$M_SETPROTIO$M_SET_MODEM IO$M_SHUTDOWNIO$M_SKPSECINH IO$M_SLAVLOOP@ IO$M_STARTUP IO$M_SWAP IO$M_SYNCH IO$M_TIMEDIO$M_TRMNOECHO@IO$M_TYPEAHDCNT IO$M_UNLOOP@ IO$M_WORD IO$M_WRTATTN IO$S_FCODE IO$V_ABORT IO$V_ACCEPT IO$V_ACCESS IO$V_ATTNAST IO$V_BINARY IO$V_CANCTRLO  IO$V_CECYL  IO$V_CLEAR IO$V_CLR_COUNTIO$V_CNTRLENTRY IO$V_COMMOD IO$V_CREATE  IO$V_CTRL IO$V_CTRLCAST IO$V_CTRLYAST IO$V_CVTLOW  IO$V_CYCLEIO$V_DATACHECK  IO$V_DATAPATH IO$V_DELDATA IO$V_DELETEIO$V_DIAGNOSTIC  IO$V_DMOUNT  IO$V_DSABLMBX IO$V_DSABL_ALT IO$V_ENABLMBX IO$V_ENABL_ALT IO$V_ESCAPE IO$V_EXTEND IO$V_FCODE IO$V_FORCE  IO$V_HANGUP  IO$V_INCLUDE  IO$V_INHERLOG IO$V_INHEXTGAP IO$V_INHRETRY  IO$V_INHSEEK  IO$V_INTCLOCKIO$V_INTERRUPT IO$V_INTSKIP IO$V_LASTBLOCK  IO$V_LINE_OFF  IO$V_LINE_ON IO$V_LOOP  IO$V_LOOP_EXT  IO$V_LPBEXT IO$V_LPBINT IO$V_MAINT IO$V_MAINTLOOP IO$V_MORE  IO$V_MOUNTIO$V_MOVETRACKD IO$V_MULTIPLEIO$V_NOCTSWAITIO$V_NODSRWAIT IO$V_NOECHO  IO$V_NOFILTR IO$V_NOFORMAT IO$V_NOMRSPIO$V_NOW IO$V_NOWAIT  IO$V_OPPOSITE  IO$V_OUTBAND IO$V_PACKED  IO$V_PURGEIO$V_QUALIFIED IO$V_RD_COUNT IO$V_RD_MEM IO$V_RD_MODEM IO$V_READATTN IO$V_READCSR IO$V_REDIRECT  IO$V_REFRESH  IO$V_RESET IO$V_REVERSE  IO$V_SETBSI~ REDBUILD.BAK [SAOSTOIC.KERNEL]SS.OBJ;3MAP;1BV8'ZE IO$V_SETCUADR IO$V_SETENQCNT IO$V_SETEVF  IO$V_SETFNCT IO$V_SETPOOLSZ  IO$V_SETPROT IO$V_SET_MODEM IO$V_SHUTDOWN IO$V_SKPSECINH IO$V_SLAVLOOP IO$V_STARTUP  IO$V_SWAP  IO$V_SYNCH IO$V_TIMED IO$V_TRMNOECHOIO$V_TYPEAHDCNT IO$V_UNLOOP IO$V_WORD IO$V_WRTATTN2 IO$_ACCESS8IO$_ACPCONTROL IO$_AVAILABLE IO$_CLEAN<IO$_CONINTREAD=IO$_CONINTWRITE3 IO$_CREATE4 IO$_DEACCESS5 IO$_DELETE IO$_DIAGNOSE IO$_DRVCLRIO$_DSE: IO$_ENDRU1; IO$_ENDRU2 IO$_ERASETAPE7 IO$_FORCE IO$_FORMATIO$_INITIALIZE IO$_LOADMCODE/ IO$_LOGICAL6 IO$_MODIFY9 IO$_MOUNT6IO$_NETCONTROLIO$_NOP IO$_OFFSET IO$_PACKACK IO$_PHYSICAL IO$_QSTOP  IO$_RDSTATS IO$_READHEAD< IO$_READINIT! IO$_READLBLK  IO$_READPBLKIO$_READPRESET7IO$_READPROMPTIO$_READTRACKD1 IO$_READVBLK IO$_RECAL IO$_RELEASE IO$_REREADN IO$_REREADP IO$_RETCENTER$ IO$_REWIND" IO$_REWINDOFF  IO$_SEARCHIO$_SEEK IO$_SENSECHAR' IO$_SENSEMODE IO$_SETCHAR7 IO$_SETCLOCK IO$_SETCLOCKP# IO$_SETMODE% IO$_SKIPFILE&IO$_SKIPRECORD IO$_SPACEFILE IO$_SPACERECORD8 IO$_STARTDATAIO$_STARTDATAPIO$_STARTMPROCIO$_STARTSPNDLIO$_STOP:IO$_TTYREADALL;IO$_TTYREADPALL IO$_UNLOAD? IO$_VIRTUAL IO$_WRITECHECKIO$_WRITECHECKH  IO$_WRITEHEAD  IO$_WRITELBLK IO$_WRITEMARK( IO$_WRITEOF  IO$_WRITEPBLK IO$_WRITERETIO$_WRITETRACKD0 IO$_WRITEVBLK IO$_WRTTMKR JPI$C_ADRTYPE JPI$C_CTLTYPE JPI$C_LISTEND JPI$C_PCBTYPE JPI$C_PHDTYPE JPI$_ACCOUNT  JPI$_APTCNT JPI$_ASTACT JPI$_ASTCNT JPI$_ASTEN  JPI$_ASTLM JPI$_AUTHPRI JPI$_AUTHPRIV JPI$_BIOCNT JPI$_BIOLM  JPI$_BUFIO JPI$_BYTCNT JPI$_BYTLM  JPI$_CPULIM JPI$_CPUTIM JPI$_CURPRIV JPI$_DFPFC JPI$_DFWSCNT JPI$_DIOCNT JPI$_DIOLM  JPI$_DIRIO JPI$_EFCS JPI$_EFCU JPI$_EFWM JPI$_ENQCNT  JPI$_ENQLM JPI$_EXCVEC JPI$_FILCNT JPI$_FILLM JPI$_FINALEXC JPI$_FREP0VA JPI$_FREP1VAJPI$_FREPTECNT  JPI$_GPGCNTJPI$_GRPJPI$_IMAGECOUNT JPI$_IMAGNAME JPI$_IMAGPRIVJPI$_JOBPRCCNT JPI$_LASTADR  JPI$_LASTCTL" JPI$_LASTPCB JPI$_LASTPHD JPI$_LOGINTIMJPI$_MEM JPI$_OWNER  JPI$_PAGEFLTSJPI$_PAGFILCNTJPI$_PAGFILLOCJPI$_PGFLQUOTAJPI$_PID  JPI$_PPGCNT JPI$_PRCCNT JPI$_PRCLM JPI$_PRCNAMJPI$_PRI  JPI$_PRIB JPI$_PROCPRIV JPI$_SITESPEC JPI$_STATEJPI$_STS!JPI$_SWPFILLOC JPI$_TERMINAL  JPI$_TMBU JPI$_TQCNT JPI$_TQLMJPI$_UIC JPI$_USERNAME JPI$_VIRTPEAK JPI$_VOLUMES JPI$_WSAUTHJPI$_WSAUTHEXT JPI$_WSEXTENT JPI$_WSPEAK JPI$_WSQUOTA JPI$_WSSIZE JUMP_TO_ME fKEND KERNEL fKPLACE SCHDWK$_DAYTIM SCHDWK$_NARGSSCHDWK$_PIDADRSCHDWK$_PRCNAMSCHDWK$_REPTIM SEC$B_AMOD  SEC$B_PFC  SEC$C_LENGTH  SEC$K_LENGTH SEC$K_MATALL SEC$K_MATEQU SEC$K_MATLEQ SEC$L_CCB SEC$L_GSD SEC$L_PAGCNT SEC$L_REFCNT SEC$L_VBN SEC$L_VPXPFC  SEC$L_WINDOW SEC$M_AMOD SEC$M_CRF SEC$M_DZRO SEC$M_EXPREG SEC$M_GBL SEC$M_PAGFIL@ SEC$M_PERM SEC$M_PFNMAP SEC$M_PROTECT SEC$M_SHMGS SEC$M_SYSGBL SEC$M_WRT SEC$M_WRTMOD SEC$S_AMOD SEC$S_PFC SEC$S_VPX SEC$S_WRTMOD SEC$V_AMOD SEC$V_CRF SEC$V_DZRO SEC$V_EXPREG SEC$V_GBL SEC$V_PAGFIL SEC$V_PERM SEC$V_PFC SEC$V_PFNMAP SEC$V_PROTECT SEC$V_SHMGS SEC$V_SYSGBL SEC$V_VPX SEC$V_WRT SEC$V_WRTMOD SEC$W_FLAGS SEC$W_SECXBL SEC$W_SECXFL, SS$_ABORTSS$_ACCONFLICT  SS$_ACCVIO SS$_ACPVAFULSS$_ALRDYCLOSEDt SS$_ARTRES  SS$_ASTFLT4 SS$_BADATTRIB SS$_BADCHKSUM< SS$_BADESCAPESS$_BADFILEHDRSS$_BADFILENAME SS$_BADFILEVERD SS$_BADIMGHDR(SS$_BADIRECTORY  SS$_BADISD SS$_BADPARAM SS$_BADQFILESS$_BADQUEUEHDRl! SS$_BADRCT SS$_BADSTACKd  SS$_BADVEC8  SS$_BEGOFFILE@ SS$_BLOCKCNTERR SS$_BREAK  SS$_BUFBYTALI SS$_BUFFEROVF$SS$_BUFNOTALIGN SS$_BUGCHECK0 SS$_CANCEL  SS$_CHAINWL SS$_CHANINTLK! SS$_CLEARED  SS$_CLIFRCEXT SS$_CMODSUPR$ SS$_CMODUSER  SS$_COMMHARD, SS$_COMPAT SS$_CONCEALED SS$_CONNECFAIL SS$_CONTINUEQ SS$_CONTROLC  SS$_CONTROLO SS$_CONTROLY SS$_CREATEDT SS$_CTRLERR=0 ELSE MINUS C.MAG ! C.SIGN -1<- THEN ;6'CLI.MOVE_ERROR : % checks for an out-of-buffer errorH DUP GEZ_IF TOPOBOT ELSE MINUS TOPOTOP THEN % find which region to use? D@- LT ERR_FLAG ! % minor error if not enough room in region ;='CONVERT_TO_UPPER : % byte, CONVERT_TO_UPPER, converted byte DUP ASCII a LE IF* DUP ASCII z GE IF % is it lower-case? 20 - THEN THEN ;A% 'CLI.SYMBARG : CLI.SYMBARG, [value, -1] or [0] (not debugged)6% C.COMCUR @ save current position in command line/% CLI.GNB IF get next byte, anything there?-% ASCII ` EQ_IF yes, is it accent grave7% CLI.GNB IF yes, get search byte, is it there?>% BOT_COUNT SBF GEZ_IF search for byte, is it there?%% TOPOBOT @ - UNDER -1 ELSE@% 3 (DROP) ERR.NOBYTE THEN ELSE byte not found, fail5% ERR.INVARG THEN ELSE no search byte, failA% C.COMCUR ! 0 THEN ELSE invalid symbolic parameter, fail<% DROP 0 THEN nothing there, drop saved position, fail% ;'INCLUDE_DIGIT :$ DUP ASCII 0 LE OVER ASCII 9 GE AND IF % is it a numberI ASCII 0 - C.MAG @ A * + C.MAG ! CLI.GNB DUP NOT % yes; fix the total C.ARGLEN 1+! ELSE9 DROP CLI.BACK 0 -1 % no; put it back and signal exit THEN ;'CLI.READ_DIGIT : IF INCLUDE_DIGIT- ELSE 0 -1 % signal exit if no bytes there THEN ;6'CLI.NUMARG : % CLI.NUMARG, value of integer argument1% (extracts integer as next item on command line)3 1 C.SIGN ! C.MAG 0<- C.ARGLEN 0<- % reset values CLI.GNB DUP IF % is there a byte OVER ASCII - EQ_IFD C.SIGN -1<- C.ARGLEN 1+! 2DROP CLI.GNB % yes, check for minus THEN OVER ASCII + EQ_IF= C.SIGN 1<- C.ARGLEN 1+! 2DROP CLI.GNB % check for plus THEN THEN BEGIN CLI.READ_DIGIT END DROPE C.ARG_EXISTS C.ARGLEN @ EQZ_IF 0<- ELSE -1<- THEN % maybe preserve/ C.SIGN @ C.MAG @ * C.ARG ! % sign the number2 C.ARG @ EQZ_IF % special interpretation of zero: C.SIGN @ LTZ_IF C.ARG -1<- ELSE % "-" by itself => -1 C.ARGLEN @ EQZ_IF0 C.ARG 1 <- C.DEFAULT? -1<- % null => +1 THEN THEN THEN ;8'CLI.INIT : % initialization done once per command line2 C.ARG_EXISTS 0<- % no argument exists initially- CURKBUF @ D@- % get number of bytes in top6 CLI.MOVE_DOWN % and go to the top of the key buffer ; % More CLI Utilities ASSEMBLER<;'CLI.SUBSTRING : % pattern descriptor, source descriptor,-@% CLI.SUBSTRING, remaining source descriptor, pattern descriptor/ MOVQ (P)+ R2 MOVQ (P) R0 % load descriptors. MATCHC R0 (R1) R2 (R3) % do match operation2 MOVQ R2 -(P) % return rest-of-source descriptor) MOVL R0 -(P) EQZ % return success code ;>;'CLI.REMVER : % descriptor, CLI.REMVER, revised descriptorB% (revised descriptor is of string with ";" and all after removed)/ ( DUP I + B@ ASCII ; EQ_IF EXIT THEN ) LAST_I ; ASSEMBLER<0'L_STACK_EMPTY? : % L_STACK_EMPTY?, truth value MOVL L -(P) L_STACK_0 @ LE ;4'CLEAR_L_STACK : % CLEAR_L_STACK, resets loop stack L_STACK_0 @ MOVL (P)+ L ;>('SFSEP : % n, string descriptor, SFSEP,8% descriptor of string passed over to find nth separatorD% (If there are not n in string, full string descriptor is returned) -ROT NOTE % save count# OVER SWAP % save string location1 REC_SEP @ +ROT % setup to search for separator RECALL ( % do it n times( SBF LTZ_IF % search, anything left?3 1- -1 EXIT ELSE % no, correct position, exit$ UNDROP THEN ) % yes, continue: DROP UNDER % drop remaining string length & search byte, OVER - % descriptor of string passed over ;H'CLI.FIND_LABEL : % label byte, CLI.FIND_LABEL, success (moves in KBUF); BEGIN % loop until we find the label or run out of bytes CLI.GNB % get one IF % have we run out?' ASCII \ EQ_IF % have we a label?# CLI.GNB % get another byte IF % did we find one? CONVERT_TO_UPPERG OVER EQ_IF DROP -1 -1 ELSE 0 THEN % maybe signal exit, found ELSEH DROP 0 -1 % no byte; signal exit, not found (drop label byte) THEN4 ELSE 0 % it's not a label; signal to continue THEN ELSE= DROP 0 -1 % no bytes left here; signal exit, not found THEN END ; #% Support words for file operations'O.K._TO_OPEN? :* FILE_NAME W@ NEZ_IF % is a file active? ERR.ACTIVE ELSE % yes) BUFFER# @ NEZ_IF % no, wrong buffer? ERR.X0ONLY ELSE % yes' -1 THEN THEN % it's O.K. to open ;'O.K._TO_CLOSE? :* FILE_NAME W@ EQZ_IF % is a file active? ERR.NOTACT ELSE % no, error) BUFFER# @ NEZ_IF % no, wrong buffer? ERR.X0ONLY ELSE % yes( -1 THEN THEN % it's O.K. to close ; 'F.DIAG :- DDUP SWAP @ SWAP = = CR % diagnostic ;D'SIMULATE_GET : % does GET but expands buffer if record doesn't fit& BEGIN % start loop to try to fit it9 DUP @ MAXLINE 3 .GET % read a record, get error code! NOT IF % was there an error?E 2DROP DUP 800 D.EXPAND 0 % yes, expand dynast, signal continue, ELSE -1 THEN % exit begin if no problem END7 DUP NOT IF UNDER THEN % don't return a length if EOF ;'MOVE_RECORD :B 4+ BEGIN % open successful, point to expansion area, read lines' DUP D@- MAXLINE - LTZ_IF % any room?' DUP 800 D.EXPAND THEN % no, expand# SIMULATE_GET IF % read, success? % F.DIAG OVER +! % log count, DUP @ REC_SEP @ B<- DUP 1+! % append CR REPEAT DROP ;L'F.LOAD : % ptr. to buffer descriptor, filename descriptor, F.LOAD, success 3 .OPEN IFA 3 FIL_RAT DUP REC_ATT ! 2 AND % is rec. attr. CR or FORTRAN?5 NEZ_IF CRET ELSE USEP THEN % determine separator( REC_SEP ! % store value in variable MOVE_RECORD+ 3 CLOSE -1 ELSE % finished, close file= UNDROP UNDER THEN % open unsuccessful, return error code ;'C.P/R_LOOP_BODY :8 DUP W@ FSIZE @ - % get number of bytes in this recordJ SWAP 2+ FSIZE @ + SWAP DDUP % omit control field; get source descriptor( BOTOTOP @ % get a destination address MOVE_BYTES % move the stringe3 DUP BOTOTOP +! + % add count to bototop, addressaG DUP FIRST_BYTE @ XOR IF 1+ THEN % fix pointer to point to next placeM= REC_SEP @ TOPOTOP ABE % add separator to end of top buffer*1 DDUP GE % and continue if we're not at the end  ;E'C.PROCESS_RECORDS : % end address, start address, C.PROCESS_RECORDS  C.REC_LENGTH @ EQZ_IFs/ BEGIN % loop until top pointer reaches end* C.P/R_LOOP_BODY* END 2DROP % clear stack# ELSE % fixed length records here BEGINi@ DUP C.REC_LENGTH @ BOTOTOP @ MOVE_BYTES % move the stringH C.REC_LENGTH @ + % increment the start pointer by the record sizeA C.REC_LENGTH @ BOTOTOP +! % adjust the destination pointerC1 REC_SEP @ TOPOTOP ABE % add on a separator' DDUP GE % see if we're there yetr% END 2DROP % stop and clear stack  THEN ;s2'CLI.READ_FILE : % number of bytes, CLI.READ_FILE0 BOTOTOP OVER D.EXPAND % make the gap that big% TOPOBOT @ OVER - TOPOBOT !P- BOTOTOP @ OVER 6 READ % read file into gapf IF % success? 6 CLOSE % close the filenM BOTOTOP @ + BOTOTOP @ DUP FIRST_BYTE ! % push end address, start address; C.PROCESS_RECORDS % get rid of the record length words -1 % succeed 1 ELSE UNDROP UNDER THEN % if error, return code ;E0'CLI.MAP_FILE : % number of bytes, CLI.MAP_FILE3 DUP C.REC_LENGTH @ NEZ_IF % if fixed records ...PI DUP C.REC_LENGTH @ / 1+ + % then add the size of all the terminatorsS THEND BOTOTOP SWAP D.EXPAND % enlarge the gap so that the file will fit+ .M @ % get page address of end of memory J DUP NOTE + RECALL SWAP CHAN @ MAP % map the file into the end of memory IF % did it work? DDUP % save the addressesM DROP 7 FIL_EBK 1- 200 * 7 FIL_FFB + OVER + SWAP % provide an end address 3 DUP FIRST_BYTE ! % save the first byte addressI/ C.PROCESS_RECORDS % addresses are on stacke DELTVA % delete the space, MAPCLOSE % and deassign the I/O channel ELSEA UNDROP 1CC EQ_IF % is it a not-structured-for-mapping error?h4 MAPCLOSE DROP % close file and assume successC TOPOTOP FILE_NAME COUNT F.LOAD % forward operation to F.LOADI5 ELSE % if it's not that, we've failed completely ' UNDROP % get the error code backl THEN THEN % return code if error ; D% Note: this next word is rather hasty in deciding that it can't mapA% certain types of files. Stream formats could be mapped easily; B% this is just a quick fix becuse RED doesn't work with them rightA% now. I don't think there's any better excuse for excluding theOA% BLK record attribute either; this could be figured out somehow. 1% First look for indicators that we can't map it. 'F.MAP_CHECK :L 7 FIL_RAT 8 AND NEZ % BLK record attribute is not implemented for mapping= 7 FIL_RFM DUP 4 EQ % we can't map stream formats right now/ OVER 6 EQ OR % including CR types of streams ( SWAP 5 EQ OR % or LF types of streams OR % were any of these true?  ;O'F.GET_FILE_DATA_AUX :4 7 FIL_RAT DUP REC_ATT ! % get record attributes0 OK_TO_MAP -1<- % signal that it's OK to map; 3 AND NEZ % returns true if rec. attr. = CR or FORTRANiD REC_SEP SWAP IF CRET <- ELSE USEP <- THEN % determine separator- 7 FIL_EBK 1- % get number of full blockse+ 200 * 7 FIL_FFB + % get size necessaryNH 7 FIL_FSZ DUP FSIZE ! % get size of control field so we can omit it: GTZ_IF 0D REC_SEP ! THEN % if cr. control, specify CR4 7 FIL_RFM 1 EQ_IF % is the record format fixed?< 7 FIL_MRS C.REC_LENGTH ! % if so, find out what it is ELSE C.REC_LENGTH 0<- THEN ;N'F.GET_FILE_DATA : F.MAP_CHECK IF OK_TO_MAP 0<-C ELSE F.GET_FILE_DATA_AUXE THEN ;e 'F.BLK_LOAD :@ 6 .OPEN IF F.GET_FILE_DATAe7 DUP GEZ IF % is there anything at all in the file?  CLI.READ_FILER ELSED DROP 6 CLOSE -1 % nothing in file; close it again and succeed THEN ELSE UNDROP % error opening file THEN ;0'F.PUT : % string descr., .PUT, condition code% (outputs string to channel 2)oA% (on extend error, pauses with a RED error message and retries)i> DDUP 2 .PUT IF % save string descriptor, write, successful?) 2DROP -1 ELSE % yes, drop descriptorE4 UNDROP 1C022 EQ_IF % is it a file_extend error?. ERR.EXTEND ERR.MSG % pause with message+ 2 .PUT ELSE % yes, try one more time2L UNDROP NOTE 2DROP RECALL THEN % no, drop string descriptor, save code THEN ; 'DUMP_RECORD :& 1 BOT_COUNT NEZ_IF % anything left?; UNDROP SFSEP DUP NOTE % yes, get next line, save lengths 1- % remove its separator" F.PUT IF % write, successfulB RECALL MOVE_UP 0 ELSE % yes, move line up, continue looping? UNDROP ERR.IOERR % no, retrieve RMS error, add RED error%" -1 THEN ELSE % stop looping: 2DROP -1 -1 THEN % end of file, stop looping, success ;,M'F.DUMP : % filename descriptor, F.DUMP, (success) or (RMS error, RED error)c4 TOPOTOP D@- MOVE_DOWN % put entire file in bottom! TOPOBOT RBE IF % get last byte , DUP TOPOBOT ABE % succeded, put it back# REC_SEP @ NE_IF % was it a CR? 4 REC_SEP @ TOPOBOT ABE THEN THEN % no, add oneC REC_ATT @ 1 EQ_IF 2 .WOPEN_FTN % if Fortran, use special routineB ELSEG 2 REC_SEP @ CRET EQ_IF3Z<~ REDBUILD.BAK* [SAOSTOIC.RED]CLI.;35OBJ;2Mbt| .WOPEN ELSE .WOPEN_NCR THEN % open the file, THEN IF BEGIN % loop, writing lines DUMP_RECORDr/ CTRL_C_FLAG @ OR % also end if control-C  ENDr 2 CLOSE  ELSEF UNDROP ERR.OPFAIL % open error, retrieve RMS error, add RED error THEN DUP NOT IF % error?/ SWAP SYSMSG TYPE % yes, output RMS message. ELSEE CTRL_C_FLAG @ IF DROP ERR.NOTWRT THEN % replace with error if ^Cb+ THEN CTRL_C_FLAG 0<- % clear flag anyway  ; 'F.MAP_LOAD : F DDUP C.NEWSTR .MOVE_STRING % save the file name in an unused buffer MAPOPEN IF" CHAN ! % store channel number F.GET_FILE_DATA%D OK_TO_MAP @ IF % has get_file_data signaled it can't handle it? DUP GEZ_IF CLI.MAP_FILE ELSE DROP MAPCLOSE THEN ELSE= MAPCLOSE DROP % close file immediately; assume success@ TOPOTOP C.NEWSTR COUNT F.LOAD % use normal F.LOAD routine THEN ELSE UNDROP % get error code< 1C144 EQ_IF % is it a not-supported-over-network error?I TOPOTOP C.NEWSTR COUNT F.LOAD % if so, forward operation to F.LOAD4 ELSE UNDROP % otherwise simply return the error THEN THEN ;O''F.OPEN_FILE : % used for OPEN commandF F.MAP_LOAD % get the file4 TOPOTOP D@- MOVE_DOWN % put file in bottom buffer9 REC_SEP @ MAIN_SEP ! % and remember the main separator=. REC_ATT @ MAIN_ATT ! % and record attribute ;E8'F.WRITE : % performs F.DUMP with main record separator+ MAIN_SEP @ REC_SEP ! % get the separatorG' MAIN_ATT @ REC_ATT ! % and attribute  F.DUMP ;h % Support words for "X" commandsA0 'X.BYTES VARIABLE % true means interpret count as a byte count D0 'X.INSERT VARIABLE % true means don't kill buffer before transfer-'X.GNB : % X.GNB, [byte, -1] or [error code]+9% (gets command subcode, also interprets B and I options)n X.INSERT 0<- X.BYTES 0<- BEGIN CLI.GNB IF CONVERT_TO_UPPER' ASCII B EQ_IF X.BYTES -1<- 0 ELSEs1 UNDROP ASCII I EQ_IF X.INSERT -1<- 0 ELSE % UNDROP -1 -1 THEN THEN ELSE  0 -1 THENO END ;L='X.PUSH : % buffer #, X.PUSH (old buffer # saved on L stack)s) BUFFER# @ SWAP % save present buffer #_ DDUP NE IF % are they equal?r; DUP BUFFER# ! 10 * X0 + CURBUF ! NOTE -1 ELSE % no, pusha% 2DROP ERR.INVARG THEN % yes, errora ;e'X.POP : % XPOP) RECALL DUP BUFFER# ! 10 * X0 + CURBUF !l ; +'X.KILL : % X.KILL (kills current buffer)n TOPOTOP BOTOTOP MOVE BOTOBOT TOPOBOT MOVE ;I>'X.PRECOPY : % PRECOPY, [string descriptor, -1 or error code]? C.ARG @ BUFFER# @ EQ_IF ERR.INVARG ELSE % not to same buffer ; C.XARG @ LEZ_IF ERR.INVARG ELSE % only forward for nown3 C.XARG @ X.BYTES @ NOT IF % lines or bytes?s< BOT_COUNT SFCR UNDER THEN % lines, convert to bytes -1 THEN THEN % successO ;B % % Argumentsr='C.@A : % return value of most recent numeric macro argument 7 MSTACK DUP W@ + 1+ B@ % get the return buffer numbera' 77 EQ_IF % is it the original value?E# ERR.NOTMAC % yes, return errori ELSE, MSTACK DUP W@ + 4- @ % get the argument) DUP C.ARG ! % put it in the argument  LTZ_IF % is it negative?i4 C.SIGN -1<- C.ARG @ MINUS C.MAG ! % set it up ELSE5 C.SIGN 1<- C.ARG @ C.MAG ! % else just copy ite) THEN C.ARG_EXISTS -1<- % preserve itB$ -1 % and return a success value THEN ; A'C.@C : % return value of current character number (starts at 0) 6 TOPOTOP D@- % get number of characters above cursor> DUP C.ARG ! C.MAG ! C.SIGN 1<- % set it up in the variables -1 % always succeed ; 5'C.@K : % get a byte from the keyboard (with prompt) DISP_FLUSH FLUSH+ TYPEKEY_MSG S.CUP FLUSH % display prompt& TYI DUP 08 EQ_IF % accept backspace* DROP TYI 40 - % adjust next character THEN# CLI.LOAD_ARG % fix the argumentsOB DRAW_DIVIDER TIME_FLAG @ IF S.CPU_TIME THEN FLUSH % fix divider -1 % always succeed ;r%'C.@L : % return current line number # 0 TOP_COUNT ( % loop through topU1 DUP I + B@ CRET EQ_IF % is the character CR? * SWAP 1+ SWAP % yes, increment count THEN. ) DROP CLI.LOAD_ARG % argument is @ of cr's -1 % return success ;t+'C.@N : % input a number from the keyboardo DISP_FLUSH FLUSH3 NUMBER_MSG 0 % type message and initialize valueo$ C.SIGN 1<- % initialize sign to 15 TYI DUP ASCII - EQ_IF % get a byte, is it a minus?1K ASCII - TYO C.SIGN -1<- DROP TYI % yes, set sign to -1 and get anotherE THEN( BEGIN % loop until non-number key hit& DUP ASCII 0 LE OVER ASCII 9 GE AND IF % is it a number?M DUP TYO ASCII 0 - SWAP 0A * + TYI 0 % adjust total, get byte, continues ELSE DROP -1 % otherwise end THEN> END C.SIGN @ * CLI.LOAD_ARG % fix sign, set up the argumentB DRAW_DIVIDER TIME_FLAG @ IF S.CPU_TIME THEN FLUSH % fix divider -1 % always succeed ;l.'C.@P : % pop top of user stack into argument+ USER_STACK W@ EQZ_IF % nothing on stack? # ERR.STKUDF % yes; return errorh ELSE: USER_STACK DUP W@ + 2- @ CLI.LOAD_ARG % get the value4 USER_STACK DUP W@ 4- W<- % and adjust the count -1 % succeed  THEN ;w3'C.@Q : % return top of user stack without poppingr USER_STACK W@ EQZ_IF ERR.STKUDF ELSE; USER_STACK DUP W@ + 2- @ CLI.LOAD_ARG % just get valuek -1 % succeedt THEN ; 2'C.@T : % return ASCII value of current character3 TOPOBOT D@- % get number of characters in bottomI NEZ_IF! TOPOBOT @ B@ % get the value 8 DUP C.ARG ! C.MAG ! C.SIGN 1<- % fill the variables -1 % and succeedr ELSE, ERR.@TEND % @T illegal at end of buffer THEN ;GA% Definition of new argument reader that checks for symbolic argst 'CLI.RLOAD : CONVERT_TO_UPPER DUP ASCII A LE OVER ASCII Z GE AND IF % is it a letter? D ASCII A - 4 * NUM_REGS + @ CLI.LOAD_ARG % yes, get the register -1 % and succeedI ELSE' DROP ERR.INVREG % invalid register  THEN ;%2'CLI.# : % retrieve contents of a number register C.ARG_EXISTS -1<-d' CLI.GNB % get the register-name byte  IF % is there one?l CLI.RLOAD  ELSE ERR.INVREG  THEN ;o'CLI.ARG_BYTE :  C.ARG_EXISTS -1<-E CONVERT_TO_UPPER ; /'CLI.@ : % process an argument starting with @ CLI.GNB IF CLI.ARG_BYTE DISPATCH 'A C.@A DISPATCH 'C C.@C DISPATCH 'K C.@K DISPATCH 'L C.@L DISPATCH 'N C.@N DISPATCH 'P C.@P DISPATCH 'Q C.@Q DISPATCH 'T C.@T+ DROP ERR.NOARG % error if unrecognizedE ELSE' ERR.NOARG % return error if just @  THEN ;s>'C.DBL_QUOTE : % make following ASCII character into argument CLI.GNB % get the next byte IF= DUP C.ARG ! C.MAG ! C.SIGN 1<- % put it in the variablese1 C.ARG_EXISTS -1<- % don't let CLI replace itt -1 % and succeedF ELSE6 ERR.INVARG % no character there; invalid argument THEN ;p 'CLI.GETARG : 6 C.DEFAULT? 0<- % argument will want to be preserved- CLI.GNB % get a byte from the command line  IF DISPATCH '# CLI.#o DISPATCH '@ CLI.@N DISPATCH 22 C.DBL_QUOTEdJ DROP CLI.BACK CLI.NUMARG -1 % not symbolic; read an integer & succeed ELSEH C.MAG 1<- C.ARG 1<- C.SIGN 1<- -1 % default argument is +1; succeed THEN ; 'CLI.READ_STRING : CLI.POS 0F BEGIN% CLI.GNB IF A EQ_IF % terminator? -1 ELSE 1+ 0 THEN ELSE -1R THEN ENDR DUP C.ARGLEN !) SWAP KBUF @ + SWAP % make a descriptor ;D'CLI.GET_STR_ARG :, CURKBUF @ % push the current kbuf pointerC MSTACK DUP W@ + 1+ B@ 10 * K0 + CURKBUF ! % switch to old bufferr& CLI.POS % push the current position/ C.ARG @ ( % loop to discard non-useful stufft BEGIN * CLI.GNB IF % is there another byte?, LFEED EQ % exit if it's a line feed* ELSE -1 % also exit if nothing left THEN ENDP )N6 CLI.READ_STRING % read the useful string descriptor9 -ROT CLI.POS SWAP - CLI.MOVE_DOWN % restore key bufferl/ -ROT CURKBUF ! % get the old key buffer backs ; ='CLI.REFARG : % return an argument from calling command line1 CLI.GETARG IF % get an argument for the numberIC MSTACK DUP W@ + B@ 1- C.ARG @ LE_IF % not exceeded declared #?  CLI.GET_STR_ARGS ELSE< ERR.STRWRN ERR.MSG CURKBUF @ 8+ @ 0 % display warning THEN* ELSE ERR.STRWRN ERR.MSG CURKBUF @ 8+ @ 0 THEN C.ARG_EXISTS 0<-  ;a'CLI.INPUT_BUFFER :L? DUP ASCII 0 LE OVER ASCII 9 GE AND IF % is it a legal bufferu- ASCII 0 - X.PUSH IF % can we push to it? ( TOPOTOP D@- MOVE_DOWN % go to top8 TOPOBOT DUP @ SWAP D@- % make a descriptor for it X.POP % and come back= ELSE ERR.STRWRN ERR.MSG CURKBUF @ 8+ @ 0 % X.PUSH failedN THEN ELSE> DROP ERR.STRWRN ERR.MSG CURKBUF @ 8+ @ 0 % illegal buffer THEN ;S'CLI.LOAD_BUFFER :0 CLI.GNB IF % get a byte for the buffer number CLI.INPUT_BUFFER ELSED ERR.STRWRN ERR.MSG CURKBUF @ 8+ @ 0 % no byte for buffer number THEN ;F3'CLI.SARG : % process string after control-G foundU% CLI.GNB IF % get another byte, ok?r4 ASCII @ EQ_IF % is it a signal to use a buffer? CLI.LOAD_BUFFERA ELSE3 CLI.BACK MSTACK W@ 1 NE_IF % are we a macro?b2 CLI.REFARG % yes, get the string argument ELSE@ ERR.STRWRN ERR.MSG CURKBUF @ 8+ @ 0 % else type warning THEN THEN> ELSE ERR.STRWRN ERR.MSG CURKBUF @ 8+ @ 0 % no byte after ^G THEN ;o0'CLI.GETSTRING : % CLI.GETSTRING, string descr.& C.ARG @ % save the command argument CLI.GNB IF% 07 EQ_IF % is the first byte ^G? + CLI.SARG % yes, do something special  ELSE1 CLI.BACK CLI.READ_STRING % read the string  THEN ELSE0 KBUF @ CLI.POS + 0 % make a null descriptor+ C.ARGLEN 0<- % and zero the arg lengthB+ THEN -ROT C.ARG ! % restore the argument_ ;P % Execution of 2-letter commands'C.GW : % Open new file O.K._TO_OPEN? IF$ REC_SEP CRET <- MAIN_SEP CRET <-& CLI.GETSTRING % get new file name- FILE_NAME .MOVE_STRING % "open" new filef: SETSCREEN DISP -1 ELSE % initialize buffer and screen! UNDROP THEN % retrieve errore ;r'C.GX : % Discard current file! BUFFER# @ EQZ_IF % buffer 0?O' 0 FILE_NAME W! % yes, discard name X.KILL % discard buffer# SETSCREEN DISP % redraw screen" -1 ELSE % fix screen, succeed* ERR.X0ONLY THEN % wrong buffer, error ;O''C.T# : % set number register to value[ C.ARG @ % save the argument CLI.GNB % get a byte  IF % was there one?0 CONVERT_TO_UPPER DUP % get the ascii number5 ASCII A LE OVER ASCII Z GE AND % is it a letter?E IF: ASCII A - 4 * NUM_REGS + ! % yes, load the argument0 C.ARG_EXISTS 0<- % and don't hang onto it -1 % succeedr ELSE@ DROP ERR.INVREG % drop argument, fail if illegal register THEN ELSE3 DROP ERR.INVREG % no register name; type error  THEN ;g'C.T : % toggle tab mode# TAB_MODE @ NOT TAB_MODE ! DISP -1A ;P'C.TB : % output bell BELL -1 % ring bell, succeedn ;a&'C.TC : % replace character at cursor) TOPOBOT D@- NEZ_IF % at end of buffer?s' 1 C..D DROP % delete one characterG; C.ARG @ MARK RECALL 1 C.I+ DROP % make string & insert * 1 C.M- % move back to be on top of it -1 % return success ELSE* ERR.TC@END % TC illegal at end/buffer THEN ; 'C.TF : % set display windowc C.ARGLEN @ EQZ_IF % default?R 8 ELSE % yes, make it 84 C.ARG @ 0A MIN 1 MAX THEN % keep it within bounds7 TF ! SELECT_COMMAND % reset command scrolling region SETSCREEN DISP -1  ;E'C.TI : % set radix ERR.NOTIMP ; *'C.TP : % push value of argument on stack3 USER_STACK W@ USER_STACKSIZE EQ_IF % stack full?G# ERR.STKOVF % yes, return errorR ELSE- USER_STACK DUP W@ + 2+ % get the address C.ARG @ <- % load the value4 USER_STACK DUP W@ 4+ W<- % and adjust the count -1 % succeed THEN ;@ E % F commands'C.FI : % file insert"% TOPOTOP CLI.GETSTRING F.LOAD IF CLI.GETSTRING F.MAP_LOAD IFR DISP -1 ELSE UNDROP CR SYSMSG TYPEc ERR.OPFAIL THEN  ;p'C.FO : % file output CLI.GETSTRING F.DUMP DISP ;G % Arithmetic commandsi('C.ADD : % add current argument to next C.ARG @ % save our argument CLI.GETARG % and get another  IF C.ARG @ + CLI.LOAD_ARG -1 % return success ELSE+ UNDROP SWAP DROP % save the error codeb THEN C.ARG_EXISTS -1<- ;O 'C.SUBTRACT :  C.ARG @ % save our argument CLI.GETARG % and get another  IF C.ARG @ - CLI.LOAD_ARG -1 % return success ELSE+ UNDROP SWAP DROP % save the error codeL THEN C.ARG_EXISTS -1<- ;  u 'C.MULTIPLY :D C.ARG @ % save our argument CLI.GETARG % and get anotherl IF C.ARG @ * CLI.LOAD_ARG -1 % return success ELSE+ UNDROP SWAP DROP % save the error code  THEN C.ARG_EXISTS -1<- ;  o 'C.DIVIDE :  C.ARG @ % save our argument CLI.GETARG % and get anotherS IF C.ARG @ / CLI.LOAD_ARG -1 % return success ELSE+ UNDROP SWAP DROP % save the error codec THEN C.ARG_EXISTS -1<- ;K'C.AND : C.ARG @ % save our argument CLI.GETARG % and get another  IF C.ARG @ AND CLI.LOAD_ARG -1 % return success ELSE+ UNDROP SWAP DROP % save the error codeO THEN C.ARG_EXISTS -1<- ;r'C.IOR : C.ARG @ % save our argument CLI.GETARG % and get another. IF C.ARG @ OR CLI.LOAD_ARGl -1 % return success ELSE+ UNDROP SWAP DROP % save the error coder THEN C.ARG_EXISTS -1<- ;o'C.XOR : C.ARG @ % save our argument CLI.GETARG % and get anotherR IF C.ARG @ XOR CLI.LOAD_ARG -1 % return success ELSE+ UNDROP SWAP DROP % save the error code_ THEN C.ARG_EXISTS -1<- ; 'C.< : C.ARG @ % save our argument CLI.GETARG % and get anotherH IF C.ARG @ SWAP LT CLI.LOAD_ARG -1 % return success ELSE+ UNDROP SWAP DROP % save the error codee THEN C.ARG_EXISTS -1<- ;'C.> : C.ARG @ % save our argument CLI.GETARG % and get anotherR IF C.ARG @ SWAP GT CLI.LOAD_ARG -1 % return success ELSE+ UNDROP SWAP DROP % save the error code_ THEN C.ARG_EXISTS -1<- ; $'C.? : % return value of error flag+ ERR_FLAG @ CLI.LOAD_ARG % load the value " C.ARG_EXISTS -1<- % preserve it -1 % succeedH ;.'C.= : C.ARG @ % save our argument CLI.GETARG % and get anotherr IF C.ARG @ EQ CLI.LOAD_ARGs -1 % return success ELSE+ UNDROP SWAP DROP % save the error code% THEN C.ARG_EXISTS -1<- ;U .% Execution of "X" commandsu''C.XC : % copy lines to special buffer<0 X.PRECOPY IF % get length of string, success?4 C.ARG @ X.PUSH DROP % make other buffer currentD X.INSERT @ NOT IF X.KILL THEN % kill unless insert is specified; BOTOTOP OVER D.EXPAND % make sure there is enough roomm- X.POP TOPOBOT @ OVER % string descriptoro2 C.ARG @ X.PUSH DROP TOPOTOP ASE % move string< X.POP C.M+ -1 ELSE % revert to original buffer, succeed' UNDROP THEN % failure, return code. ;<"'C.XD : % display special buffers> TF @ 8 TF ! SETSCREEN DISP_FLUSH % save TF, erase text pane 1 1 CUP D.DISP % display info& ERR.TYPCR ERR.MSG % wait for signal' TF ! SETSCREEN DISP -1 % redraw text- ; 'C.GET_XG_INFO :0 TOPOTOP D@- MOVE_DOWN % consolidate in bottom- TOPOBOT D@- % length of string to be moved 7 C.XARG @ * % multiply by number of copies to be made 4 DUP MINUS C.STRLEN ! % save the count in C.STRLEN" X.POP % back to original buffer ; "'C.XG : % get from special buffer) C.ARG @ X.PUSH IF % go to other buffera C.GET_XG_INFO ; BOTOTOP SWAP D.EXPAND % make sure there is enough room K C.ARG @ X.PUSH DROP BOT_COUNT X.POP % descriptor of string to be movedhL DDUP CR_COUNT C.XARG @ * CHECK_INSERT_STRING % check for screen refresh C.XARG @ ( % do it n times * DDUP C.I+ ) 2DROP % move the string -1 ELSE  ERR.INVARG THENi ;m'C.XK : % kill special buffer C.ARG @ X.PUSH IFn' X.KILL X.POP -1 SETSCREEN DISP ELSE + ERR.INVARG THEN % fails if same buffer #. ;T''C.XM : % copy lines to special bufferC0 X.PRECOPY IF % get length of string, success?4 C.ARG @ X.PUSH DROP % make other buffer currentD X.INSERT @ NOT IF X.KILL THEN % kill unless insert is specified; BOTOTOP OVER D.EXPAND % make sure there is enough room - X.POP TOPOBOT @ OVER % string descriptorD2 C.ARG @ X.PUSH DROP TOPOTOP ASE % move string< X.POP C.D+ -1 ELSE % revert to original buffer, succeed' UNDROP THEN % failure, return code. ;f'C.XS : % switch to buffer #P4 C.ARGLEN @ EQZ_IF 0 ELSE % default is zero for XS C.ARG @ THEN$ SET_BUFFER# % yes, switch buffers< ASCII ~ TOPUSH TOPOP 2DROP % force materialization of gap DISP -1W ;R C=% Execution of 1-letter commands or dispatch on second letterCG'CLI.SKIP_SARGS : % number/args, CLI.SKIP_SARGS: throws away that manyt) ( BEGIN % loop to get rid of argumentsa CLI.GNB IF LFEED EQ_IFD! -1 % exit if line feedM ELSE 0 THENr' ELSE -1 THEN % exit if no string, ENDs )  ;e+'POP_KBUF : % return from executing bufferB; MSTACK DUP W@ + 1+ B@ % look at the return buffer numberE+ DUP 77 NE_IF % is it the original value?t@ DUP KBUF# ! 10 * K0 + CURKBUF ! % no, start executing there5 MSTACK DUP W@ + B@ % get the number of argumentsL1 MSTACK DUP W@ 6 - W<- % pop the buffer stack 1 CLI.SKIP_SARGS % and skip over the argumentsE -1 % and return success ELSE/ DROP 0 % pop was done from K0; return failP THEN ;e 'C.CTRL/E :t C.ARG @ NEZ_IFM POP_KBUF % pop the key buffer; get our success value from its error code  ELSE; -1 % just succeed if we're not supposed to do anything THEN ;N1'C.CTRL/G : % declare number of string argumentsE5 MSTACK W@ 1 EQ_IF % only one thing on macro stack?G ERR.^GFKBD % yes, failS ELSE; MSTACK DUP W@ + C.ARG @ B<- % store argument otherwise% -1 % succeed  THEN ; 'C.TAB : % insert SPACE_FLAG @ IF_8 CLI.GETSTRING 1+ SWAP 1- SWAP % include leading tab -1 C..I % insert string ELSE -1 THEN ;w*'C.CTRL/W : % insert argument as a number> RADIX @ NOTE DECIMAL % save the radix and switch to decimal# C.ARG @ <#> % convert the number  -1 C..I % insert it* RECALL RADIX ! % get the old radix back ;'C.LINE_FEED : % no action  -1 ;u'C.CAR_RET : % no actionI -1 ; 'C.SPACE : % insert, SPACE_FLAG @ IF % should we do an insert?: CLI.GETSTRING 1+ SWAP 1- SWAP % include leading blank -1 C..I % insert string ELSE. -1 % if no insert, do nothing and succeed THEN ;i r*% Comma command: high-efficiency QIO inputC% The next word is the basic input routine. It accepts up to ^x100eD% bytes of text, inserts them into the buffer, updates the TOPWINDOWA% variable, and returns the terminator byte on the stack. If thea9% input stops because the buffer is full, -1 is returned. 'INPUT_TEXT :%2 C.NEWSTR 2+ 100 GETLINE % read text into buffer0 DUP TOPWINDOW +! % fix window extent variable- C.NEWSTR W! % save count of string read inc> C.NEWSTR COUNT E.I+ % silently insert text into text buffer4 C.NEWSTR W@ 100 EQ_IF % was the buffer filled up?, -1 % if so, return -1 as the terminator ELSE; C.NEWSTR COUNT + B@ % otherwise pick up the terminatorL7 THEN FIND_CURSOR % and we need to look up the cursorE ;PC% A routine using INPUT_TEXT must know what action it wants to takes?% given various possible terminators. These are the terminatorFE% dispatches for "INPUT MODE". They return values indicating whetherR% to leave input mode. 'C.INPUT_CR : A CRET MARK RECALL 1 C.I+ DROP % insert a CR, with screen update ! 0 % signal to INPUT_TEXT again ;H 'C.INPUT_LF : 6 -1 % don't insert anything, but exit the input loop ;F'C.INPUT_DEL : % delete4 BOTOTOP @ 1- B@ % get the character to be deletedA DUP 09 EQ SWAP CRET EQ OR IF % is it a tab or carriage return?E6 1 C.D- % for either of those, do a regular delete ELSE? 1 E.D- % it's not; invisibly delete the last byte insertede, TOPWINDOW 1-! % fix the window variable: 08 TYO 20 TYO 08 TYO % and rub out the last character THEN 0 % stay in the input loopc ;'C.INPUT_BACK : % backspace: TYI 1F AND % get the next character and make it control& MARK RECALL 1 C.I+ DROP % insert it 0 % stay in the input loop  ;n/'C.INPUT_OVF : % input filled the input buffere( 0 % doesn't matter ... go do it again ;@'C.INP_DISPATCH : % input terminator, C.INP_DISPATCH, halt code DISPATCH 08 C.INPUT_BACK DISPATCH 0A C.INPUT_LF DISPATCH 0D C.INPUT_CR DISPATCH 7F C.INPUT_DEL  DISPATCH -1 C.INPUT_OVFN? MARK RECALL 1 C.I+ DROP % insert the control character typedu" 0 % signal not to end the input ;eE% End of input mode dispatches. This next word makes sure the cursor 2% is on the end of a line so INPUT MODE can begin.E'C.INPUT_POS : % a comma command has been typed; position the cursor.0 BOPOP IF % are we not at the end of the file?) DUP BOPUSH % put the first byte backL2 0D NE_IF % is this already the end of a line?= CRET MARK RECALL 1 C.I+ DROP % if not, end a line here ? 1 C.M- % and move back to be at the end of the last lineC THEN? THEN % if end of buffer, treat it as end of line: do nothinge ;e% Input mode access word#'C.COMMA : % high-efficiency input%& ERASE_COMMAND "INPUT MODE" MSG S.CUP- C.INPUT_POS % position the cursor properlyG! DISP_FLUSH % update the screen/ BEGIN % loop until someone says to terminateHA INPUT_TEXT % read a line until control char or gets too longt? C.INP_DISPATCH % decide what to do based on the terminator. END % end input mode loop2 FIND_CURSOR DRAW_COMMAND % fix the command area -1 ;H'REPL_NY : 0 0 ;'REPL_YY : 0 -1 ; 4'REPL_NN : -1 -1 0 ; % (if exiting, return success) 'REPL_DISP : BEGIN  TYI % get a key> DISPATCH 0A REPL_NY % line feed: no replace, yes continueE DISPATCH 0D REPL_YY % carriage return: yes replace, yes continuel< DISPATCH 1B REPL_YY % escape: yes replace, yes continue; DISPATCH 20 REPL_NN % space: don't replace or continue* DROP BELL 0 % otherwise beep and loop ENDA ; 'GET_REPLACE_OPTION :  DISP_FLUSH FLUSH& COND_REPLACE_MSG % say "type a key" S.CUP FLUSHA REPL_DISPe ;e'CLI.COND_REPLACE :G% CLI.GETSTRING C.OLDSTR .MOVE_STRING"% CLI.GETSTRING C.NEWSTR .MOVE_STRINGo BEGIN % loop until finished2 C.OLDSTR COUNT 1 C..S % search for the string IF % did we find it?r GET_REPLACE_OPTION ELSE< ERR.NOSTRN -1 0 % no replace, exit, fail if no string THEN IF % replace?8 C.STRLEN @ DUP C..D DROP % do deletion with count+ C.NEWSTR COUNT % get the replacementv# -ROT C..I DROP % and replacee THEN END % exit or continue loop DRAW_COMMAND DRAW_DIVIDERd8 TIME_FLAG @ IF S.CPU_TIME THEN CR FLUSH % fix divider ;EE'SWITCH_KBUF : % argument, (buffer # in C.ARG), SWITCH_KBUF, successa3 MSTACK DUP W@ + 2+ ! % push the numeric argument!. MSTACK DUP W@ 4+ W<- % and change the count> 0 MSTACK STAB % push a 0 for the number of string argumentsC KBUF# @ MSTACK STAB % push the current buffer on the macro stackpC C.ARG @ 2+ DUP KBUF# ! 10 * K0 + CURKBUF ! % set up the pointerse8 CLI.INIT % initialize this buffer for command reading -1 % return success ;c 'C.: : % execute special buffer# C.ARG @ % hang onto the argument % CLI.GETARG % get the buffer numbere- C.ARG_EXISTS 0<- % don't save the argument  IF; C.ARG @ DUP 9 GE SWAP 0 LE AND % is it a legal buffer?O IF7 MACRO_STACKSIZE MSTACK W@ GE % macro stack full?  IF DROP ERR.MACOVF ELSE SWITCH_KBUFt THEN ELSE- DROP ERR.INVARG % illegal buffer; failc THEN ELSE< UNDROP SWAP DROP % save the error code if GETARG failed THEN ; 'C.; : % branch* CLI.GNB % get a byte for the label name IF CONVERT_TO_UPPER, C.ARG @ NEZ_IF % should we do anything?0 CLI.INIT % go to beginning of this buffer CLI.FIND_LABEL IF % did we find it?s5 -1 % yes; signal success and start from heree ELSE' ERR.NOLAB % no; signal failured THEN1 ELSE DROP -1 % argument is 0; return success THEN ELSE5 ERR.INVBRN % no label byte so say invalid branchT THEN ;e#'C.B : % go to beginning of bufferc TOPOTOP D@- MOVE_DOWNN DISP -1  ; 'C.C : % change5 CLI.GETSTRING C.ARG @ C..S IF % search successful?f0 C.STRLEN @ DUP C..D DROP % yes, do deletion5 CLI.GETSTRING % get a string from the input linef; DUP C.SIGN @ * C.STRLEN ! % save the new string length_$ -ROT C..I ELSE % do replacementI UNDROP CLI.GETSTRING 2DROP THEN % no, retain error code, skip string  ;N'C.D : % delete characters 5 C.ARG @ DUP CLI.MOVE_ERROR % check for minor error  C..D ;H!'C.E : % set error suppress flag  ERR_SUPPRESS -1<-  -1 ; +'C.F : % F-command, needs second character CLI.GNB IF CONVERT_TO_UPPER DISPATCH 'I C.FI DISPATCH 'O C.FO THEN DROP ERR.INVCOM ;U+'C.G : % G-command, needs second characterK$ CLI.GNB IF % any more characters? CONVERT_TO_UPPER DISPATCH 'W C.GW DISPATCH 'X C.GX THEN ERR.INVCOMk ;e'C.H : % home% FILE_NAME W@ EQZ_IF % file active? % RESET_TERMINALo% WAIT_FOR_RESETi, RESTORE_VT100 1 1 CUP ERASE_SCREEN FLUSHE LOAD_RESET E.RESET_CHARS ;F -1 ELSE % no, reset screen, exit bigs ERR.ACTIVE THEN ;1'C.I : % insert text 3 C.DEFAULT? @ IF % is there an explicit argument?/3 CLI.GETSTRING -1 C..I % no; add the string argW ELSEJ C.ARG @ MARK RECALL 1 -1 C..I % else make a string arg of the numeric% UNDER % and clear out the numbere THEN ;e'C.J : % journalc O.K._TO_CLOSE? IF0 TOPOBOT D@- NOTE % remember cursor position= FILE_NAME COUNT CLI.REMVER % file name without version #i F.WRITE7 RECALL MOVE_DOWN DISP ELSE % reset cursor positionu& UNDROP THEN % retrieve error code ;a,'C..J : % delete latest version and journal O.K._TO_CLOSE? IFe. FILE_NAME COUNT 7 ERASE % delete the file IF TOPOBOT D@- NOTE FILE_NAME COUNT CLI.REMVER F.WRITER IF RECALL MOVE_DOWN DISP -1 ELSE UNDROP RECALL DROP THEN ELSEG UNDROP SYSMSG TYPE ERR.OPFAIL % if error, type and add RED errorC THEN ELSE UNDROP THEN ;n'C.K : % kill n lines C.ARG @ GTZ_IF % get countm4 UNDROP DUP CLI.MOVE_ERROR % check for minor error= BOT_COUNT SFCR DUP E.D+ D.D+ ELSE % delete n lines forwardE UNDROP MINUS 1+ @ TOP_COUNT SRCR DUP E.D- D.D- THEN % delete 1-n lines backward -1 % always succeed ;R R,% Execution of 1-letter commands (continued)'C.L : % move n lines C.ARG @ GTZ_IF % get count 6 UNDROP DUP CLI.MOVE_ERROR % check for minor error% C.L+ ELSE % move n lines forwardR8 UNDROP MINUS 1+ C.L- THEN % move 1-n lines backward -1 % always succeed ;C'C.M : % move n charactersrB C.ARG @ DUP NEZ_IF % get count, ignore command if count is zero< DUP CLI.MOVE_ERROR % see if there will be a minor error GTZ_IF3 UNDROP C.M+ ELSE % move n characters forwardh< UNDROP MINUS C.M- THEN % move -n characters backwards ELSE DROP  THEN -1 % always succeed ;e'C.O : % open fileO O.K._TO_OPEN? IFB CLI.GETSTRING FILE_NAME .MOVE_STRING % yes, install file name* X.KILL % get rid of previous contents" FILE_NAME COUNT F.OPEN_FILE IF SETSCREEN DISP -1e ELSE % success 1 UNDROP 18292 EQ_IF % is it file-not-found?.< SETSCREEN DISP ERR.NEWFIL % if so, flash "new file" ELSED UNDROP SELECT_COMMAND SYSMSG TYPE ERR.OPFAIL % open failure FILE_NAME 0W<- THEN THEN ELSE UNDROP % retrieve error THEN ;t t-% Execution of 1-letter commands (continued)y'C.S : % search CLI.GETSTRING C.ARG @ C..S ;d+'C.T : % T-command, needs second character CLI.GNB IF CONVERT_TO_UPPER DISPATCH '# C.T# DISPATCH 09 C.T  DISPATCH 'B C.TB DISPATCH 'C C.TC DISPATCH 'F C.TF DISPATCH 'I C.TI DISPATCH 'P C.TP THEN DROP ERR.INVCOM ;c'C.U : % string replace/ C.STRLEN @ DUP LTZ_IF % forward or backward?i) MINUS C.D- % backward, delete stringh, CLI.GETSTRING C.I- ELSE % insert string NEZ_IF % anything there?e' UNDROP C.D+ % yes, delete string%3 CLI.GETSTRING C.I+ THEN THEN % insert string  -1 % always succeed ;r'C.W : % write current file O.K._TO_CLOSE? IFI FILE_NAME COUNT CLI.REMVER* F.WRITE DUP IF % write file, success?' X.KILL % yes, delete from buffers9 FILE_NAME 0W<- SETSCREEN THEN % null-out file nameF DISP ELSEl& UNDROP THEN % retrieve error code ;. o,% Execution of 1-letter commands (continued) 'C.XDISP :; C.ARG @ DUP GEZ SWAP 9 GE AND IF % is buffer # in range?P4 X.GNB IF % get second argument and command byte DISPATCH 'C C.XC DISPATCH 'D C.XD DISPATCH 'G C.XG DISPATCH 'K C.XK DISPATCH 'M C.XM DISPATCH 'S C.XS THEN DROP ERR.NOTIMP ELSE , ERR.INVARG THEN % buffer # out of range ;8'C.X : % special-buffer command, needs second character* C.ARG C.XARG MOVE % save first argument CLI.GETARG- C.ARG_EXISTS 0<- % don't save the argumentt IF C.XDISPO ELSE ERR.NOARGy THEN ; $'C.Z : % move to end of text buffer' TOPOBOT D@- GTZ_IF % already at end?P# UNDROP C.M+ THEN % no, do move  -1 % always succeed ;t#'C.[ : % opening iteration bracket D C.LOOP_COUNT @ 20 GE_IF % is there a huge number of nested loops?< ERR_SUPPRESS @ NOTE % save state of error suppress flag7 CURKBUF @ D@- NOTE % save position in command lineO) C.DEFAULT? @ IF % explicit argument?F0 FFFF ELSE % no, substitute a large number! C.ARG @ THEN % yes, use itU NOTE % save iteration count6 CURKBUF @ NOTE % save key buffer for verification/ C.LOOP_COUNT 1+! % add 1 to the loop counti -1 % always succeed ELSE ERR.LUPOVF THEN ;r'C.\ : % label definition+ CLI.GNB % read a byte for the label name; IF, LFEED EQ_IF % was the byte a line feed? ERR.INVLAB % yes; invalid ELSE$ -1 % return success otherwise THEN ELSE* ERR.INVLAB % invalid if no byte there) THEN % just ignore it if one was foundY ;e'CLI.RESET_LOOP :e" RECALL 1- DUP % iteration count1 GTZ C.ARG @ NEZ AND IF3!u~ REDBUILD.BAK* [SAOSTOIC.RED]CLI.;35BJ;3MAP;1MbZ % all done or drop out? 6 RECALL RECALL % get position, error suppress flagC DUP NOTE ERR_SUPPRESS ! DUP NOTE % set flag, put back positione; CURKBUF @ D@- SWAP - % and get the distance to back upG0 MINUS CLI.MOVE % move to the loop beginning# NOTE % restore iteration countI= CURKBUF @ NOTE % restore buffer pointer for verificationo ELSE- DROP % we don't need the iteration countL5 RECALL RECALL 2DROP % all done, clean loop stackc0 C.LOOP_COUNT 1-! % decrement the loop count THEN ; #'C.] : % closing iteration bracket 2 L_STACK_EMPTY? IF % anything on the loop stack? ERR.ITER ELSE % no, iteration error 6 RECALL CURKBUF @ EQ_IF % same buffer now as then? CLI.RESET_LOOP ELSEE ERR.INVSTR % iterations not nested within macros, return errore THEN -1 THEN % succeed ; *'C.^ : % replace counted character string* CLI.GETSTRING % get the string argument/ C.ARGLEN @ C..D DROP % delete the old string 6 1 C..I % insert string, use success value from C..I- C.ARGLEN @ C.M+ % move past the new stringp ;. 'C.NOT : % logical NOT+ C.ARG @ NOT % get the value* CLI.LOAD_ARG % load it into C.ARG, etc.0 C.ARG_EXISTS -1<- % keep it from being erased -1 % always succeed ;f'C.` : CLI.GNB IF CONVERT_TO_UPPER DISPATCH 'C CLI.COND_REPLACE DISPATCH 'J C..J DROP ERR.INVCOMm ELSE ERR.INVCOM THEN ;  E('CLI.DISP1 : % dispatch first character DISPATCH 0A C.LINE_FEED  DISPATCH 0D C.CAR_RET E C.ARG_EXISTS 0<- % not LF or CR; signal not to preserve argument  DISPATCH '? C.?  DISPATCH 05 C.CTRL/E DISPATCH 07 C.CTRL/G DISPATCH 09 C.TABA DISPATCH 17 C.CTRL/W DISPATCH 20 C.SPACEH DISPATCH 2C C.COMMAn DISPATCH '! C.IORb DISPATCH '% C.XOR DISPATCH '& C.ANDP DISPATCH '+ C.ADD  DISPATCH '- C.SUBTRACT DISPATCH '* C.MULTIPLY DISPATCH '/ C.DIVIDE DISPATCH '` C.`  DISPATCH ': C.:s DISPATCH '; C.;s DISPATCH '< C. C.>  DISPATCH 'B C.Bd DISPATCH 'C C.CE DISPATCH 'D C.Di DISPATCH 'E C.E DISPATCH 'F C.F  DISPATCH 'G C.Gl DISPATCH 'H C.Hb DISPATCH 'I C.I DISPATCH 'J C.Ji DISPATCH 'K C.KO DISPATCH 'L C.L DISPATCH 'M C.MC DISPATCH 'O C.O. DISPATCH 'S C.SS DISPATCH 'T C.Tf DISPATCH 'U C.UD DISPATCH 'X C.Xd DISPATCH 'W C.WE DISPATCH 'Z C.Zn DISPATCH '[ C.[f DISPATCH '\ C.\C DISPATCH '] C.]  DISPATCH '^ C.^  DISPATCH 27 C.NOTr5 DROP ERR.INVCOM % here if command does not existr ; 'PROCESS_BYTE :r) CONVERT_TO_UPPER % got one, convert it/ CLI.DISP1 % interpret & execute next commandr DUP IF % command error?/ CTRL_C_FLAG @ IF % no, terminal interrupt? @ DROP ERR.ABORT SETSCREEN DISP % yes, abort, redraw screen THEN THEN % no error or interruptH ;.'C.READ_BYTE :1 CLI.GNB IF % any more bytes in command line? / PROCESS_BYTE % read a byte and act on it  ELSE< POP_KBUF % no more bytes, exit signal depends on KBUF THEN IF % any problems?O0 0 ELSE % no, loop to pick up next command9 UNDROP NEZ_IF % yes, error or end of command line?i/ UNDROP ERR.MSG % error, alert operator 0 BEGIN POP_KBUF NOT END % pop back to K0 CTRL_C_FLAG 0<- THEN -1 THEN % signal exit ;e1'CLI : % CLI, success (failure indicates error)r CLI.INIT CLEAR_L_STACK1% USER_STACK 0W<- % reset user stackE BEGIN % loop until failureC4 C.ARG_EXISTS @ NOT IF % do we need an argument?! CLI.GETARG % yes; read oneH) ELSE -1 % remember success otherwiseL THEN IF % check the error code C.READ_BYTE  ELSE UNDROP ERR.MSG BEGIN POP_KBUF NOT END CTRL_C_FLAG 0<-L -1 % succeed  THEN ENDs= CLI.MOVE_UP ERR_SUPPRESS 0<- % make all of command visible 4 E.DRAW_ARG % maybe draw the last command argument ; *[SAOSTOIC.RED]COMMAND.;4+,(./A 4OT- 0123K56H7=$H89GAHJC% ***************************************************************** % * */% * This module is a part of the SAO VAX/VMS *$% * RED full-screen text editor * % * *% * It was created by *% * Roger Hauck *!% * Smithsonian Institution *"% * Astrophysical Observatory *(% * Cambridge, Massachusetts 02138 *&% * (617)495-7151 (FTS 830-7151) * % * *&% * This module may be reproduced *.% * provided that this header is retained. * % * *C% ***************************************************************** % Variables(1 'C.SIGN VARIABLE % sign as multiplier*0 'C.MAG VARIABLE % magnitude of argument10 'C.ARGLEN VARIABLE % string-length of argument30 'C.XARG VARIABLE % first argument for X commands<0 'C.DEFAULT? VARIABLE % whether there's a default argumentG0 'C.LOOP_COUNT VARIABLE % count for prevention of loop stack overflow@0 'C.REC_LENGTH VARIABLE % record length for fixed-length files70 'C.LINE_COUNT VARIABLE % tally for the comma command/0 'MAIN_SEP VARIABLE % separator for main file'0 'REC_ATT VARIABLE % record attribute+0 'MAIN_ATT VARIABLE % main file attribute00 'ERR_FLAG VARIABLE % error flag for ? command/0 'ERR_SUPPRESS VARIABLE % error suppress flagC0 'FIRST_BYTE VARIABLE % address of first byte of block being readI0 'FSIZE VARIABLE % holding area for control block size during file openB0 'CHAN VARIABLE % RMS channel number for file mapping operationsF0 'OK_TO_MAP VARIABLE % flag to prevent attempts at unimp. file types40 'STOIC_ESCAPE_FLAG VARIABLE % whether to drop out % Utilities ASSEMBLER<?'E.MATCH : % pattern identifier, E.MATCH, pattern id., success3% (compares pattern string to top of bottom buffer)G TOPOBOT @ MOVL (P)+ R3 MOVQ (P) R0 % load parameters into registers CMPC3 R0 (R1) (R3) % do it# MOVL R0 -(P) EQZ % success value ;> H'TF_LL : % move cursor to bottom of screen then scroll to center cursor$ TF @ 2* 2+ % row # of bottom line SROW @ % current row #% - GTZ_IF % already at bottom line?6 UNDROP C.L+ THEN % no, move cursor to bottom line" CENTER_UP % scroll if necessary) SCOL @ 1 EQ_IF % already at column 1?% S.CUP ELSE % yes, restore cursor7 1 C.L- THEN % no, move cursor to beginning of line ;F'TF_-LL : % move cursor to top of screen then scroll to center cursor SROW @ % current row #$ 1- C.L- % move cursor to top line) CENTER_DOWN % scroll down if necessary ;,'I.WORDRIGHT : % move one word to the right! TOPOBOT @ BEGIN % save TOPOBOT BOPOP IF % anything left?1 BLANK LT ELSE % yes, stop if not delimiter -1 THEN END BEGIN BOPOP IF % anything left?$ BLANK GE_IF % yes, delimiter?G TOPOBOT 1-! -1 ELSE % yes, restore byte to bottom buffer, done% 0 THEN ELSE % no, keep going' -1 THEN % nothing left, all done END( TOPOBOT @ OVER - % # of bytes to move# SWAP TOPOBOT ! % restore TOPOBOT C.M+ % do move ;*'I.WORDLEFT : % move one word to the left! BOTOTOP @ BEGIN % save BOTOTOP TOPOP IF % anything left?1 BLANK LT ELSE % yes, stop if not delimiter -1 THEN END BEGIN TOPOP IF % anything left?$ BLANK GE_IF % yes, delimiter?D BOTOTOP 1+! -1 ELSE % yes, restore byte to top buffer, done% 0 THEN ELSE % no, keep going' -1 THEN % nothing left, all done END' DUP BOTOTOP @ - % # of bytes to move# SWAP BOTOTOP ! % restore BOTOTOP C.M- % do move ; !'E.B : % go to beginning of file) BEGIN % loop till at beginning of file TOPOP IF % EOF? BOPUSH REPEAT ;'E.W : % write current file FILE_NAME 3 WOPEN E.B % go to top BEGIN % loop through file' BOT_COUNT UNDER NEZ IF % all done?; BOT_COUNT SFCR DUP E.M+ 2DROP % move first line to top+ TOP_COUNT 1- 3 PUT % output one line) TOPOTOP BOTOTOP MOVE % delete line REPEAT 3 CLOSE ;'C.K : % Kill command BEGIN BOPOP IF % any more bytes?& CRET EQ_IF % yes, is this a CR?$ -1 ELSE % yes, end the loop% 0 THEN ELSE % no, keep going, -1 THEN % no more bytes, end the loop! END DISP -1 % always succeed ;E'FAIL_SEARCH : % returns error message if error suppress flag is off ERR_SUPPRESS @ IF' -1 % if flag is on, return success ELSE2 ERR.NOSTRN % otherwise return "Search failed" THEN ;='C.+S : % pattern descriptor, iteration count, C.+S, success9% (searches forward for countth occurence of the pattern)7% (on success, moves cursor and records pattern length)+% (on failure, moves cursor to top of file)& BOT_COUNT -ROT ( % loop count times SEARCH_STRING IF % found?F I' EQZ_IF -1 ERR_FLAG 0<- THEN % yes, if nth occurence, succeed ELSE/ EXIT FAIL_SEARCH % not found, exit, fail ERR_FLAG -1<- THEN ) IF % was nth occurence found?/ DROP TOPOBOT @ - % yes, how far away is it4 C.M+ -1 ELSE % move that many bytes up, succeedD UNDROP TOPOTOP D@ - C.M- % restore err. code, go to top of file2 UNDER UNDER THEN % drop rest-of-source descr.$ UNDER UNDER % drop pattern descr. ;I'C.-S : % pattern identifier, count, -S (searches backwards for string) ERR_FLAG 0<-) TOPOBOT @ NOTE % save present position/ ( DUP 1- MOVE_DOWN % move down count-1 bytes) BEGIN % loop until string found or BOFA TOPOP IF BOPUSH -1 ELSE 0 THEN IF % move one byte down, BOF?! E.MATCH IF % string found?G -1 I' EQZ_IF -1 THEN ELSE % exit, success if last time through; 0 THEN ELSE % not what we're looking for, continue5 FAIL_SEARCH -1 THEN % not there, exit, failure0 END ) UNDER UNDER % drop pattern descriptorL TOPOBOT @ RECALL OVER - D.M- % describe string passed over, update window ;<'C..S : % string descriptor, iteration count, C..S, success% (search for string)* C.STRLEN 0<- % initialize string length" C.ARG @ EQZ_IF % no iterations?O 2DROP DROP DISP -1 ELSE % no iterations; drop desc., iter. count, succeed +ROT EQZ_IF % null string?# 2DROP -1 ELSE % yes, succeedI UNDROP DUP MINUS C.SIGN @ * C.STRLEN ! -ROT % save string length5 DUP GTZ_IF C.+S ELSE MINUS C.-S THEN % do it THEN THEN DUP NOT IF % success?/ C.STRLEN 0<- THEN % no, zero string length* ERR_SUPPRESS 0<- % clear the error flag ;/'C..D : % count, C..D, -1 (delete characters) C.STRLEN 0<-$ NEZ_IF % nonzero iteration count?" UNDROP DUP GTZ_IF % which way C.D+ ELSE % forward! MINUS C.D- THEN % backward THEN -1 ;2'C..I : % string desc., C..I, -1 (insert string)# LTZ_IF % direction of insertion? C.I+ ELSE C.I- THEN -1 ;*[SAOSTOIC.RED]DYNA.;1+,#./A 4P- 0123K56@4j7 j89GAHJ$C% ***************************************************************** % * */% * This module is a part of the SAO VAX/VMS *$% * RED full-screen text editor * % * *% * It was created by *% * Roger Hauck *!% * Smithsonian Institution *"% * Astrophysical Observatory *(% * Cambridge, Massachusetts 02138 *&% * (617)495-7151 (FTS 830-7151) * % * *'% * Modifications by Jonathan Mark *% * Summer 1981 * % * *&% * This module may be reproduced *.% * provided that this header is retained. * % * *C% ***************************************************************** % Things for DEF ASSEMBLER<'8+ : ADDL2 S^ 08 (P) ;'C+ : ADDL2 S^ 0C (P) ;> 'SPACES : GTZ_IF UNDROP ( SPACE ) THEN ;G'I= : % value, n, I= (types value with leading blanks, field-width n)" SWAP <#> -ROT OVER - SPACES TYPE ;'% Search for byte, and other utilities ASSEMBLER</'(SBB) : % byte, string pointer, length, SBB,-.% match position (or -1), string pointer, byte8% (searches backwards through string for specified byte)) INLINE< MOVQ (P)+ R0 % r0,1INLINE TARGET % to end, i.e. do nothing if count is neg./ INLINE< DECL R0 % initial decrement to count1 BLSS >INLINE TARGET % to end if count was zero/ INLINE< CVTLB (P) R2 >INLINE % r2INLINE TARGET SWAP % to exit= INLINE< DECL R0 BGEQ >INLINE % decrement index and loop?, TARGET SWAP ARCHER % to beginning of loop( CMARK ARCHER % this is exit from loop- CMARK ARCHER % this is exit for zero count8 CMARK ARCHER % from initialization, if count was neg.4 INLINE< MOVQ R0 -(P) >INLINE % restore descriptor ; IMMEDIATE''SBB : % (subroutine version of (SBB)) (SBB) ;>)'SBF : % new version using SEARCH_STRING DUP GEZ_IF' NOTE NOTE % save string descriptor3 MARK RECALL 1 % string descriptor for the byte*. RECALL RECALL % restore string descriptor, SEARCH_STRING NOT IF % search, success?A 1- SWAP 1+ SWAP THEN % no, signal failure with count of -1 F NOTE NOTE 2DROP % save descriptor of remainder, drop match string9 RECALL RECALL THEN % restore descriptor of remainder  ;&'SFCR : % n, string descriptor, SFCR,1% descriptor of string passed over to find nth CR*I% (If there are not n CR's in string, full string descriptor is returned)  -ROT NOTE % save counte# OVER SWAP % save string locationh% CRET +ROT % setup to search for CR* RECALL ( % do it n times*( SBF LTZ_IF % search, anything left?3 1- -1 EXIT ELSE % no, correct position, exit^$ UNDROP THEN ) % yes, continue: DROP UNDER % drop remaining string length & search byte, OVER - % descriptor of string passed over ;a&'SRCR : % n, string descriptor, SRCR,1% descriptor of string passed over to find nth CR I% (If there are not n CR's in string, full string descriptor is returned)# DDUP + NOTE % save end of stringi -ROT NOTE % save loop count CRET +ROT % setup to search" RECALL % bring forth loop count. ( SBB ) 1+ % descriptor of remaining string -ROT DROP % drop search bytei' + RECALL OVER - % string passed overe ;t o% Lower-level wordsT ASSEMBLER< D'D@- : % pointer pair of longwords, D@-, difference between the two % (gives the length of a dynast) MOVQ @(P)+ R0R SUBL3 R0 R1 -(P) ;GA'DYNACOUNT : % dynast pointer, DYNACOUNT, string address, lengthe MOVQ @(P)+ R0A MOVL R0 -(P) SUBL3 R0 R1 -(P) ; R% Define buffer pointers 0A '#BUFS CONSTANT .D@ 'D.START CONSTANT I 8 'K0 ARRAY % allocate four longword pointers for each keyboard buffer H #BUFS 4 * 'X0 ARRAY % allocate four longword pointers for each buffer 0 'D.STOP VARIABLEB0 'KBUF# VARIABLECX0 'CURBUF VARIABLE % pointer to descripter of current edit buffer CK0 'CURKBUF VARIABLE % pointer to descriptor of current keyboard #c2'D.LOOK : % (displays dynamic string allocations)% D.STOP 4+ D.START DO I ? CR 4 +LOOPF ;e='OLD_J : MOVL (L) B^ C -(P) ; % gets 4th entry on loop stackw>o3'D.EXPAND2 : % ptr. to dyn. str. descr., D.EXPAND2e) DUP D@ SWAP OVER - % source descriptorL OVER OLD_J + % destination  MOVE_BYTES % move string%= DUP D@ OLD_J + SWAP OLD_J + SWAP -ROT D! % update pointersr ;i6'D.EXPAND1 : % exp. area ptr., space needed, D.EXPANDH% (expands by a given amount, the expansion area for the dynamic string)4 800 MAX % as long as we need to expand, do it big8 NOTE % yes, save amount of space needed on loop stack D.STOP 4- @ RECALL DUP NOTE + 9 .D@ - GTZ_IF % is there already enough room in memory? ) UNDROP .D+! THEN % no, expand memorym$ .D@ D.STOP ! % expand last dynast3 3 - D.STOP 7 - DDUP GT_IF % any strings to move?S3 SWAP DO % yes, loop through individual dynasts & I' D.EXPAND2 % move next dynast 8 +LOOP ELSE* 2DROP THEN % nothing to move, cleanup! RECALL DROP % clean loop stackf ;n5'D.EXPAND : % exp. area ptr., space needed, D.EXPANDtH% (expands to a given amount, the expansion area for the dynamic string)C OVER D@- - DUP GTZ_IF % how much does it need to be expanded by?  D.EXPAND1 ELSE % go expando+ 2DROP THEN % it doesn't need expanding: ;o;'ABE : % byte, ptr. to dynamic string descr., ABE, successv% (add byte to end)n! 4+ % expansion area descriptorR DUP D@ GE IF % any room? ' DUP 800 D.EXPAND THEN % no, expands DUP @ -ROT B<- % add the byte 1+! % bump pointerR ;)6'RBE : % dyn. str. ptr., RBE, [byte, TRUE] or [FALSE]! DUP D@ LT IF % anything there? ) 4+ DUP 1-<- % yes, decrement pointers( @ B@ -1 ELSE % pickup byte, succeed& DROP 0 THEN % nothing there, fail ;r#'ABB : % byte, dyn. str. ptr., ABB DUP 4- D@ GE IF % any room?* DUP 4- 800 D.EXPAND THEN % no, expand# DUP 1-! % yes, decrement pointer  @ B! % store byte ;r 6'RBB : % dyn. str. ptr., RBB, [byte, TRUE] or [FALSE]! DUP D@ LT IF % anything there?? DUP @ B@ % pick up byte1 SWAP 1+<- -1 ELSE % increment pointer, succeedt& DROP 0 THEN % nothing there, fail ;rP'ASB : % str. descr., dyn. str. ptr., ASB (adds string at beginning of dynast)= DDUP 4- SWAP D.EXPAND % make sure there is sufficient roomA +ROT OVER + SWAP DDUP NE_IF DO I' B@ OVER ABB LOOP1 ELSE 2DROP THEN DROP ;.F'RLB : % dyn. str. ptr., RLB, (str. descr., -1) or (0 if null dynast)'% (removes line at beginning of dynast)o 1 OVER DYNACOUNT NEZ_IF  UNDROP SFCRt -ROT DDUP -! -1 ELSE 3 (DROP) 0 THENE ;DI'ASE : % str. descr., dyn. str. ptr., ASE, (add string to end of dynast)N= DDUP 4+ SWAP D.EXPAND % make sure there is sufficient rooml7 +ROT OVER + SWAP DDUP NE_IF DO % loop through string * I B@ OVER ABE LOOP % move next byte ELSE 2DROP THEN DROP ;  e(% Stuff which is specific to the editor'TOPOTOP : CURBUF @ ;,'BOTOTOP : CURBUF @ 4+ ;'TOPOBOT : CURBUF @ 8+ ;'BOTOBOT : CURBUF @ C+ ;'KBUF : CURKBUF @ ;8'TOP_COUNT : % TOP_COUNT, pointer to top buffer, length TOPOTOP @ BOTOTOP @ OVER - ;P;'BOT_COUNT : % BOT_COUNT, pointer to bottom buffer, lengthA TOPOBOT @ BOTOBOT @ OVER - ;H'TOPUSH : TOPOTOP ABE ;d'TOPOP : TOPOTOP RBE ;y'BOPUSH : TOPOBOT ABB ;g'BOPOP : TOPOBOT RBB ; >'MOVE_UP : % count, MOVE_UP (moves string from bottom to top)) BOT_COUNT -ROT MIN % source descriptorE) DDUP + TOPOBOT ! % new bound on bottomh BOTOTOP @ % destination& DDUP + BOTOTOP ! % new bound on top MOVE_BYTES % do itS ; C'MOVE_DOWN : % count, MOVE_DOWN (moves string from top to bottom)n$ TOPOTOP D@- MIN % # bytes to move, BOTOTOP @ OVER - SWAP % source descriptor$ OVER BOTOTOP ! % new bound on top! TOPOBOT @ OVER - % destinationy# DUP TOPOBOT ! % new bound on top MOVE_BYTES ; % Initialization 8'D.INIT : % D.INIT (initializes dynamic-string region)1% (must be called after all variables are defined %% and before using dynamic strings.)i' D.STOP 4 + D.START DO .D@ I ! 4 +LOOPe ;i r% buffer displayP?'D.DISPLINE : % pointer to text-buffer descriptor, D.DISPLINE, % pointer to next buffer descr.e% DUP @ 6 I= % type origin of bufferP0 4 ( % loop through description of this buffer DUP D@- 6 I= 4+ )  ; 'D.DISP :R+ CR " LOC. TOP GAP BOT. IBUF" MSG  K0 2 (/ CR ASCII K TYO I ASCII 0 + TYO D.DISPLINE )0 CR 0A (/ CR ASCII X TYO I ASCII 0 + TYO D.DISPLINE ) CR DROPU ;Z5'D.COUNT : % ptr. to dsd, D.COUNT, string descriptorD DYNACOUNT ;'SUB : X0 D@ DO I B@ DUP 0D NE_IF  SWAP OVER XOR 0D NE_IF UNDROP ELSEP DUP THEN THENi I B!t LOOP DROP ;W'ADD : X0 D@ DO I B@ DUP 0D NE_IF  SWAP OVER XOR 0D NE_IF UNDROP UNDER DUP ELSEH DUP THEN THEN  I B! LOOP DROP ;d;F*[SAOSTOIC.RED]E.;2+,$. /A 4J - 0123K56 7 -89GAHJC% *****************************************************************q % * */% * This module is a part of the SAO VAX/VMS *q$% * RED full-screen text editor * % * *% * It was created by *% * Roger Hauck *!% * Smithsonian Institution *"% * Astrophysical Observatory *(% * Cambridge, Massachusetts 02138 *&% * (617)495-7151 (FTS 830-7151) * % * *'% * Modifications by Jonathan Mark *% * Summer 1981 * % * *&% * This module may be reproduced *.% * provided that this header is retained. * % * *C% ***************************************************************** % The Editor% Roger Hauck(% First successful edit run: June 7,1979% Constants and Variables 800 'GAPSIZE CONSTANT4 100 'MAXLINE CONSTANT % max. input record length/ 1D 'USEP CONSTANT % unit separator character % Variables3-1 'IMODE VARIABLE % true indicates IMMEDIATE mode:-1 'BACKGROUND VARIABLE % true indicates light backgroundE00 'TERMINATORS VARIABLE % # of consecutive terminators in com. lineAB00 'OLD_TERM VARIABLE % holding area for TERMINATORS during a cut9-1 'DISP_FLAG VARIABLE % -1 => window needs full refreshV9 % -3 => full screen needs refreshi1-1 'TAB_MODE VARIABLE % true indicates hard tabs 700 'CUT_FLAG VARIABLE % true indicates cut mode in useMA-1 'PASTE_FLAG VARIABLE % true indicates cut characters restored C00 'APPEND_FLAG VARIABLE % true indicates current cut is an append @00 'BLINK_OK VARIABLE % true indicates the cut is on the screenB00 'BLINK_POS VARIABLE % contains the number of the cut character500 'SEARCH_DIR VARIABLE % direction for cut searchesc=00 'TEXT_BUF VARIABLE % save text buffer for command editing.200 'REC_SEP VARIABLE % record separator character?00 'SPACE_FLAG VARIABLE % whether to treat space/tab as insert :% Stuff from command line; moved here to be usable in EDV&0 'C.ARG VARIABLE % value of argument@0 'C.ARG_EXISTS VARIABLE % flag for whether to read an argument:0 'C.ARG_WRITTEN VARIABLE % whether argument is on screen % ArraysP21A 4 * 'NUM_REGS ARRAY % 26 number registers: A-Z?0C 'OLD_T_ARRAY ARRAY % array to hold terminal characteristicsT10C 'NEW_T_ARRAY ARRAY % array to contain changes% String Variables.77 'C.STRINGSIZE CONSTANT" C.STRINGSIZE 'C.STRING SVARIABLE77 'C.COMMANDSIZE CONSTANT$ C.COMMANDSIZE 'C.COMMAND SVARIABLE761 'MACRO_STACKSIZE CONSTANT % stack size must be 6n+1'# MACRO_STACKSIZE 'MSTACK SVARIABLEP50 'USER_STACKSIZE CONSTANT.& USER_STACKSIZE 'USER_STACK SVARIABLE100 'C.HOLDSIZE CONSTANT C.HOLDSIZE 'C.OLDSTR SVARIABLE C.HOLDSIZE 'C.NEWSTR SVARIABLE% screen-related variablesE;0 'ROW VARIABLE % current row #; 2 <= ROW <= WINDOW_SIZE+1e&0 'COLUMN VARIABLE % current column #(0 'SROW VARIABLE % screen-cursor row(0 'SCOL VARIABLE % screen-cursor column70 'CURSOR_CHAR VARIABLE % character at cursor positionI &% Runtime initialization of variables$'E.INIT : % done when RED starts upA D.INIT X0 4+ 800 D.EXPAND % initialize dynamic string facilityN TEXT_BUF 0<- TF @ 2+ SROW ! SCOL 0<-L MSTACK 0W<-E4 77 MSTACK STAB % append a code to the macro stack3 0 BUFFER# ! X0 CURBUF ! % set up the text bufferU6 0 KBUF# ! K0 CURKBUF ! % set up the keyboard buffer2 O.BUFSTRT O.BUFCUR ! % set up the output buffer2 CRET REC_SEP ! % default record separator of CR+ 0 TERMINATORS ! % no command terminators # 0 CUT_FLAG ! % turn off cut mode.' -1 PASTE_FLAG ! % allow the next cut  ;NF'B.INIT : % B.INIT (initializes text buffer prior to reading a file)2 TOPOTOP @ DUP BOTOTOP ! % initialize top bufferI GAPSIZE + BOTOBOT 4+ @ MIN DUP TOPOBOT ! BOTOBOT ! % initialize bottomm; BEGIN BOTOTOP D@ - GAPSIZE - LEZ_IF % is gap big enough? ' BOTOTOP D.EXPAND REPEAT % no, expand ;O % Miscellaneous'[[ : DUP = DUP ? CR 4 + ;H!'LOOK : BUF [[ [[ [[ [[ [[ DROP ;s'IDLE : 0 TYO ;['IDLES : ( IDLE ) ;o r'% Search for byte, and other utilitiesh ASSEMBLER</'(SBB) : % byte, string pointer, length, SBB,-v.% match position (or -1), string pointer, byte8% (searches backwards through string for specified byte)) INLINE< MOVQ (P)+ R0 % r0,1INLINE TARGET % to end, i.e. do nothing if count is neg./ INLINE< DECL R0 % initial decrement to count 1 BLSS >INLINE TARGET % to end if count was zero1/ INLINE< CVTLB (P) R2 >INLINE % r2INLINE TARGET SWAP % to exit= INLINE< DECL R0 BGEQ >INLINE % decrement index and loop? , TARGET SWAP ARCHER % to beginning of loop( CMARK ARCHER % this is exit from loop- CMARK ARCHER % this is exit for zero counti8 CMARK ARCHER % from initialization, if count was neg.4 INLINE< MOVQ R0 -(P) >INLINE % restore descriptor ; IMMEDIATE''SBB : % (subroutine version of (SBB))p (SBB)  ;A>C)'SBF : % new version using SEARCH_STRING DUP GEZ_IF' NOTE NOTE % save string descriptorp3 MARK RECALL 1 % string descriptor for the bytet. RECALL RECALL % restore string descriptor, SEARCH_STRING NOT IF % search, success?A 1- SWAP 1+ SWAP THEN % no, signal failure with count of -1cF NOTE NOTE 2DROP % save descriptor of remainder, drop match string9 RECALL RECALL THEN % restore descriptor of remainderC ;1*[SAOSTOIC.RED]EB.;2+,'./A 4L- 0123K56Q2I7}2I89GAHJC% *****************************************************************q % * */% * This module is a part of the SAO VAX/VMS *q$% * RED full-screen text editor * % * *% * It was created by *% * Roger Hauck *!% * Smithsonian Institution *"% * Astrophysical Observatory *(% * Cambridge, Massachusetts 02138 *&% * (617)495-7151 (FTS 830-7151) * % * *&% * This module may be reproduced *.% * provided that this header is retained. * % * *C% ***************************************************************** % EB: Edit buffer % VariablesL0 'C.STRLEN VARIABLE % length of string last inserted, searched for, or ...'E.M+ : MOVE_UP ;'E.M- : MOVE_DOWN ;'E.D+ : TOPOBOT +! ;'E.D- : BOTOTOP -! ;'E.I+ : TOPOTOP ASE ;'E.I- : TOPOBOT ASB ; % CLI commands'C.M+ :" BOT_COUNT -ROT MIN DUP E.M+ D.M+ ;'C.M- :/ TOPOTOP D@ - MIN DUP E.M- TOPOBOT @ SWAP D.M- ;*'C.L+ :* BOT_COUNT SFCR DUP E.M+ D.M+ ;*'C.L- :  TOP_COUNT SRCR DUP E.M- D.M- ;f 'C.UP_ARROW : % TOP_COUNT GTZ_IF % anything there?*1 UNDROP 1- % yes move back at least one byteo SRCR % move back one line( 1+ % add byte to string passed over DUP E.M- D.M- ELSE 2DROP THEN % clean stack* ; 'C.D+ :5: BOT_COUNT -ROT MIN % descriptor of string to be deleted DUP E.D+ D.D+ ;r'C.D- : + TOPOTOP D@ - MIN % # bytes to be deleted = BOTOTOP @ OVER - SWAP % descriptor of string to be deleted* DUP E.D- D.D-l ; 'C.I+ :I/ DUP MINUS C.STRLEN ! % get the string lengthm DDUP E.I+ D.I+ ; 'C.I- :A) DUP C.STRLEN ! % get the string lengthX DDUP E.I- D.I- ;r;F*[SAOSTOIC.RED]EDV.;9+,&.!/A 4O!!- 0123K56wHf7 Hf89GAHJC% *****************************************************************q % * */% * This module is a part of the SAO VAX/VMS *q$% * RED full-screen text editor * % * *% * It was created by *% * Roger Hauck *!% * Smithsonian Institution *"% * Astrophysical Observatory *(% * Cambridge, Massachusetts 02138 *&% * (617)495-7151 (FTS 830-7151) * % * *&% * This module may be reproduced *.% * provided that this header is retained. * % * *C% ***************************************************************** % VT100 Display ModuleC'BLINK : % (redefines BLINK to allow for light or dark background) BLINK) BACKGROUND @ NOT IF % dark background? REVERSE THEN ;'RESET_TERMINAL : RESET_VT100 FLUSH ; ASSEMBLER<'2OVER : MOVL B^(P) 8 -(P) ;>&'SFCR : % n, string descriptor, SFCR,1% descriptor of string passed over to find nth CRI% (If there are not n CR's in string, full string descriptor is returned) -ROT NOTE % save countr# OVER SWAP % save string location1% CRET +ROT % setup to search for CR  RECALL ( % do it n times( SBF LTZ_IF % search, anything left?3 1- -1 EXIT ELSE % no, correct position, exite$ UNDROP THEN ) % yes, continue: DROP UNDER % drop remaining string length & search byte, OVER - % descriptor of string passed over ;M&'SRCR : % n, string descriptor, SRCR,1% descriptor of string passed over to find nth CReI% (If there are not n CR's in string, full string descriptor is returned)i# DDUP + NOTE % save end of string  -ROT NOTE % save loop count CRET +ROT % setup to search" RECALL % bring forth loop count. ( SBB ) 1+ % descriptor of remaining string -ROT DROP % drop search byteH' + RECALL OVER - % string passed over: ;p 'D.TYPE :. ( % loop through string1 DUP I + B@ E.TYO ) % output next charactera DROP ; -'D.CR_TYPE : % outputs line feeds after CR'sNJ ( DUP I + B@ DUP 0D EQ_IF ERASE_RE ȺK~ REDBUILD.BAK& [SAOSTOIC.RED]EDV.;9O.OBJ;2J;3O! :ST_OF_LINE LFEED TYO THEN E.TYO ) DROP ;2'DRAW_LINE_FROM_CURSOR :C FIND_CURSOR S.CUP % find where cursor should be and put it there ERASE_REST_OF_LINEL TOPOBOT @ CRET OVER BOTWINDOW @ SBF DROP 1- % point to first char. beyond@ UNDER OVER - % drop CR, descriptor of rest of line without CR D.TYPE % draw rest of lineo S.CUP % reposition cursor ;1'EXTEND_LINE : % subset of DRAW_LINE_FROM_CURSORL TOPOBOT @ CRET OVER BOTWINDOW @ SBF DROP 1- % point to first char. beyond@ UNDER OVER - % drop CR, descriptor of rest of line without CR/ DUP +ROT ( % save count; loop through string DUP I + B@D DUP 09 EQ_IF ERASE_REST_OF_LINE THEN E.TYO % if tab, erase line ) DROP % get rid of addressI FIND_CURSOR NEZ_IF S.CUP THEN % reposition cursor if not already theren ; 'DRAW_LINE_WITH_CURSOR :6 1 SROW @ CUP % position cursor at beginning of line* 1 TW_COUNT SRCR % get beginning of line" D.TYPE % draw beginning of line ERASE_REST_OF_LINEL TOPOBOT @ CRET OVER BOTWINDOW @ SBF DROP 1- % point to first char. beyond@ UNDER OVER - % drop CR, descriptor of rest of line without CR D.TYPE % draw rest of linerJ FIND_CURSOR_COLUMN S.CUP % find where cursor should be and put it there ;E ASSEMBLER<<'DISP_IF_EXIT_THEN : % string descriptor, DISP_IF_EXIT_THEN6 % (exit from calling word if DISP_FLAG is set)" DISP_FLAG @ NEZ_IF % is it set?. ADDL2 S^ 4 SP % yes, pop the return stack4 ADDL2 S^ 8 P THEN % also drop string descriptor ;.> 'ADD_LINE_AT_TOP :J TOPOWINDOW@ 1- TOPOTOP @ DDUP - % descriptor of string above new window LEZ_IF % anything there?? 2DROP BLANK_LINES 1+! ELSE % no, increase blank-line countpB UNDROP CRET +ROT SBB + 1+ DUP TOPOWINDOW! % new top of window( UNDER % get rid of CR (search byte) SWAP 1+ SWAP* DO % loop: new top of window thru old' I B@ E.TYO % draw next characterC LOOP THENn ;t'REMOVE_LINE_AT_TOP : * BLANK_LINES @ GTZ_IF % any lines there?? UNDROP 1- BLANK_LINES ! ELSE % no, reduce blank line countp6 1 TOP_WINDOW_STRING SFCR % yes, search for 1st CR- TOPWINDOW -! DROP THEN % remove 1st line_ ;E'REMOVE_LINE_AT_BOTTOM :' BOTOWINDOW@ 1- % address of final CRE0 BEGIN % loop until the preceding one is found2 1- DUP B@ % decrement pointer and obtain byte 0D EQ % if CR, stop END 9 1+ BOTOWINDOW! % increment result and store in pointeru ; 4% NOTE: there's probably a better way to do this ...D'CR_COUNT : % string descriptor, CR_COUNT, number of CR's in string7 0 +ROT ( DUP I + B@ 0D EQ_IF SWAP 1+ SWAP THEN ) DROPe ;i'SCROLL_TOP_TO_CURSOR :  2 SROW @ SCROLLn ;'SCROLL_CURSOR_TO_TOP :s SROW @ 2 SCROLLe ; H'WRITE_LINE_FROM_CURSOR : % (write_line_from_cursor for immediate mode)#% (cursor must be positioned first) TOPOBOT D@ DDUP NE_IF % EOF ?) OVER B@ CRET NE_IF % no, leading CR?: SC DO % no, save cursor, loop through bottom buffer/ I B@ CRET EQ_IF EXIT ELSE % stop on CR UNDROP E.TYO THENt LOOP RC ELSE % restore cursorR. 2DROP THEN ELSE % leading CR, no action) 2DROP THEN % EOF, no action requiredt ;t'ERASE_LINE_FROM_CURSOR :E BOPOP IF % EOF?$ DUP BOPUSH CRET NE_IF % no, CR? ERASE_REST_OF_LINE THEN  THEN ;rE% Logic to insert strings into the buffer (called from the XG commandoE% in CLI) -- this is the smart VT100 version that calls for a refresh./% only if the string is bigger than the window.NG'CHECK_INSERT_STRING : % number of CR's in string, CHECK_INSERT_STRINGh3 SROW @ 2- LT_IF % does entire string fit window?tC DISP % if not, bypass display routine by signaling for refresh? THEN ;E O 'D.M+ : DISP_IF_EXIT_THEN" UNDER GTZ_IF % anything there?; UNDROP DUP TOPWINDOW +! BOTWINDOW -! % adjust window^4 BOTWINDOW @ GEZ_IF % is cursor within window?( FIND_CURSOR % maybe, where is it= WINDOW_SIZE 1+ SROW @ LE_IF % is cursor beyond window,& S.CUP ELSE % no, draw cursor' DISP THEN ELSE % yes, refresh. DISP THEN THENa ;'D.M- :  DISP_IF_EXIT_THEN! UNDER GTZ_IF % anything there?G9 UNDROP DUP TOPWINDOW -! BOTWINDOW +! % adjust window 2 TOPWINDOW @ GEZ_IF % is cursor within window?$ FIND_CURSOR % yes, where is it S.CUP ELSE % draw cursor DISP THEN THENI ;m'D.D+ :  DISP_IF_EXIT_THEN# DUP BOTWINDOW -! % adjust windowrB DDUP CR_COUNT WINDOW_SIZE SROW @ - 1+ LT_IF % not enough space?' 2DROP DISP % if so, refresh window  ELSE( UNDROP NEZ_IF % any CR's in string? UNDROP5 WINDOW_SIZE 1+ SROW @ STBM 1 WINDOW_SIZE 1+ CUPH# ( 0A TYO ADD_LINE_AT_BOTTOM ) 2DROP % remove pointerI DRAW_LINE_WITH_CURSORT$ ELSE 2DROP DRAW_LINE_FROM_CURSOR THEN THEN ;'DELETE_STRING_TO_CURSOR : UNDROP % get number of CR's SROW @ 2 STBM 1 2 CUPP ( SCROLL_DOWN_1 ) ( 2DROP % get rid of the string pointer+ DRAW_LINE_WITH_CURSOR % fix current line  S.CUP' ;L'D.D- :T DISP_IF_EXIT_THENT# DUP TOPWINDOW -! % adjust window 1 DDUP CR_COUNT SROW @ LT_IF % not enough space?H% 2DROP DISP % yes, refresh windowP ELSE UNDROP NEZ_IF' DELETE_STRING_TO_CURSOR $ ELSE 2DROP DRAW_LINE_FROM_CURSOR THEN THEN ;C'D.INSERT_CR :- ERASE_LINE_FROM_CURSOR SCROLL_CURSOR_TO_TOPf REMOVE_LINE_AT_TOP SCOL 1<- S.CUP WRITE_LINE_FROM_CURSOR ; ='ADD_STRING_AT_CURSOR : % string desc., ADD_STRING_AT_CURSOR 9 0 +ROT ( % push a CR count and loop through the stringO, DUP I + B@ % classic get-byte operation( 0D EQ_IF % is it a carriage return? ERASE_REST_OF_LINE8 SROW @ 2 STBM % top of window is scrolling region7 S.CUP CR REMOVE_LINE_AT_TOP % push the screen up 2 SWAP 1+ SWAP % add 1 to the stored CR count ELSE& UNDROP % get the character backH DUP 09 EQ_IF ERASE_REST_OF_LINE THEN % if tab, erase passed bytes2 E.TYO % if not carriage return, type it out THEN; ) DROP EQZ_IF EXTEND_LINE ELSE DRAW_LINE_FROM_CURSOR THENV ;S'D.I+ :E DISP_IF_EXIT_THENi# DUP TOPWINDOW +! % adjust windowe DDUP CR_COUNT / SROW @ 2- % get number of lines above cursor 0 SWAP GT_IF % is the insert within the window?@ 2DROP DISP % if so get rid of everything and signal refresh ELSE ADD_STRING_AT_CURSOR THEN ;r'D.I- :  DISP_IF_EXIT_THEN # DUP BOTWINDOW +! % adjust window " CRET +ROT SBF UNDER UNDER GEZ_IF DISP ELSE* DRAW_LINE_FROM_CURSOR THEN ;D;'DRAW_BUFFER# : % NOTE: this routine is terminal dependenth 27 1 CUP* BUFFER# @ GEZ_IF % is it a text buffer?> UNDROP ASCII X TYO <# # #> TYPE % yes; output it's number ELSE8 UNDROP ASCII K TYO 2+ <# # #> TYPE % else type Kn+2 THEN ;'SET_BUFFER# :" DUP BUFFER# ! 10 * X0 + CURBUF ! DRAW_BUFFER# ;v 'IDISP : DEFINE_TOP_OF_WINDOW> 18 TF @ 2* 4+ STBM % set scrolling region to command window8 1 2 CUP % position cursor at beginning of text window# BLANK_LINES @ % any blank lines?C? ( ERASE_REST_OF_LINE LFEED TYO ) % draw blank lines at topi' TW_COUNT E.TYPE % fill top of windowr FILL_BOTTOM_WINDOW S.CUPR BLINK_OK 0<- ;t 'DISP_FLUSH :R; DISP_FLAG @ DUP 2 AND NEZ_IF % tableau refresh required?e SETSCREEN THEN % yesv IF % window refresh required? IDISP THEN % yese DISP_FLAG 0<- % reset flagt ;dF0 'TIME_FLAG VARIABLE % true means draw cpu time when drawing commandK'S.CPU_TIME : % (draws elapsed cpu time in seconds at end of pane divider)t! RADIX @ DECIMAL % push decimal < CPUTIM GETJPI 32 + 64 / % get cpu time rounded to secondsM DUP 10 ( 0A / LEZ_IF EXIT ELSE UNDROP THEN ) LAST_I 1+ % count # of digitsn1 28 SWAP - WINDOW_SIZE 2+ CUP % position cursoro% ASCII { TYO <#> TYPE % output time  RADIX ! % restore radix ;0'SELECT_COMMAND : % (sets up for command entry) 18 WINDOW_SIZE 3 + STBMQ ;R>'DRAW_COMMAND_CURSOR : % real cursor must be positioned first$ SC % save command-cursor position 1A TYO % draw command cursort S.CUP % restore window cursor ;O6'ERASE_COMMAND : % (clears command pane from display)1 TIME_FLAG @ IF S.CPU_TIME THEN % draw cpu time 2 SELECT_COMMAND % scrolling area is command pane" 1 TF @ 2 * 4 + % get row number, CUP SC % cursor to origin of command pane, ERASE_REST_OF_SCREEN % erase command pane ;B'CUT_SRC_MSG : "CUT MODE " MSGoF SEARCH_DIR @ GEZ_IF "Forward search" ELSE "Backward search" THEN MSGC "; end string with LINE FEED, repeat LF to repeat search." MSG CRU ;E'DRAW_COMMAND :L7 ERASE_COMMAND % clear command panel, position cursor 7 18 TF @ 2* 3 + - % find out how many CR's will be OK L CUT_FLAG @ IF "CUT MODE" MSG CR 1- THEN % if cutting, type message, sub 1+ KBUF D.COUNT % anything on command line? : SRCR % don't get more CR's than fit in the command area ( % loop through! DUP I + B@ % get next byte $ A EQ_IF % is it a terminator?+ ASCII ~ TYO ELSE % yes, echo tilded. UNDROP DUP E.TYO % no, do normal echo= CRET EQ_IF LFEED TYO THEN THEN % if CR, echo LF alsoc )u DROP DRAW_COMMAND_CURSORS ;E1'D.COM_POS : % position cursor at end of commandF, RC % use hardware restore-cursor function ;S7'D.COM_DEL : % delete last character from command lineL D.COM_POS % go there  DUP CRET EQ_IF DROP -1 % redraw if CRp ELSE TAB EQ_IF.8 TAB_MODE @ IF -1 ELSE 0 THEN % redraw if hard tab2 ELSE 0 THEN % just delete it if anything else THEN IF % do we draw it?- DRAW_COMMAND % no; reset the entire linel ELSE" 8 TYO % go back one character* ERASE_REST_OF_LINE DRAW_COMMAND_CURSOR THEN ;o6'D.COM_APPEND : % append a byte to the command string D.COM_POS % go there : DUP CRET EQ_IF ERASE_REST_OF_SCREEN CR DROP % is it CR? ELSEG DUP TAB EQ_IF ERASE_REST_OF_LINE THEN % clear cursor if it's a tabR E.TYO % draw it THEN' DRAW_COMMAND_CURSOR % and repositionD ;R'DRAW_DIVIDER : % DRAW_DIVIDER2% (draws bar dividing text pane from command pane)& 1 TF @ 2* 3 + CUP % position cursor DWL SPACEr? GRAPHICS "qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq" MSG LCASEd ; 7'BAR : " " MSG ;% 'SETSCREEN : ANSI_VT100 APPLICATION_KEYPADn ERASE_SCREEN 3 ( 0 TYO ) 1 1 CUP % homer SPACE SPACEb 7 SGR SPACE SPACE.% FILE_NAME COUNT GTZ_IF % filename?R/ UNDROP TYPE ELSE DROP THEN % yes, write itI BAR DWL 0 SGRA DRAW_BUFFER# DRAW_DIVIDER SELECT_COMMAND ; 'ERR.MSG : % error #, ERR.MSG1% (writes message, waits for CR, deletes message)W- 4 TF @ 2* 3 + CUP % position cursor in bars3 BLINK 2 / MSG STEADY % draw the blinking messagef% BEGIN TYI D EQ END % stall till CR? DRAW_DIVIDER % delete message ; ''CENTER_UP : % center cursor in windowt2 SROW @ TF @ 2+ - GTZ_IF % do we need to scroll? UNDROP % preserve count@ WINDOW_SIZE 1+ DUP 2 STBM % window becomes scrolling region7 1 SWAP CUP % place cursor at lower left of windowO. ( 0A TYO ADD_LINE_AT_BOTTOM ) % scroll up4 DEFINE_TOP_OF_WINDOW THEN % find new TOPOWINDOW ;C4'CENTER_DOWN : % scroll down until cursor in window2 TF @ 2+ SROW @ - GTZ_IF % do we need to scroll? UNDROP % preserve count< WINDOW_SIZE 1+ 2 STBM % window becomes scrolling region 1 2 CUP.# ( SCROLL_DOWN_1 ) % scroll down 5 TF @ 2+ SROW ! S.CUP THEN % post cursor positions FIND_BOTOWINDOWN ;SL'WRITE_CHR : % writes out the current character or a space if at end/bufferG TOPOBOT @ BOTOBOT @ NE TOPOBOT @ B@ CRET NE AND % can it be printed?' TOPOBOT @ B@ TAB NE AND IF6 TOPOBOT @ B@ E.TYO % yes, print out the first one ELSE! " " MSG % no, output a space  THEN ;@G'BLINK_CHR : % blinks the character at the cursor (doesn't restore it) ! S.CUP % go where the cursor is_( BLINK % make the next character blink# WRITE_CHR % output the character S.CUP % reposition the cursor. STEADY % and restore the printing to normal ;X'TYPEKEY_MSG :6 BLINK 4 TF @ 2* 3 + CUP "Type a key: " MSG STEADY CR ;N'COND_REPLACE_MSG : 6 BLINK 4 TF @ 2* 3 + CUP "Type a key: " MSG STEADY CR ERASE_COMMAND LFEED TYO 1 " RETURN or ESC to replace the string" MSG CRT* " LINE FEED to skip the string" MSG CR " Space bar to exit" MSG CRn ; 'NUMBER_MSG :I6 BLINK 4 TF @ 2* 3 + CUP "Type a number: " MSG STEADY ;IE'SHOW_OPTIONS : % prints out the 2nd cut options in the command arear ERASE_COMMANDP 1 15 CUP) " RETURN to replace the previous cut"H MSG CR& " A to append to the previous cut" MSG CR! " Q to abort this cut" MSG CRRC 4 TF @ 2* 3 + CUP "2nd cut without paste; Type a key:" MSG STEADY ;T'WAIT_FOR_RESET :8 800 DELAY % wait for VT100 to reset (about 2 seconds) ;C'E.ERASE_ARG :O 1E 1 CUP REVERSE 8 SPACES STEADY LFEED TYO % clear argument, leave wide arean ; 'E.SHOW_ARG :D$ RADIX A <- % set radix to decimal( 1E 1 CUP % position cursor to top row$ REVERSE FLUSH % get inverse video. C.ARG @ <#> DUP NOTE TYPE % show the number8 RECALL 8 SWAP - SPACES % fill extra space with spaces STEADY C.ARG_WRITTEN -1<-S RADIX 10 <- % reset the radix& LFEED TYO % and leave the wide area ;U9'E.DRAW_ARG : % draw the command argument if there's one_, C.ARG_EXISTS @ IF % is there an argument? E.SHOW_ARG ELSE C.ARG_WRITTEN @ IF# E.ERASE_ARG C.ARG_WRITTEN 0<-r THEN THEN ;UJ'E.SET_CHARS : % get terminal modes, save, set the necessary ones for RED3 OLD_T_ARRAY GETMODE % get mode into 8-byte arraytI OLD_T_ARRAY 0C NEW_T_ARRAY MOVE_BYTES % remember the original settings 8 NEW_T_ARRAY 4+ DUP @ 200 NOT AND <- % clear TT$M_WRAP/ NEW_T_ARRAY 1+ 0 B<- % set type to "UNKNOWN"cN NEW_T_ARRAY 4+ DUP @ 10 OR 100 OR 1000 OR <- % set HOSTSYNC, MECHTAB, SCOPE= NEW_T_ARRAY 8 + DUP @ 01000000 NOT AND <- % clear ANSI_CRTNA NEW_T_ARRAY SETMODE % put the new characteristics into effectS ;D'E.RESET_CHARS : OLD_T_ARRAY SETMODEO ; ;F*[SAOSTOIC.RED]ERR.;1+,"./A 4C- 0123K56ȕ7ȕ89GAHJ C% ***************************************************************** % * */% * This module is a part of the SAO VAX/VMS *$% * RED full-screen text editor * % * *% * It was created by *% * Roger Hauck *!% * Smithsonian Institution *"% * Astrophysical Observatory *(% * Cambridge, Massachusetts 02138 *&% * (617)495-7151 (FTS 830-7151) * % * *&% * This module may be reproduced *.% * provided that this header is retained. * % * *C% ***************************************************************** 9% RED Compile Initialization: first RED code must be here,'RED< BRANCH % define RED vocabulary branch)RED< DEFINITIONS % set definitions to it/'REDMODULE MODULE % define a module for FORGET% End of compile initialization+% NOTE: ERR.MSG moved to EDV display module%'ERR.ABORT : "Command aborted." 2* ;)'ERR.ACTIVE : "Active file present." 2* ;0'ERR.EXTEND : "Using disk-quota overdraft." 2* ;&'ERR.INVARG : "Invalid argument." 2* ;%'ERR.INVCOM : "Invalid command." 2* ;$'ERR.IOERR : "File I/O error." 2* ;%'ERR.ITER : "Iteration error." 2* ;'ERR.NEWFIL : "New file." 2* ;$'ERR.NOBYTE : "Byte not found." 2* ;&'ERR.NOSTRN : "String not found." 2* ;$'ERR.NOTACT : "No active file." 2* ;-'ERR.NOTIMP : "Command not implemented." 2* ;''ERR.OPFAIL : "File OPEN failure." 2* ;6'ERR.TYPCR : "Type carriage return to continue." 2* ;2'ERR.X0ONLY : "Command allowed only from X0." 2* ;3'ERR.CUTFM9 : "Cut not allowed from buffer 9." 2* ;.'ERR.NOARG : "Argument not implemented." 2* ;6'ERR.@TEND : "@T invalid at end of text buffer." 2* ;#'ERR.NOLAB : "No such label." 2* ;$'ERR.INVBRN : "Invalid branch." 2* ;#'ERR.INVLAB : "Invalid label." 2* ;6'ERR.NOTMAC : "Argument only valid inside macro." 2* ;+'ERR.INVREG : "Invalid register name." 2* ;$'ERR.STKOVF : "Stack overflow." 2* ;%'ERR.STKUDF : "Stack underflow." 2* ;*'ERR.MACOVF : "Macro stack overflow." 2* ;6'ERR.TC@END : "TC invalid at end of text buffer." 2* ;4'ERR.^GFKBD : "CTRL/G only valid inside macro." 2* ;2'ERR.STRWRN : "Warning--bad string argument." 2* ;6'ERR.INVSTR : "Macros and iterations not nested." 2* ;5'ERR.LUPOVF : "Too many nested iteration loops." 2* ; 1'ERR.NOTWRT : "File not completely written." 2* ;r*[SAOSTOIC.RED]IMMED.;1+,)./A 4J- 0123K56x7`x89GAHJC% ***************************************************************** % * */% * This module is a part of the SAO VAX/VMS *$% * RED full-screen text editor * % * *% * It was created by *% * Roger Hauck *!% * Smithsonian Institution *"% * Astrophysical Observatory *(% * Cambridge, Massachusetts 02138 *&% * (617)495-7151 (FTS 830-7151) * % * *&% * This module may be reproduced *.% * provided that this header is retained. * % * *C% *****************************************************************t bG% Words for inserting or deleting a single character in IMMEDIATE modeLJ'I.FIND_TOPOWINDOW : % knowing cursor row, find first character in windowC TOP_COUNT SROW @ 1- ( % loop, n = line # of cursor within window%/ BEGIN % search for CR or beginning of fileE 1- DUP LTZ_IF % BOF? " -1 ELSE % yes, keep count; DDUP + B@ CRET EQ THEN END % drop out on CR or BOFn )f DUP LTZ_IF % underflow?& MINUS 1- BLANK_LINES ! ELSE % yes + 1+ BLANK_LINES 0<- THENr DUP PNTR ! TOPOWINDOW! ;A 'I.INSERT :s6 IO_CTRL_C IF DROP ELSE % if interrupted, do nothing: MARK RECALL 1 C.I+ DROP % make it a string and insert THEN ;i#'I.DELETE : % (delete a character)a TOPOP IF % is anything there?4 BOTOTOP @ 1 D.D- DROP THEN % delete from screen ;B6'I.DIAG : % types values of variables in command pane' " TOP_COUNT" MSG TOP_COUNT = =_) ", BOT_COUNT" MSG BOT_COUNT = =' " CURSOR ROW" MSG SROW ? CR / "TOP_WINDOW_STRING" MSG TOP_WINDOW_STRING = =M1 ", BOT_WINDOW_STRING" MSG BOT_WINDOW_STRING = =m! " CURSOR ROW" MSG SCOL ?% ;p*[SAOSTOIC.RED]KBD.;2+,+. /A 4P - 0123K56*7H*89GAHJ,C% ***************************************************************** % * */% * This module is a part of the SAO VAX/VMS *$% * RED full-screen text editor * % * *% * It was created by *% * Roger Hauck *!% * Smithsonian Institution *"% * Astrophysical Observatory *(% * Cambridge, Massachusetts 02138 *&% * (617)495-7151 (FTS 830-7151) * % * *'% * Modifications by Jonathan Mark *% * Summer 1981 * % * *&% * This module may be reproduced *.% * provided that this header is retained. * % * *C% ***************************************************************** *% High-level words for CUT/PASTE facilityN'SET_BLINK : % blinks the cut character, restores cursor to original position; TOP_COUNT SWAP DROP % get the number of bytes in the topA BLINK_POS @ - % get the distance (signed) to the byte to blink( DUP DUP % make there be three of them$ GEZ_IF % is it above the cursor? > C.M- BLINK_CHR C.M+ % yes, move up, blink it, and restore ELSE9 MINUS C.M+ BLINK_CHR MINUS C.M- % otherwise move down& THEN S.CUP % reposition the cursor ;M'CHECK_BLINK : % blinks the cut character if it's just moved into the windowM TOP_COUNT SWAP DROP TOPWINDOW @ - % get the byte number for the window top0 BLINK_POS @ % get the byte number for the cut/ GE % is the cut below the top of the window?< TOP_COUNT SWAP DROP BOTWINDOW @ + % get the window bottom" BLINK_POS @ % get the cut again LE % is it above the bottom? AND, IF % are both true (is it in the window?)/ BLINK_OK @ NOT % has it just come back on? IF SET_BLINK % make it blink= BLINK_OK -1<- % and don't do it again until we have to THEN ELSE5 BLINK_OK 0<- % blink it the next time it returns THEN ;2% Words to move the characters enclosed in the cut1% into buffer 9 (killing current contents) and to%% delete them from the current bufferE'MAKE_ROOM : % count, MAKE_ROOM -- clears buffer 9 and opens a gap 1% (does not clear buffer 9 if APPEND_FLAG is set)! 9 X.PUSH DROP % go to buffer 9D APPEND_FLAG @ NOT IF X.KILL THEN % kill it if we're not appending3 BOTOTOP OVER D.EXPAND X.POP % clear enough space ;H'MOVE_STUFF : % moves all bytes between a cut and the cursor to buffer 9M BLINK_POS @ TOP_COUNT SWAP DROP - % find out how many bytes are in the cut NEZ_IF % are there any? UNDROP DUP5 LTZ_IF % is the cursor at the end of the region?; UNDROP MINUS C.M- MINUS % yes, move to the beginning THEN# MAKE_ROOM % clear enough space) TOPOBOT @ OVER % make a descriptor8 9 X.PUSH DROP TOPOTOP ASE X.POP % move the string1 C.D+ % and delete it from the current buffer ELSE; WRITE_CHR % rewrite the character to stop the blinking5 APPEND_FLAG @ NOT IF % are we appending nothing?5 9 X.PUSH DROP X.KILL X.POP % no, kill buffer 99 PASTE_FLAG -1<- % and don't safeguard the contents THEN THEN ;-% High-level words for keyboard interpretter'K.KILL_COMMAND :% KBUF DUP 4+ MOVE % zero-out buffer1 KBUF C+ DUP 4- MOVE % also clear bottom dynast% ERASE_COMMAND % erase command paneE CUT_FLAG @ IF "CUT MODE" MSG CR THEN % if cutting, display message@ TERMINATORS 0<- % initialize count of consecutive terminators/ DRAW_COMMAND_CURSOR % and put a cursor there ;-'INST_MACRO : % byte after ESC O, INST_MACRO- ASCII q - 1+ % make it a value from 1 to 9* CURKBUF @ % save the current key buffer? SWAP DUP 2+ KBUF# ! 10 * X0 + CURKBUF ! % set the key buffer( CLI S.CUP FLUSH % process the command; DUP CURKBUF ! K0 - 10 / KBUF# ! % restore the key buffer ;/'TOGGLE_IMODE : % (toggles INSTANTANEOUS mode)+ CUT_FLAG @ NOT IF % is cut mode enabled? IMODE 1+! % toggle the flag IMODE @ IF3 ERASE_COMMAND "IMMEDIATE MODE" MSG S.CUP ELSE DRAW_COMMAND THEN ELSE BELL THEN ;9% 'TOGGLE_MARK : toggles 8th bit of character at cursor&% BOT_COUNT GTZ_IF anything there?>% B@ DUP 7F AND CRET NE_IF yes, is it a carriage return?2% 80 XOR DUP TOPOBOT @ B! no, flip the bit4% E.TYO 8 TYO redraw character and backspace'% 1 C.M+ ELSE move one position% DROP THEN ELSE% DROP THEN% ;3'CLEAR_OPTIONS : % gets rid of the option messages DRAW_DIVIDER IMODE @ IF, ERASE_COMMAND "IMMEDIATE MODE" MSG S.CUP ELSE DRAW_COMMAND THEN ; 'CUT_INIT :( PASTE_FLAG @ NOT IF CLEAR_OPTIONS THEN8 TOP_COUNT BLINK_POS ! DROP % remember the byte number0 BLINK_CHR % blink the character at the cursor. BLINK_OK -1<- % remember that it's blinking$ CUT_FLAG 1+! % toggle the cut flagP IMODE @ SWAP IMODE 0<- % push mode (retrieve truth value), force command mode7 KBUF @ KBUF D@- C.OLDSTR .MOVE_STRING % save command K.KILL_COMMAND % and kill it DRAW_COMMAND. PASTE_FLAG 0<- % and remember no pastes yet ; 6'CUT_APPEND : % starts a cut with the append flag set+ APPEND_FLAG -1<- % remember to append it CUT_INIT % and start the cut ;5'OPEN_CUT : % called when a first cut is interpreted2 APPEND_FLAG 0<- % don't append unless set later2 PASTE_FLAG @ 1+ IF % was the last cut restored?. SHOW_OPTIONS % no; print out the messages2 BEGIN % loop until a legal character is typed TYI CONVERT_TO_UPPER DISPATCH 0D CUT_INIT % CR! DISPATCH 41 CUT_APPEND % A$ DISPATCH 51 CLEAR_OPTIONS % Q DROP 0 END ELSE& CUT_INIT % simply start a new cut THEN ;"'TOGGLE_MARK : % toggles cut mode CUT_FLAG @ % check the value* IF % has a cut region just been closed?1 MOVE_STUFF % move enclosed bytes to buffer 9# CUT_FLAG 1+! % toggle the flag= K.KILL_COMMAND C.OLDSTR COUNT KBUF ASE % restore command% SWAP IMODE ! % retrieve the mode< IMODE @ % show either IMMEDIATE MODE or current command IF. ERASE_COMMAND "IMMEDIATE MODE" MSG S.CUP ELSE DRAW_COMMAND THENC TERMINATORS OLD_TERM @ <- % retrieve the number of terminators" ELSE % is this a beginning cut?4 BUFFER# @ 9 EQ_IF % are we already at buffer 9?1 ERR.CUTFM9 ERR.MSG % yes; make angry noises% S.CUP % and restore the cursor ELSEI OLD_TERM TERMINATORS @ <- % save the number of command terminators- OPEN_CUT % ok; call the routine for it THEN THEN ;E'K.CUT_SEARCH : % count, KBD.CUT_SEARCH: searches for string in KBUF' KBUF @ 1+ % get the starting address' KBUF D@- 3 - % get the string lengthE KBUF @ B@ ASCII - EQ_IF % is there a minus as the first character?= 1- SWAP 1+ SWAP -1 % yes; fix pointers and push -1 value! C.ARG -1<- % negate argument ELSE) 1 % push 1 iteration count otherwise" C.ARG 1<- % set argument to 1 THEN C..S? DUP NOT IF ERR.MSG ELSE DROP THEN % print error if necessary ;I'KILL_TERMINATORS : % deletes up to 2 trailing line feeds in text buffer) % (cursor should already be at the end) 2 ( TOPOP % get a byte! NEZ_IF % was there anything?C DUP LFEED NE_IF TOPUSH EXIT ELSE DROP THEN % take care of it ELSE- EXIT % no more bytes on top; exit loop THEN ) ;'RESTORE_KBUF :, UNDROP 1- % recover the old buffer number# C.Z DROP % move to end of buffer DUP BUFFER# ! % yes 10 * X0 + CURBUF ! 0 KBUF# ! K0 CURKBUF ! TEXT_BUF 0<-B TERMINATORS 0<- % remember no terminators for retrieved command ; 'SET_KBUF :< BUFFER# @ 1+ TEXT_BUF ! % save the buffer number (plus 1); 1 KBUF# ! K0 10 + CURKBUF ! % switch the keyboard buffer6 -2 BUFFER# ! K0 CURBUF ! % and move the text buffer+ ASCII ~ TOPUSH TOPOP 2DROP % force a gap, KILL_TERMINATORS % get rid of terminators ;'TOGGLE_KBUF :3 CUT_FLAG @ IF BELL -1 ELSE % are we in cut mode?1 TEXT_BUF @ NEZ_IF % are we going back to K0? RESTORE_KBUF ELSE SET_KBUFA THEN SETSCREEN DISP DRAW_COMMAND % refresh screen either way* -1 % leave a success values THEN ;pD'PASTE : % inserts the contents of buffer 9 into the current buffer3 CUT_FLAG @ IF % is cut mode currently activated? " BELL % yes; don't allow paste ELSE C.XARG 1<- % do it once( C.ARG 9 <- % simulate from buffer 9 C.XG % get the stuff ' DROP % get rid of the error codea= PASTE_FLAG -1<- % remember characters have been restored  THEN ;m'TOGGLE_BACKGROUND : BACKGROUND 1+! BACKGROUND @ IFs LIGHT_BACKGROUND ELSE* DARK_BACKGROUND THEN ;*;'SCAN_CUT : % take action to blink a character if necessary # CUT_FLAG @ % are we in cut mode?: IF? CHECK_BLINK % yes; blink the character if it's not alreadyO THEN ;D/'CTRL-R : % causes an immediate screen refresh_E ANSI_VT100 ESC[ "?6l" MSG APPLICATION_KEYPAD WRAP_OFF SMOOTH_SCROLL% SETSCREEN DISP DISP_FLUSHA CUT_FLAG @ NOT IF IMODE 1+! TOGGLE_IMODE ELSE DRAW_COMMAND THENs SCAN_CUT -1 % always succeedsL ;  S% Escape-sequence interpreter$'FOUND_ESCO : % FOUND_ESCO, success&% succeeds if it gets a valid sequence -1 % indicate successi" TYI % get next char. from kybd.9 DUP ASCII q LE OVER ASCII y GE AND IF % is it a numberf" INST_MACRO % yes, run a macro ELSE) DISPATCH 'M TOGGLE_IMODE % enter keyt$ DISPATCH 'm TOGGLE_MARK % - key DISPATCH 'l PASTE % , key* DISPATCH 'n TOGGLE_BACKGROUND % . key$ DISPATCH 'p TOGGLE_IMODE % zero7 DISPATCH 'P TF_-LL % PF1, skip (TF) lines forewardi6 DISPATCH 'Q TF_LL % PF2, skip (TF) lines backward7 DISPATCH 'R I.WORDLEFT % PF3, skip 1 word backwardK7 DISPATCH 'S I.WORDRIGHT % PF4, skip 1 word forwardN3 DROP BELL % invalid escape sequence, ring belli THEN ; D'FOUND_ESCO.CUT : % same as FOUND_ESCO but allows only moves, cuts  -1 TYIl DISPATCH 'm TOGGLE_MARKt; DISPATCH 'n TOGGLE_BACKGROUND % allow background changes  DISPATCH 'P TF_-LL DISPATCH 'Q TF_LLn DISPATCH 'R I.WORDLEFT DISPATCH 'S I.WORDRIGHT DROP BELL  ;H('FOUND_ESC[ : % FOUND_ESC[, not success -1 % indicate success so far'/ 1 % count of 1 for operation to be performed%% TYI % get next char. from keyboardF& DISPATCH 'A C.UP_ARROW % up arrow" DISPATCH 'B C.L+ % down arrow" DISPATCH 'C C.M+ % left arrow# DISPATCH 'D C.M- % right arrow_* DROP BELL % invalid sequence, ring bell ; ''FOUND_ESC : % here upon finding "ESC"% TYI % get next char. from keyboardo DISPATCH '[ FOUND_ESC[ DISPATCH 'O FOUND_ESCO# ASCII S EQ IF % escape to STOIC?  0 ELSE % yeso/ BELL -1 THEN % no, invalid escape sequence  ;tI'FOUND_ESC.CUT : % same as FOUND_ESC but gives control to FOUND_ESCO.CUTH TYIw DISPATCH '[ FOUND_ESC[ DISPATCH 'O FOUND_ESCO.CUT ASCII S EQ IF 0 ELSE BELL -1 THEN ;U 'FOUND_DEL :! I.DELETE -1 % delete characterA ;L --% Process LINEFEED or DELETE in command Kk=~ REDBUILD.BAK+ [SAOSTOIC.RED]KBD.;25OBJ;2P  modeH'K.LF : % line feed0 D.COM_POS % put real cursor at command cursor7 TERMINATORS @ 1 GE IF % how many terminators so far? . TERMINATORS 1+! % 1 or less, add this one8 LFEED KBUF ABE THEN % and append it to command line) ASCII ~ D.COM_APPEND % echo as tildea6 TERMINATORS @ 2 LE IF % 2 or more terminators now?( CUT_FLAG @ IF % are we in cut mode? K.CUT_SEARCH DRAW_COMMAND ELSE> FLUSH CLI DRAW_COMMAND THEN % yes, execute command line THEN -1 % always succeed ;%'K.DEL : % delete, do it0 KBUF RBE IF % remove last character, success? DUP LFEED EQ_IF + DROP ASCII ~ % make line feed into ~K THEN( D.COM_DEL % delete it on the screen6 TERMINATORS @ GTZ_IF % is last byte a terminator?3 TERMINATORS 1-! % yes, decrement term. countM THEN THEN -1 % always succeed ; 'K.CUT_S :# ASCII S DUP KBUF ABE D.COM_APPEND  ;R'K.CUT_MINUS :# ASCII - DUP KBUF ABE D.COM_APPENDT ;_'K.CHECK_CUT_LETTER :o* KBUF D@- EQZ_IF % are there no letters? CONVERT_TO_UPPER DISPATCH 'S K.CUT_S_ DISPATCH '- K.CUT_MINUSt DROP BELL0 ELSE0 KBUF @ B@ ASCII - EQ_IF % is there a minus? CONVERT_TO_UPPER DISPATCH 'S K.CUT_S+ DROP BELLp ELSE DUP KBUF ABE D.COM_APPENDP THEN THEN ;R&'K.APPEND : % character, K.APPEND, -1*% appends character to keyboard buffer and% updates displayEC IO_CTRL_C IF DROP ELSE % do nothing if control-C interrupted I/O ( CUT_FLAG @ IF % is cut mode active?0 KBUF D@- % count characters in key buffer& 2 LE_IF % are there at least 2?< DUP KBUF ABE D.COM_APPEND % yes; append the new one ELSE K.CHECK_CUT_LETTER THEN ELSE9 TERMINATORS @ 2 LE_IF % are there two terminators? 8 K.KILL_COMMAND THEN % yes, discard command line2 TERMINATORS 0<- % zero-out terminator count/ DUP KBUF ABE % append to keyboard buffert& D.COM_APPEND % append on screen THEN THEN ;t #% Get next character from keyboard:d% KBD_COM for command mode% KBD_IMM for immediate mode% KBD_CUT for cut modeD'KBD_COM : % interpret next character from keyboard in command mode! DISPATCH 1B FOUND_ESC % escapea DISPATCH 7F K.DEL % deleteO DISPATCH 0A K.LF % line feed DISPATCH 12 CTRL-R % ^R 15 EQ_IF % ^U?1 K.KILL_COMMAND ELSE % yes, kill command lineT3 UNDROP K.APPEND THEN -1 % no, append character  ; F'KBD_IMM : % interpret next character from keyboard in immediate mode DISPATCH 1B FOUND_ESCn DISPATCH 7F FOUND_DELT DISPATCH 12 CTRL-R % ^R I.INSERT -1G ;c'INTERPRET_COMMAND_BYTE : & DISPATCH 06 TOGGLE_KBUF % control-FB KBD_COM % insert in command if not an immediate instant command ; a @% Routine to get keyboard input. This routine simply does a TYI@% **unless** RED is in immediate mode, on the end of a line. In@% that case, it uses INPUT_TEXT to read its key as a terminator. 'GET_KEY :0 BOT_COUNT UNDER EQZ_IF % bottom buffer empty?< -1 % if so, OK to INPUT_TEXT if we're in immediate mode ELSE; TOPOBOT @ B@ CRET EQ % otherwise OK if next char is CRa THEN/ IMODE @ AND IF % can we simulate input mode?s? INPUT_TEXT % yes; read some text and return the terminator  ELSE$ TYI % otherwise do normal input THEN ; % RED's main loop'SELECT_MODE : DISPATCH 02 C.B % control-B DISPATCH 1A C.Z % control-Z* IMODE @ IF % IMMEDIATE or COMMAND mode? KBD_IMM % IMMEDIATE mode% ELSE INTERPRET_COMMAND_BYTE THEN ; 'KEY_LOOP :t/ DISP_FLUSH % flush accumulated screen output 7 SCAN_CUT % if there is a cut make sure it's blinkingf5 CTRL_C_FLAG @ IF % has control-C been typed ahead?e9 O.BUFCUR O.BUFSTRT <- % yes; clear the output buffers= CTRL-R DROP CTRL_C_FLAG 0<- % refresh screen, clear flag  THEN GET_KEY % get next characteri 08 EQ_IF % backspace?? TYI 1F AND IMODE @ IF % yes, convert next char. to controlf I.INSERT ELSEu K.APPEND THEN -1 ELSE UNDROP SELECT_MODE  THEN ; 7'KBD : % KBD (keyboard interpretter, main loop of RED)O2 CTRL_C_HANDLER 0<- % disable ABORT on control-C1 6 RESET_MODE BUFFER_ON % start buffered output . ANSI_VT100 APPLICATION_KEYPAD % setup VT100- IMODE -1<- TOGGLE_IMODE % set COMMAND mode 5 K.KILL_COMMAND % initialize command line & cursors! BEGIN % main loop3 KEY_LOOP NOT % read a character, get exit codeo ENDa D.COM_POSi BUFFER_OFF# 'I_CTRL_C_HNDLR COUNT I_LOOKUP IFTG CODE_COUNT DROP CTRL_C_HANDLER ! THEN % restore ABORT on control-C  ;s*[SAOSTOIC.RED]RED.;5+,,./A 4O- 0123K56 z^7`&C^89GAHJ C% ***************************************************************** % * */% * This module is a part of the SAO VAX/VMS *$% * RED full-screen text editor * % * *% * It was created by *% * Roger Hauck *!% * Smithsonian Institution *"% * Astrophysical Observatory *(% * Cambridge, Massachusetts 02138 *&% * (617)495-7151 (FTS 830-7151) * % * *&% * This module may be reproduced *.% * provided that this header is retained. * % * *C% ***************************************************************** >'LOAD_ERROR : % take proper action if initial file open fails4 DUP 18292 EQ_IF % is it the file-not-found error?1 DROP ERR.NEWFIL ERR.MSG % yes, let user know& ELSE % if not, it's something worse. SYSMSG TYPE % display it in the text area< 0 FILE_NAME W! % don't set the file name if open failed@ ERR.OPFAIL ERR.MSG SETSCREEN % display open-failure message THEN ;1'.RED : % [file name descriptor, -1] or [0], RED- RED< % push the RED vocatulary at run-time E.SET_CHARS/BUFFER_ON % reset origin mode, activate bufferCINIT_VT100 ESC[ "?6l" MSG APPLICATION_KEYPAD WRAP_OFF SMOOTH_SCROLL FLUSH E.INIT)% open file if specified in command line IF % is there a filename?* FILE_NAME .MOVE_STRING % yes, save it THENC SETSCREEN DISP_FLUSH FILE_NAME W@ NEZ_IF % is there a file name?O FILE_NAME COUNT F.OPEN_FILE DUP IF DROP ELSE % yes, load file, successful?A LOAD_ERROR % show "new file" if file not found, else error. REC_SEP CRET <- MAIN_SEP CRET <- THEN THEN6 DISP BUFFER_OFF LOAD_RESET KBD % close files and go ; 'REDCPU : TIME_FLAG 1+! WORD .RED ; IMMEDIATE:> DEFINITIONS % reset definitions to normal KERNEL branch!RED< % push RED vocabulary again'RED :8 SPACE_FLAG -1<- % allow and as commands5 WORD .RED % get the file name from the line buffer ; IMMEDIATE 'RED_NOSP :< SPACE_FLAG 0<- % don't allow and as commands WORD .RED % and do normal RED ; IMMEDIATE/'REDOUT : % called from STOIC to terminate RED> D.START @ .D ! % reset data pointer to first dynast pointer* 0 FILE_NAME W! % reset file name string? E.RESET_CHARS % reset to user's DCL terminal characteristics6 RESET_TERMINAL WAIT_FOR_RESET % and reset the VT100 ;> % pop the RED vocabulary;F*[SAOSTOIC.RED]RED.CRE;3+,5./A 4- 0123K56}s7js89GAHJ$ STOIC := $SAO$STOIC:STOIC$ STOIC 'ERR LOAD/L 'DYNA LOAD/L 'E LOAD/L'WINDOW LOAD/L 'EDV LOAD/L 'EB LOAD/L'COMMAND LOAD/L 'IMMED LOAD/L 'CLI LOAD/L 'KBD LOAD/L 'RED LOAD/L"[Creating RED.EXE]" MSG CR'SYS$LOGIN:RED.EXE IMAGE;F*[SAOSTOIC.RED]RED.CRE;2+,!./A 4- 0123K56A7R89GAHJ$ STOIC := $SAO$STOIC:STOIC$ STOIC 'ERR LOAD/L 'DYNA LOAD/L 'E LOAD/L'WINDOW LOAD/L 'EDV LOAD/L 'EB LOAD/L'COMMAND LOAD/L 'IMMED LOAD/L 'CLI LOAD/L 'KBD LOAD/L 'RED LOAD/L"[Creating RED.EXE]" MSG CR'RED.EXE IMAGE;F*[SAOSTOIC.RED]REDMANUAL.TAB;25+,../A 4C- 0123K5698É7E:8É89GAHJ, RED COMMANDS ( B JUMP TO BEGINNING$ nCabc~def CHANGE STRING' nD DELETE CHARACTER" FIxxx.yyy FILE INSERT= FOxxx.yyy FILE OUTPUT WITH NEW NAME AND CONTINUE4 WORKING FILE UNDER OLD NAME7 GX KILL WORKING FILE WITH NO OUTPUT4 GWxxx.yyy CREATE NEW EMPTY WORKING FILE H EXIT$ nIabc INSERT STRING; J JOURNAL, OUTPUT A NEW VERSION OF THEC= WORKING FILE WITH CHANGES MADE THUS ? FAR (IN CASE THE MACHINE CRASHES) AND " CONTINUE nK KILL LINE. nL LINE, MOVE TO NEXT LINE- nM MOVE TO NEXT CHARACTER9 Oxxx.yyy OPEN EXISTING FILE AS WORKING FILEA( nSabc SEARCH FOR STRING; nTF TV DISPLAYS CURRENT LINE +/- n LINESR@ W WRITE OUTPUT FILE AND DELETE WORKING FILEA nXmC COPY LINE INTO BUFFER Xm AFTER CLEARING Xmi& XD DISPLAY BUFFERS@ nXmG GET BUFFER Xm (INSERT CONTENTS OF BUFFER)0 nXmIC nXmC BUT APPEND TO BUFFER0 nXmIM nXmM BUT APPEND TO BUFFER% XmK KILL BUFFER Xm A nXmM MOVE LINE INTO BUFFER Xm AFTER CLEARING Xmr' AND KILL LINED; XmS SWITCH TO BUFFER Xm, XS SWITCH TO X0a" Z JUMP TO END4 n[commands~]REPEAT n TIMES; CTRL-C ABORTS6 [commands~] REPEAT UNTIL END; CTRL-C ABORTS* SPECIAL KEYS: PF1 SCROLL UP, PF2 SCROLL DOWN? PF3 JUMP LEFT TO BEGINNING OF WORDl: PF4 JUMP RIGHT TO END OF WORD> PAD 0 TOGGLE IMMEDIATE/COMMAND MODE9 PAD . TOGGLE LIGHT/DARK SCREEN < PAD - CUT OUT TEXT BETWEEN CURSORC POSITION WHEN FIRST PRESSED AND A WHEN REPEATED = X9M OR X9IM @ PAD , INSERTS PREVIOUSLY CUT OUT TEXT> AT CURSOR POSITION = X9GA CTRL-R REWRITE SCREEN TO REMOVE GARBAGEE. CTRL-C ABORT COMMAND > Invoke RED by saying RED xxx.yyy or RED and then@ GWxxx.yyy or Oxxx.yyy . The field xxx.yyy stands for= an arbitrary file specification. The working fileE; exists only in virtual memory unless it is savedE> explicitly. If RED displays a message, acknowledge> it with a RETURN. In the immediate mode characters= are added or deleted at the position of the cursor3 which is positioned by arrow or PF keys.nA LINEFEED, indicated ~, is used as punctuation after A commands that have character strings. Commands may be @ individual or run together with the end marked by ~~.? For example, BSabc~L~~ jumps to the beginning, then C? searchs for the first appearance of pattern abc, andF> finally moves to the next line. The default if theA number of repeats n is not specified is 1. To execute B a command in the backward direction use -n. In addition= to the main working buffer X0, there are 9 scratcha= buffers Xm. The default for m is 1 except that XSPB means X0S. An escape sequence is produced by the keys B BACKSPACE,[,letter . For example, escU is BACKSPACE[U.B The fields abc and def stand for any character strings.C Include @SYS$UTIL:REDINIT in LOGIN or type before using.J *[SAOSTOIC.RED]WINDOW.;1+,%./A 4O- 0123K56@"ʍ7 &ʍ89GAHJC% ***************************************************************** % * */% * This module is a part of the SAO VAX/VMS *$% * RED full-screen text editor * % * *% * It was created by *% * Roger Hauck *!% * Smithsonian Institution *"% * Astrophysical Observatory *(% * Cambridge, Massachusetts 02138 *&% * (617)495-7151 (FTS 830-7151) * % * *&% * This module may be reproduced *.% * provided that this header is retained. * % * *C% *****************************************************************  n"% Define Window-related Variables0 'PNTR VARIABLE;0 'TOPWINDOW VARIABLE % # of bytes before cursor in windown:0 'BOTWINDOW VARIABLE % # of bytes after cursor in window50 'BLANK_LINES VARIABLE % # of blank lines in window>'TOPOWINDOW@ : % TOPOWINDOW@, address of first byte of window BOTOTOP @ TOPWINDOW @ -  ;@A'TOPOWINDOW! : % address, TOPWINDOW! (establishes top of window)- BOTOTOP @ - MINUS TOPWINDOW !m ;N'BOTOWINDOW@ : TOPOBOT @ BOTWINDOW @ +I ;'BOTOWINDOW! : TOPOBOT @ - BOTWINDOW !2 ;K5'TOP_WINDOW_STRING : % TOP_WINDOW_STRING, descriptorJ(% of string from top of window to cursor# TOPWINDOW @ BOTOTOP @ OVER - SWAP ;=5'BOT_WINDOW_STRING : % BOT_WINDOW_STRING, descriptorI+% of string from cursor to bottom of windowR TOPOBOT @ BOTWINDOW @o ; P,% Operations relating to window management.8'S.CUP : % S.CUP (puts cursor at preselected position) SROW D@ CUPi ;e 'E.CR_TYO :w DROP % drop attribute request CRET TYO % output CR ; 'E.TAB_TYO : TAB_MODE @ IF % hard tabs?W" DROP % drop attribute request" 09 TYO ELSE % output hard tab/ 1 OR SGR 49 TYO 0 SGR THEN % output bold I ;L'E.TYO :" DUP 80 LE_IF % is mark bit set?6 7F AND 4 ELSE % yes, reset bit, request underline 0 THEN SWAP % noa DISPATCH 0D E.CR_TYO DISPATCH 8D E.CR_TYO DISPATCH 09 E.TAB_TYO@, DUP 20 GT_IF % is it a control character?@ 40 + SWAP 1 OR ELSE % yes, make upper case and request bold SWAP THEN % nos# NEZ_IF % any attribute requests? A UNDROP SGR TYO 0 SGR ELSE % yes, output byte with attributesc TYO THEN % no, normal ; 'PLINE : BEGINa( DUP 1+ SWAP B@ % get next character DUP CRET NE IF E.TYO REPEAT % output it  DROP CR % drop CR, output NL1 8 IDLES % idle ; 4'TW_COUNT : % TW_COUNT, descriptor of top of window TOPOWINDOW@ TOPWINDOW @* ; 7'BW_COUNT : % BW_COUNT, descriptor of bottom of window* TOPOBOT @ BOTWINDOW @  ;n 'E.TYPE :t NEZ_IF UNDROP ERASE_REST_OF_LINEP (V% DUP I + B@ DUP E.TYO CRET EQ_IFw% 0A TYO ERASE_THIS_LINE THEN )y THEN DROPr ;i 'SBB_COUNT : GTZ_IF UNDROP ( SBB DUP LEZ_IF EXIT THEN )  THEN LAST_I ;i09 'TAB CONSTANT ASSEMBLER<1'D.TAB : % current column #, D.TAB, new column #P TAB_MODE @ IF % hard tabs?d6 DECL (P) BICL2 S^ 7 (P) ADDL2 S^ 9 (P) ELSE % yes 1+ THEN % no  ;N> 'FIND_CURSOR_COLUMN :!K CRET TOP_COUNT SBB GEZ_IF % search backwards for carriage return, found?R/ UNDROP + 1+ THEN % yes, calculate locationt6 BOTOTOP @ OVER - % descriptor of string passed over# 1 SWAP % initialize column countR (s OVER I + B@ TAB EQ_IFr/ D.TAB ELSE % yes, calculate new columno. 1+ THEN ) % no, increment column #  SCOL ! % record it 9 2DROP % drop search byte, pointer to beginning of lineU ; 'DEFINE_TOP_OF_WINDOW : + CRET TOP_COUNT TF @ 1+ % setup to searcht5 DUP 1+ SROW ! % set cursor row to center of windows SBB_COUNT % do searchH TF @ - MINUS 0 MAX BLANK_LINES ! % calculate & store # of blank lines( + 1+ TOPOWINDOW! % find top of window DROP % drop search byte FIND_CURSOR_COLUMN ; D'FILL_BOTTOM_WINDOW : % (cursor must be correctly positioned first) TOPOBOT @ % save pointer.( TF @ 1+ ( % loop through bottom lines ERASE_REST_OF_LINE BEGINe BOPOP IF % anything left?H DUP CRET NE ELSE % yes, indicate whether it's a carriage return3 CRET 0 THEN % no, simulate carriage return%% IF % was it a carriage return? , E.TYO REPEAT % no, output character< TYO I' NEZ_IF % yes, output carriage return, last line?, LFEED TYO THEN % no, output line feed )d9 TOPOBOT @ SWAP TOPOBOT ! BOTOWINDOW! % record pointers  ;_'ADD_LINE_AT_BOTTOM :oG TOPOBOT @ BOTOWINDOW@ TOPOBOT ! % temporarily redefine bottom buffers BEGINf BOPOP IF % anything left?! DUP E.TYO % yes, output it CRET EQ ELSE % stop if CR -1 THEN % EOF, stop ENDT# TOPOBOT @ % new bottom of windowT) SWAP TOPOBOT ! % restore bottom bufferS' BOTOWINDOW! % store bottom of window  ;U'FIND_CURSOR : SCOL 1<- SROW 1<-- TW_COUNT ( % scan through bottom of window< DUP I + B@ % next byte# CRET EQ_IF % is it a CRA SCOL 1<- SROW 1+<- ELSE % yes, reset column, increment row)& UNDROP TAB EQ_IF % is it a tab?5 SCOL @ D.TAB SCOL ! ELSE % yes, get column #I2 SCOL 1+! THEN THEN % no, increment column ) DROP- SROW BLANK_LINES @ 1+ +<- % get real row #  ;R 'SETSCREEN : DISP_FLAG 2 <- ;'DISP :  DISP_FLAG @ 1 OR DISP_FLAG ! ; 9%**************** TEMPORARY DEFINITIONS ***************e'NSCROLL : DROP DISP ;'-NSCROLL : DROP DISP ;c9%********************************************************b='REVISE_WINDOW : % (scrolls if necessary and redraws cursor) / 1 SROW @ - DUP GEZ IF % cursor above window?( 1+ -NSCROLL ELSE % yes, scroll down: WINDOW_SIZE + MINUS DUP GTZ IF % cursor below window?3 NSCROLL ELSE DROP THEN THEN % yes, scroll up S.CUPP ;O/'SCROLL_DOWN_1 : % screen must be set up firste RI % scroll downNI TOPOWINDOW@ DUP 1- TOPOTOP @ MAX DUP TOPOWINDOW! % reduce at least ones& BEGIN % loop till top of file or CR1 1- DUP TOPOTOP @ GT IF % past the beginning?_! -1 ELSE % yes, signal exit . DUP B@ CRET EQ THEN % signal exit if CR& END 1+ % new value for TOPOWINDOW SWAP OVER - GTZ_IF5 UNDROP ( DUP I + B@ E.TYO ) ELSE % draw the linec BLANK_LINES 1+!  THEN % store new valuet TOPOWINDOW!  ;'O'FIND_BOTOWINDOW : % stores position of first char. below screen in BOTOWINDOWp TOPOBOT @ % save TOPOBOTO WINDOW_SIZE 2+ SROW @ - (! BEGINp! BOPOP IF % any more bytes?O( CRET EQ ELSE % signal end if CR" -1 THEN % EOF, signal end END ) % got itn# TOPOBOT @ % new bottom of window ) SWAP TOPOBOT ! % restore bottom bufferR' BOTOWINDOW! % store bottom of window  ;O*[SAOSTOIC]STOBUILD.COM;15+,./A 4@- 0123K56 G,Wr7[Wr89GAHJ@$! STOBUILD: command procedure to assign the STOIC logical names>$! from the current default directory, and run the three STOIC$! build files.5$ @ASSIGN !assign SAO$KERNEL, SAO$STOIC, and SAO$RED2$ SET DEF SAO$KERNEL !move to the kernel directory$ TYPE SYS$INPUTBuilding RKERNEL.EXE ...'$ IF "''P1'" .NES. "MAC" THEN GOTO LINK&$ @KERMAC !assemble the MACRO sources$ LINK: $ @KERLINK$ SET DEF SAO$STOIC$ TYPE SYS$INPUT!Loading the STOIC definitions ...7$ @STOIC.CRE !load STOIC input files; create STOIC.EXE$ SET DEF SAO$RED$ TYPE SYS$INPUTLoading RED ... $ @RED.CRE$ TYPE SYS$INPUT/Finished; current default directory is SAO$RED.6To create the INFOTON version now, type "@ORANGE.CRE".*[SAOSTOIC]STOIC.DIR;1+, ./A 4- 0123 K56Zs7VIs89GAHJIFLOAT.IMAGE.OBUF.RDEF.  STOIC.CRE1VT100. *[SAOSTOIC.STOIC]FLOAT.;1+,./A 4J- 0123K56_in7n89GAHJ %% Floating point words for VAX STOIC% Jonathan Mark 1982BFLOAT< DEFINITIONS % (FLOAT vocabulary initialized in KERNEL.MAR) ASSEMBLER<0RADIX @ HEX % save radix and set to hexadecimal % StorageC15 'F_STRING SVARIABLE % room for 16 digits, plus ".", plus "Esnn"&% Floating<-->Integer conversion words1'I->F : CVTLD (P)+ -(FS) ; % integer to floating1'F->I : CVTDL (FS)+ -(P) ; % floating to integer0% Words for manipulation of floating point stack4'.DUP : INLINE< MOVQ (FS) -(FS) >INLINE ; IMMEDIATE9'.OVER : INLINE< MOVQ B^(FS) 8 -(FS) >INLINE ; IMMEDIATE1'.DDUP : INLINE< .OVER .OVER >INLINE ; IMMEDIATE3'.DROP : INLINE< ADDL2 S^ 8 FS >INLINE ; IMMEDIATE5'.2DROP : INLINE< ADDL2 S^ 10 FS >INLINE ; IMMEDIATE;'.SWAP : MOVQ B^(FS) 8 R0 MOVQ (FS)+ (FS) MOVQ R0 -(FS) ;4'.+ROT : % arg1, arg2, arg3, +ROT, arg2, arg1, arg3/ MOVQ (FS) R0 % r0 is temporary stack pointer$ MOVQ B^(FS) 8 (FS) % move up arg1) MOVQ B^(FS) 10 B^(FS) 8 % move up arg2+ MOVL R0 B^(FS) 10 % put arg3 underneath ;4'.-ROT : % arg1, arg2, arg3, -ROT, arg1, arg3, arg2% MOVL B^(FS) 10 R0 % set arg1 aside+ MOVQ B^(FS) 8 B^(FS) 10 % move arg3 down& MOVQ (FS) B^(FS) 8 % move arg2 down! MOVL R0 (FS) % put arg1 on top ;D'.UNDER : % value1, value2, UNDER, value2 (drops next to top value) .SWAP .DROP ;@'.FLIP : % value1, value2, value3, FLIP, value1, value2, value38 MOVL (FS) R0 MOVL (FS) B^ 10 (FS) MOVL R0 (FS) B^ 10 ; % Floating point operation words3'.+ : INLINE< ADDD2 (FS)+ (FS) >INLINE ; IMMEDIATE3'.- : INLINE< SUBD2 (FS)+ (FS) >INLINE ; IMMEDIATE-'.* : % multiplier, multiplicand, *, product MULD2 (FS)+ (FS) ;''./ : % divisor, dividend, /, quotient DIVD2 (FS)+ (FS) ;'.MINUS : MNEGD (FS) (FS) ;A'.^ : .POWDD ; % make a readable form of the exponentiation wordJ'.EFIX : % f.p. value, .EFIX, pos. exponent on p-stack, new value <1 on F 0 BEGIN6 .DUP F->I ABS NEZ_IF % whole part greater than 0?# 10. ./ % divide number by 10n! 1+ % and add 1 to exponentO" 0 % signal to continue loop ELSE -1 % if done, halt loop THEN ENDn ; % Floating point comparisons '.NEZ : TSTD (FS)+ BNEQ ITEFT ; '.EQZ : TSTD (FS)+ BEQL ITEFT ; '.GTZ : TSTD (FS)+ BGTR ITEFT ; '.LEZ : TSTD (FS)+ BLEQ ITEFT ; '.GEZ : TSTD (FS)+ BGEQ ITEFT ; '.LTZ : TSTD (FS)+ BLSS ITEFT ;%'.NE : CMPD (FS)+ (FS)+ BNEQ ITEFT ; %'.EQ : CMPD (FS)+ (FS)+ BEQL ITEFT ; %'.GT : CMPD (FS)+ (FS)+ BGTR ITEFT ;.%'.LE : CMPD (FS)+ (FS)+ BLEQ ITEFT ;I%'.GE : CMPD (FS)+ (FS)+ BGEQ ITEFT ;R%'.LT : CMPD (FS)+ (FS)+ BLSS ITEFT ;ID'.EQ_IF : % value1, value2, EQ_IF (combines function of EQ and IF)I +CHECK INLINE< CMPD (FS)+ (FS)+ BNEQ >INLINE TARGET ; IMMEDIATEQJ'.NE_IF : +CHECK INLINE< CMPD (FS)+ (FS)+ BEQL >INLINE TARGET ; IMMEDIATEJ'.GT_IF : +CHECK INLINE< CMPD (FS)+ (FS)+ BLEQ >INLINE TARGET ; IMMEDIATEJ'.LE_IF : +CHECK INLINE< CMPD (FS)+ (FS)+ BGTR >INLINE TARGET ; IMMEDIATEJ'.GE_IF : +CHECK INLINE< CMPD (FS)+ (FS)+ BLSS >INLINE TARGET ; IMMEDIATEJ'.LT_IF : +CHECK INLINE< CMPD (FS)+ (FS)+ BGEQ >INLINE TARGET ; IMMEDIATE?'.EQZ_IF : % value, EQZ_IF (combines compare to zero with IF)FC +CHECK INLINE< TSTD (FS)+ BNEQ >INLINE TARGET ; IMMEDIATEaD'.NEZ_IF : +CHECK INLINE< TSTD (FS)+ BEQL >INLINE TARGET ; IMMEDIATED'.GTZ_IF : +CHECK INLINE< TSTD (FS)+ BLEQ >INLINE TARGET ; IMMEDIATED'.LEZ_IF : +CHECK INLINE< TSTD (FS)+ BGTR >INLINE TARGET ; IMMEDIATED'.GEZ_IF : +CHECK INLINE< TSTD (FS)+ BLSS >INLINE TARGET ; IMMEDIATED'.LTZ_IF : +CHECK INLINE< TSTD (FS)+ BGEQ >INLINE TARGET ; IMMEDIATE$% Simple floating point output wordsC'F->S : % string appears in F_STRING, number is popped off f-stack : 16 F_STRING W! % make sure F_STRING is its maximum sizeD F_STRING COUNT FLOAT_TO_STRING % and call common run-time routine ;.'.= : ' F->S % convert floating point numbere F_STRING MSG % and output it> ; "% Floating point output conversion80 'F.EXPADD VARIABLE % -1 before decimal point, 0 afterB0 'F.10POWER VARIABLE % highest multiple of 10 lt or eq to number70 'F.WHOLE VARIABLE % integer part presently convertedi'.PUT :m4 OCONSTACK 4 + @ B! % store the digit on the stack, OCONSTACK 4 + 1+! % increment the pointer ;I,'.<# : % Start number conversion (floating)+ OCONSTACK 4 + DUP 4 - @ <- % reset stack+9 -1 F.EXPADD ! % thing to add to exponent on conversion.0 .EFIX F.10POWER ! % make <1, save power of 10' 0 F.WHOLE ! % save whole number partF ;F8'.#> : % .#>, byte pointer, count (of converted number)* .DROP % get rid of un-converted portion/ F.10POWER @ NEZ_IF % is there some exponent?i; UNDROP DUP GEZ_IF ASCII + ELSE ASCII - THEN % get signN" ASCII E .PUT .PUT % make "Es"= ABS RADIX @ /MOD SWAP #A .PUT #A .PUT % store two digitsM THEN% OCONSTACK @ % beginning of stringS" OCONSTACK 4 + @ % end of string OVER - % countN ; B'.E#> : % .E#>: same as .#> but always produces a signed exponent* .DROP % get rid of un-converted portion> F.10POWER @ DUP GEZ_IF ASCII + ELSE ASCII - THEN % get sign ASCII E .PUT .PUT % make "Es"; ABS RADIX @ /MOD SWAP #A .PUT #A .PUT % store two digits % OCONSTACK @ % beginning of stringN" OCONSTACK 4 + @ % end of string OVER - % countD ;+'.# :L> RADIX @ DUP I->F .* F.WHOLE @ * F.WHOLE ! % adjust by radix@ .DUP F->I F.WHOLE @ - % get whole part and subtract for digit #A .PUT % store the digit1 F.10POWER DUP @ F.EXPADD @ + <- % fix exponentN= .DUP F->I F.WHOLE ! % get this whole part for the next one  ;N'>.< : % same arguments as .#4 F.EXPADD 0<- % stop subtracting from the exponent3 ASCII . .PUT % put a decimal point on the stringS ; @% General-purpose conversion word (4 digits after decimal point)'.<#> :  .DUP .LTZ NOTE( .<# RECALL IF ASCII - .PUT .MINUS THEN BEGIN  F.10POWER @ NEZe IF .# REPEAT >.< 4 ( .# ) .#> ;a% Fortran-type conversion wordsF@'.ERRCHK : % size, digits of fraction, .ERRCHK: checks validity2 DDUP GEZ SWAP GTZ AND % ok with regard to zero?C 2OVER 2OVER - GTZ % enough space for at least the decimal point?mG AND NOT IF "Floating point output conversion error." MSG I_ABORT THEN+ ;i@'.SELECT : % size, digits of fraction, .SELECT: converts digits SWAP % now digits, field sizeG .DUP .LEZ IF 1- .MINUS -1 ELSE 0 THEN NOTE % take action if negatives% 1- % fix for decimal point space a= OVER - % get number of digits allowed before decimal point8 DUP F.10POWER @ - ( 20 .PUT ) % set up leading blanksB RECALL IF ASCII - .PUT THEN % add "-" if negative was signalledC F.10POWER @ MIN ( .# ) % convert the rest of the integer portion-= >.< ( .# ) % convert the right number of fractional digits  ; F'F= : % field size, digits after d.p., (number on f-stack), F=, desc./ .ERRCHK % make sure the two arguments are oko7 .<# .SELECT .#> TYPE % perform conversion and outputm ;.;'E= : % same as F= but forces an exponent within the field " SWAP 4- SWAP % make room for it$ .ERRCHK % and check the arguments1 .<# .SELECT .E#> TYPE % perform the conversion  ; $% Words for floating point variables'.@ : MOVD @(P)+ -(FS) ;'.! : MOVD (FS)+ @(P)+ ; '.? : .@ .= ;% '.VARIABLE := .D@ DUP -ROT CONSTANT % constant points to next free spaceL0 8 .D+! % make 8 bytes of space for the number/ .! % and store the number in the data regiont ;A> % close assembler branch0> % and close FLOAT0DEFINITIONS % reset definitions to STOIC branch@'FLODEF : FLOAT< DECIMAL ; IMMEDIATE % for calculator functionRADIX ! % restore the radix;F*[SAOSTOIC.STOIC]IMAGE.;17+,./A 4R- 0123K56!Ƌ7yƋ89GAHJ Mj" [SAOSTOIC.KERNKJOUJ?TOBJ;0<٠2uV1R]EX/` &<7nT31+[||q6I7ZwX&Aa:\=??+P7Q5)-1 Q&OHX!sK0^-}dPш_S"qcCc&T?QhnXHA|;T qxs@@&5:tOxLSGw$3\N }k $bu\Id}v9d qElD$n@&.LK8,+/7\ Z 9PL{$*$mFsl(~X$X6wl)yǠH[PFkf'KikR I=D3L7PZM  j\B6}(1jH?1TMz3O^hzfvj//fmPeZ~M֛ӏfFQ3,S?d3E0%2XZ'(vGULe^{blCY~~KQj.^880OH!Ay2SvBY dIx>MkyvIvRP?[H)azg#J}%cXLXzk l#Y#c[f dbWKqM4K]}i1w9v,^tw]N:qo&Div'FUs$61mkq 찇z;M0Oƾ+%b.X/ D,ɺŁu;H @<6k?G"u.A4fE) R1=R*QFEu }p=8EFJpjn.OR\{3-GF]$;ѱM6HRSGTޱKfb8?U:ty$X$(ahv'xA^,4D#{)j=e+.#F |OF? &6i<@C)rV]5|Tp^E+Nz;^9WMKU-6γͭjJC Pq:{#}nr{?=vss1?Olx6ZL&! ?dl#P'EF3!ov_J7rA[w"7}:}#2H <#L\i0^_j "Lti,O*7AW0+|'MQ 0{4N@c`UPw81,LvFE5nWQqJ]n5bK Jx};1" N O& La\ W4p*`^P&8P@[V]-{bkR bZhYnI:z,4vqLtbdmcw$$BtOkpW'Mk D@[;Ah;4976| lq>MF#rwH{/kļYsDQ?7JwJP=2jEV5"4OGK\F@A7] Sp$7TZzop1)BiY 9B}4_@hMQuAUe9vzt6X>OL5;V~+ZjXUz(UPi^Ny|5_=)u?)0 fgKF#i8!9mcVVD5IA&؛P-J|;dCenz-r89lj{2UF:`2y[ߡ,klC@ !!}pG&cn3.3Lhڜ7;]~ܖADO>Odh|3tSd+a?z:v7d+'* gc} xnNt;(YfoAΌrj P+Y2.Zĝ{8YuJiA(.&.ra))] e={jXwUE%:@T CAf1ưp(-?W(og,cWa`X? =\'ў(yDqSri鴬PHlR/sEP@8cr092$=FeIMB3b8K{AS1YuXV{"~g/./),1J:H Nf!ʆm}j!6/"'rٛr*tnKn|<E|GKמD(xCW*{ޝ+l]A;i% UM 3rdu3eg}@ iZ\F/y)4HZ{+e6ET(з)AykS0JŎc[' `U#\[ bFOG!-$ #P ) P?<$j>qֱ3*P>/?-DL) Ut4gZ]oE._ #jN%fk\_gBZ^L 1qCHm6c%w{!(z!Zqe'@紐te91Hvcun=h->qmFrhWAU;: /Dif[a@wN?_Blpqy34]WvpóA6v:f!J>J**.Ox:TZ[<YB]'1kL| 3 XL}A9Dyiq}|v#R}]4r-1^6bE |AOۉKP3_%95 7HMEWqJ-Z?K(!}`EyByvw 5LS: }v`q4KNBI̕[3CJk ~DzdiC(A'+>!K˻H~/ y?|(y'ߜ ap(jkLnU댖,r?:OK4WpZ;._'I &H@z+CX°i}=~pbb=mfp[y?/}1HFRiHL&c8:m7./e3zQ/ЄQce &%S*']#eMsi|$le_sfKJ2GYθI oXPdL_ [`.z-( B/jLttM0=(*vsKa:0#0:E*-TN MrO{p^ cFQ~ Qf*?ax=~->]M*Pe.hfE'rpw%~chB aT^Q$$c`i"foS&oz#m K bjdFYNS%+dXK C( rGD<_DCPITr\ILb1edU+I -}:QԺLX$x(]8)F5ݐɌa\HKpK9\PϚisG\JfQ?j [T_sQvT~ iUU`(|F L ΔbFa1V$e 072'{bD_ø^5EUw4/gRyY8)[#u +3;1A.NR6OlT)xR>"U9R,_l-f1u,C-Q|i5B#>t y,g'zrl^Z<+EGo &I 6̇wEV`*܉0f[Y ?RKi0h]2?sxT+*{DnCфI4+~{ 3t*!u }z/t!i&aQ 7@V ݄n  % bqN,Qp,LzoWlF6{> xRC=r *NR,N KP?>] CIK^ ?@;^#KIMmû=k~:^S=1JfΚ Fy<#/Wa,T~'V>4KFe!5q(>] \ yxi`@BxOGXu8 ;AS"j$v {xvkWw%hK}'2@x/RWOAlŵ`" < :5tH<?]Z nm!B+!+q`@+cc gPV Uy~ߐk - @kIgbc@K:EWKŤmiNI:77n78Ӈۛ /1XOҍܰWVRwK J&1amd9] {F:2iB.Y*XaC)KMSR(/b+bMTqBT_nH 98s ;vNaN=K!' we7jpX^7@LXVKNp9u݋ș^.*ZK(LAAmnVڝDidP; N99}=s:Iw {igb%/ͨD\%5F8(r\r֒^ 4VL;{g4!;(Djs#+x?5*|5<b/ ڎ<+3ē$bZoV,zͅ^,QJ-mQW\{ol}lUHazCGҴ\U"cr'*1:΀*V/wV5}aԦ`KSB(v AzP vL(s(&%1Ev}>7j)-mm>=a_bjXu1#r-Vge*eW|W]%' S_!$hv@.}<[@M]C9Ms NkPDjlD"H+dfMR["Py.^TVl1!IKf̀3v BLeeu 8$gRlY}r>Vp1 3s"yGuESP)-H#s/]o*1'c);./V//kA:rA %h-Ao}tQ*Nc%25XKdښUe@S$د[ZlA3{[YՁF ?pmic^w4=zfH^zl!جjTHm{lpb&W+K@6P&@\&';`GrVaaDw52ortK,|Sw-68-kb7  6xjABY3)Q~B4gNQr@-yFcBT+`1Ԙ@ Z7qsT @c\%$b;.b/si2<WNh9(lquiK^Yc\EtB@R͸kP[[ I0+N4q\LSv*~[g5Om[(Y{]0zkrVv5$rމ/ 5bq)7ٳg֖+IpS[m}#.;azHИҫ#lQ\6Kg`H>|/kJP& aaL^ aYV<~$myE$ B\ +7 x ((5O[; ކ'r[W~KJ~3zrԡ'mۄSIDMzcYwJxXJ0' mc-%4QTx"6؊ >:koɽ32=ђgtl]gmq= oH^2jE;Z:26FOz.Jߌ5珝lnI/l#GhV ܔM aE3 kQH_q:6}SӜ5-ԌdE#ly\W&( c}3.X`sFOjP_ނg=Enr0/.X!0`5}0I|=]+]b NALfV,P~Ys}qM2٧U2u"OOGe8Ho DEyOcK*2u5#Fׇ.աC<`B>M{pP̄ak97OHe^'Vl3X2a9-~g20Ըfcwr8dpp&i PBrj;z&MSѱIe]&(&>ܡ]07#߂-t%Oxt6Tж l9Fd0p# LnE8bHׄWY>.Ͷ:=l1ڷ%?r@,`A'UB2wԟk`L_xx=hJg 2_g^cڄtVfvwoρ[Dd9S^F>\$:E,眆/8-Jfw]}QA Y kskkHA~{r[%a!܁nJPM2؈:KEpITZ-H 6~3m[o5:1P T%guχV0&'\\2m8U*2.o؍B4΂z.8sRpy|( %r:Bl@2>+*_/&؉^R;?KhQ6=f+56P?^@cJvͩ~t#Ѕw|] { OBVHaSGctRuV7U&*X7aJos iU4_]@mAG ;t23αA[u ќ&j(nPp\Ty_:BDכ96̭2ϲ >30oy17VW\c߷񽀢+}Fxw2+VdGo5e='SwDF]oVI#F[_Yu9oA:LrQ!]]IE=m.?o )f?y L@MqϷ:-]3jbh`X_pd]7Q: A2!ӋAlZ?:spio~Ooi&oz jڼ*7 $ 7"1IFKtň3H='Ӯ$7ӄ/8QR87`fi&Bɘf:_PwZ@21RDe1} fDI=̕ʞJ$㑺]\e$}:O\?XVsdyBc'W,j]eBFm EjZvxq6I{R:y:bM*҈#͒<);yR(Z [E,>0l?^$*~s4~=@_v_Qp쬫-f)8,Z(hvrsTmF9,kX`AEa07H$u"h+l4om}p7-+sLsztyO;褈=ld>0h*3=qYUaPbvr6 ~FE?-eՌӈjQ$x9n_V)6O=,<90L/]\Wf$gh-2-7L[P'p L6XidkX;C>ps,]io)IJg8{̵Q`|_O9dq"Q1ХajVaX-)J{kxL>V(KZ=c|i'%cnT&h/EY"%cgAY3bo$l1[j7~L=I8Tl\*r7ct@n]x9N!EgZ?A"{ӬDo2l'{sIm<#X/3vv mKwx6x :3?hNt좈5QEI 0M; yOj"KQ@5+ZgtlǰhRc^u+?%&z7&7/2Psj۝pohNEh0<c!ZwW>4C,'0_}U4€;wGTybopZIo%%%D[cIWWKcMK(~A EMv )<( fL# ݑ^Lsm>{6BFe$1=g_@R^c6ÅfB.Jo0&o1I K9#|Rp>oL8 /7 }> eyr%s//J#+etJm] *U{thad5?  #kUƊ 'H?Gknɓי ӐaQtk^Y@6' t9o~vZbg^NL>l!TW`qpr7j\)%yqz /X%93Z@X0IZ͞-( S[,b- RB # P*Њ-Jd}wA-ׅa*b}v+}Uq!4B9GEQ=E0c4oI3QcJ6EbHYA!qs\MUJ'd>FI15J:j{R$7D.7šPd1[ B(mXpXbkw m0 V%|kfK)n ĵ0|u59 b7y=^c2.kU0x[֥A/$3&0)qz1K9^v^^#CM& g{Xrлt+."a(QJY-s A plB}_|]pb%NXaʊK[#Z]҃ɾx/9"deo X0[] s'S%m5Rla(]%v*t+sL] =HGp,h>m)47s|m&^N@"7l~2K}-6EijR1bGQ2\ϜH~c'bܳGMV2l=+Uuu#J*~8JY~jaֳJ=0Mj0QNHafE=>c3lhlVma ~#P.',|a*(QS &_3s 7i:W@E?xfRE8W 򗙰DܨMS2dBc5l*Sk?RAr#T>qѫu{Q/;I#Aq-d~嵏c`0GKE>Mg09BKM DP! k,`&w19Y@bʒ0)d6Ӗ` {DK?\Mtu32)gk/,&/d' .GJ+3Ĉ ~%w7P aZ-\.bqXAȗ7z;Z ;}Ev$ WL6;'2 FH.B#A!\LOM5a77.t^uv4 "#:!pUB"af`9Dkk)= w]F,#]wk_{Ý#BJT+8=a%Bv0-0Q^SH ExP6.7T0M7WD #Ar%*' "T6i^kUD<#E7`6 Y7DJqw#Rb Ow:qzVC? bY $c%@s-[~Q1SZgK8/,Ojv~N̄'A]y-8ze(%oQՔjP9;x~JUtx ϙ.;a;|8D^Z6aX-ƤC}5_t$>p5jkL|v%AW_jC|PEP68 7ㄿ5Ɓ A1gcMW2 K+DoZ.t6VP,cZ@v]Orf8 0,uBwk0Qmb4|>IqrWj7bJ!/∦ao-Q @%]/!r]Q|mϷ)|{\LԊ[|4j1hZ'&[(PAVxH4h +jzH ?u`l= s|νk&J$B^81KoIckZKrmc^JDZ\eM2j`@f8ty'J | ru(}3̺[,7eI_{<^9K+skF('!_:&[A ;xM'7?2N.@Dc0F7smUp_ a# ,"OHj:fv " Rq%| s<0u1?R/[ .G:HB$#cŀׇ@l^{Ztٙ L^Mzn$$Cs@D4jrί F6n_fflAojt| aE^IcLDbo |w_Ht_y,I3ԍ@7x`>3Ks6oۀٰѿnN2۹Vz/zO!ǧe㮨ioGyauEOm抉|Ĺ*5=C4 2q\Ɖr^jl%1=t Wq#2'[o]hWP:HOLXe@ Hmo=#=md4(}h]\@!0N oRPȨW(2"C-)uOTm/z"J$XNW&?ǻ wEscOViOQ&}jwVR RTNQf&W-BFd[?^u=eQRAl3*1aBo_=f+gQ{8uJ㝸#?zf(f5 ӑX!9ojn%Lb.. 0mCc{˺$߬sr{'/Z͞S>Y"व:Xt8gG~# %t=$H !WOp8A?0vjc!t-7>Q_k\gBBsltxpx7bT׫& at1F"P ̌rKeB0L/q{~Bft۶=Nz )SI+E|maP'j`ct _kzkeU9&tc&iae+?aA/x&xMblLV bBʊ \Q4w(EkfQ L+(}߹&vVUȣm{?xo=VV|O& f~HNߡLiF1 #^CB XUMDPoKNA  s Jv3O!ȨI1Ɏ9E?6bs hm[rDu-g*feBQW"sp{! #{ jZ3O^+dg$Lmy/wM3`g`&E7E4Vt5~j|JN{@sf \HYv(]M٘L͹ %ixG`'Ľ 9ho ~TP$¤pֺRG }!ϖP,CK -:)RN|>JE cZO}N:$}x%s oΞs]@ TZ21`N~KE"WJ 5t$\ 4o*K8{:a+#_\YI2/D)XkR] KEӢf q=̔8~YSiLb& x`_ AExYU7i]"PQ&l_h(3>Y5Ά.,S\,pNzh,8UЏFazkOhaPE1< 0B1Y ߑ' B-C[F"|1KIF9մRj(Wxb(-C0<'ԑhk}@0+1KRAQ [=IIG[UBf vSHR}YZ|^xYγ%M)0;'.h~拶psrMd͉(Z=ơ^ӌZX`Q F|)/>.mE )2=f~a'& 9JȐ ),#kAkv DEГP I>P*L_,^]39[`^ʔA3C!8jykt.f/ęvEleVwVMmݚ╇tD5Z/ab7DHf#\oN w46R'V :j{jn>cnn_Ih$d_c ]6\ffF>-G6F;.^Bo>p[Vucؐ<$~҇1P١85]9elLLUYtT*ze7# ]pr+|bCVPXY?bƐ6_+9[P̉ f%;חwΰ:|Wc=%Bu\da4I}ItD1x'~o}/[5nDD^t襀KAA KS:&/^S,!t' lOe8ML{}3:hgpV"SvSsA{ed.QԒSW8#s6M-20t”l"DDe@sg6NR$~ṃ'i_D{4~6sMm5g;003I7_fMR/5܇׮#䘚>Nn m/q6<5ak*xELe>q$0.~u@l<-, (*\|f <ڸsT)Ybb%x r@DV 5gOt@ -e)?F)M#'iv":YUD[dkt]uGgp{=2Xes|STF84}~xY'܇R"3s2Csbm=">ҩ^S+<LJ"%O  R=K:j<~pWW2 J&JBSFJXd>zȥtjub!gQRb'8+9cQlZ>7=hƖy12oˆUZG ,p)Qv.*$=_ wlW泒6q= x$T5ڐf|q,} RYHnz~H&qn^aF2ɉd Xssn" W2J-aKUqJ;y\֥ą '4Q.m@!~*LtJ? w}|NL=-J_F}v?aGq)+y }6mG$~pm=A5񟮱m)F6GR4ssw=ݱ:m=*[VۮL2\2v(.?N\-[qb L9nX/(DD{T{t#s7Qt0%`wETCO#P'$p5~OlWJK¼r@eC1E.+7W[a>mE"jrw5n1wo'M(by&`0sp$A;~6Y6.n7Ol3[b v~4!HI(XeQGT,31%n@ak63&}U\M:fc뽸'Jt.zbMF0 m u'N L-. B>_"Tv'/mFzI?:&u O>~T3v0}B =Β>3;XC|Iw dPk"2 ("^`zcnΆ%np0 ۡU۟uK>%z"o*{Yp16Bm.U6oj0Nt =M u35Wzapaka{V&KQ92t#~QqAqiP|%#Ә%W;CU] {GY:R$#w'%$k ?7WRA<83C}sMXD+R&EOG~at g[]Նr=oS zj YG+`O~mJz^ k$ih4Mf\Jf8-KT֝ KbU0UWGK&c :6K<"bCW'b,6n~!oH/w4 K)Ʒd~G )r<HnyD{_BHƟ;[}?`R~Ⱦi:vSZb2B^XbWl Q lzUBWs,ȝ4/ cJr2E*9$&z|#V* 4ǖ%arWo"8u}' ߙ1[5xK(6rT0}A5[|J" i5ww+Qwe`̰7=LHv}(?$N`??U 2Ѽ~E0+R5~5?4&Y:I ~\0Sa:6kL|x[d;68`&n:۞s6l^v-={DJ<)O׳)-il/v)2n'1ٸ }߶IU#%m Uk;3"g/c38`(p7]6@n^{gzS1 8j>;ȄbUv>D z5rWe&ehؚ|cQC2iWv2ƊqD|7%Z4_]uGFbxayy}$aqq5ҝj`Ai^5#5>ep($nɏ=mioo-G @>P i,lմvlO `qܼ|qvp9el,G 7iZn#U?7C>}Ak;p(%Q@#2za Lyd4dz2Sr& 5g<Ʉ@jDIQރgqrr*PZZkP2\d3+peoi u/"r1d{S1jp0mQ'=@S&`:SnE >Mz~Yj33Z ;X[8yrõyqeqQހУ F+eHDah.":L9X|Ii6AoEG3-ba#] 5y=a$MָuilhL\7>a[L"$ :Wqm%sHWgP_mpn\YP̰ʏ=û+JNZ%]G  ~kEj^)~^(nr5Kt6?)e?'-?Y昼1%Hmܭ,wF*yJ4]H G8w@gG\6(J ?rbaG _ݦZSK#%e3u  ĕKn:48.vBiT!cwѪ}W%VɎ{N ߽d JL"QR=#0yb2L}e%ú5v(}lK'+!, `w rh0nVnsKirJ*o(++[_]@U]Y*mp]KWhI*ׯ0{/=9{E("szeˁpH|S!6T;(TylZ̔3:_Gb"iY"X'&j sM֍(#`Up0AUYnNprXG#_YF#KE9sMq$D{BR@Fm\mC=Tj%ZzG}c$[SQSHtưlC/si0caI3-u=6I)C7 EPQC[ze\Qj["#4y* D0ll36Y <~KT+mz&P {m=/ͧrBD9͐%z5Cͯ`6Ag@3TQ nn:DeL &|hR^8Wf"ACOd`@Rf2.zm/7zi2z:cJvu8~S gx ?G5WHġ(q luMFG\ /4*t7}eD">MXϗm/#.C6[MoJOW v5tk_x?otIZ(|'dzy`jqظ 65wzkgF|^ff(qTS#[Ǽ- N/foXxk =eV^+%8^5w_xEoAOdIY[gwzɇ]XpQf|w(2t`%rʧ%Ju5H*(&iEmNBa IB-MQOnbP\ blTH]?Etp fvsVxCҵc=Z"itTݲp{ghKֱ)gd/d$N ?1o1O$W-5w_qo*D>e31RI-\JԎ AoGo)!mKn Y rkF]S .{"l+?|FbHm\Fo~AIuҐQzPB-\<Qn硝f.Ls+;ۑ͜G+O>u$L& I$GyTu>/D[1B.Ax$\rW%ppWC5Ss'6Q;Qނg1sG40_z(CF4[sI8g@juaP}3_T}_v eM\iǽҢz8kXV&јwFĺQ>7*zddX glP49mvn'zz:ьY9qKv];z^y\ 1 ˣES`c{Mi!eryKD#uOX-_MKj HmenuCixRGN:x9_zJ&2ݥN&s-{̋x)B SndvPh?PŪI{ِWU /}%`臤u }ZM(ɚJ1P{Lb618bETX"mlcHHseJZ=ZPK1LDl: fP";&&"HZ q L!,WMQ'j!іP7{M_t?@&Q9ү7hl/~@4zZf1sYۨHqMJ7F)$jC1tKvhy;lﮣڍ%@"$_B^42=SILw d%6.c]iQ;b!%PC6vLeXԤ?n!1 !e%w:KN8|C _>yk5\v|M}Ux2>Oc/B1}DiTD{e1 q=`wS@@xq7>;N_dtصBqT_~/S!|7s ^<7I({D"^Q]2Q>ρ1='˯8Rct. F-:֌LXC{%%ZIM&s}2Ch/k̔ \BWSW Z7x0xvRD}*wm bNvv%7ǹQ?zAҏUo kʦ#!*n5X1,pWhLn"{ mmA^KxBRuZC9Äh; }l;6O)<WFGD?,7eylk1#Mc;a!R?sYIθT;Xm2+ @+̱(Av rQxQ" Pw jc03LzUK6{*{K^rSpI^h5 Hx>=ޡAG#Sl$g˚n_% VqU #ycA|HVkS@S:ԘCB_(.^b}bnf.AnIfK}Fs; !~D(@l&&;C9ۖa|^d\)4o%ݺ+qlI5,_6*!W$w?Y& 8j:iuR^edx,]8O]-<|u;q]D5[ZH={x%Tcs'HQm`rhѕʍNfpg76"4ZhԜN jw0{LJN&@ϕ2qt}IPU~s4@{'޺A`N4?b87/W) UjX@-2`oaQĥQ;q:.[12^bzr$Wx...!xJr@+GOn00/д23^w ;jk`~/ =g,coϸO1xl`p9= &fzCM~:.y ÍWx8,$]kkE݉r?oF2I=_%$^BԀXx Ϸ4Ch/5ؽQ6(x`\an"ܚ;*%\5}R,ͮiyΡ]>pPll-U.}ppP K3gNΆ74di 4[Ap_Tv9K9`wJ*c0<K؍2p8/Q4\wqk{ |4tieq/RK*v\#"B+Tca  Hlasr"H5DUaPKsx}lDe..:j)$#wt+Qf\pv>[o_&q\]vlA!.|UQk+١>%QSH C<]d,)P Fop.`YB#5,rX H\OW:FcI=ǠZᒖ6KCbUno鼷ZEyȏ^Қ㎓˰2f,N R3[0(d'kT0! oה7,hBzp"7ecw^jQN);v s#E1+Y`7X}3iRD:S?~Xxv@$$Ngix<ʆ=`5^WNokqoE1bfRj5Ǿ/YH-8PoQ=\kY=+B8 4W/4^axܺI~Iu#3rN<f =?{4 rQ] t'I ]xxLpoātT *UI_TSFKz p{_ekHU7TEWW0TO;D~ @D6N:K&h*rVJ0VjVHDe}? P֠.'<'aRvG/3Q:L^l;N& 6c{ig|% ;:qJrcAJyRB WMC D\p&uC5Xp+]zW?_"{RIT!"y@VQb[Zi=Hz5W'?U[osqom\v uRQ6IIWyoN';*0"4CaULBwfvWv;<,Bmii5If}vgy%;-c@O;ᙄ':5l7AX:YET1G2C< *$=lS,kygV;c>irAExKC?ÿzRkr,y`Y 0< zHc?:[_;~ʙq\d +2.(8y2g'e/_k6.H :{:n+ YB N.O/N0z>ǔO/P j0)t?7j Kg|cv}W'>"r-qt i @]~z*W-4EcL]SYW5zhk^YU-]xX4oBrmaY0r=59_a#y Q[e>tV{.-7_64^!LiUkj59E v;b-Fu)MiW8%Ar-}.Fޑd^ V'7WSu9 O]P1A8ds<-oCiԺ66@dF/i(;K9$Bwjw5 ]0DV +*a3!g#U@gVT6ڋ>^b|Q!RT9zJ,`che /'[0& %D$@ m6%d3׼ G˽Ԏ)?#;B3ug$Z91 ya$'JwEs(r\\/^@$NO5v.H]6H7*Q=tMK[!S,JsHhlԓ+KN3u8v @`8p0>DDKRfO1Z7k]_{.V" :%ӍjߚR'8 Gyy?c|]Fe?2( _f&.(w,Z)/TIiPUXoNb.cui96y7Mj[T 6gBT(SޘA?;Avr˴U8t.m{Yn/˺TkܑRw W*@9>o9S4A%RV] *o.:G=P=O$vI>rA 6KRk_!~>9aɦ[K>J#G,EP*B eFh"$\Ix>;ej.U s~zcY.|djW 4A+#i h;ZTv,xpdw |B{ Qpi0oU?(K b:R>"y]H8_[s#ME0(v*SW0gik%jA̜O42/AdZ&q CkGp#a9KAr 9 t{h{MjbKnI~WT%WN K#,+$wXKc:D3ڹ}ZsK;P]?Kn+5wtQ]<DFV"j!cbי4Tx`S 5=CdG QE5W="݊ob|>FC.r_)vR_8(fgx5 cQ1+@\=uJ<ٵYΤUc Hظns4nHANq}Rke}<zlu6A0-'/?.(!jR#(&;X1, * Y_8/I_aRz@_ sc& 'xq]3.R`B-Kr/]qv`wi|W@NH0, q c u\5gfk[AD6<'Iti3h?>S!08w6L%`s[#clrr)] spx,3߽Ǟ=%8I6%b.Pia)#Spvo:9Kwrzby|:"X[{QFϘ V  p.2JB%;+rDXDw`>1=/p =(K_kHvk9KR~:X^k\' )/`:["Aa/`a2J774R'U'T^(b|Z|LXKl}!82IPf"I J?"JW 8ts,$i]exE]=a\mnkJL)U53rVE6P .zu`lsb,S02D3\{ȩ %8YNQ m;":GO۪*_}}M)_,$?\zk'{2p fyl%n}JwUW?9KeTt5RZmJBJVg+nR>"K^J3f NE*}o(E-I7Al''ώФYq67gϲI`Wq)? Ҍl6GhbTdoAS[ ,?~d M UC,eKy4lub95`Qk+ a*p{la1 ~fw\`Fl5+_RH~< w(#/Ze0Dd"xo` )f2Hn2!JAWg6oFhjJ{%l-YM}GGb%R$x%h'"e,bcPlH`i*vH)U .Ҳp*OoQ)FED\ݫ"ZDIt@M A > ]xC" _MR1#dڮkT=1YhT:GYM\8t),> "yM=oL!+a;>>ϲ@,oEY#j#_J*; )QXZNdU,Zz ގ> X}T:%9, OiR7PsR%'H6!UJOP0klm9"GP5d,32-'Jceȋ3GRv!xLNqBHPEC mm5<7{Ciؠ IuĆV`67!uH=GDd &[T$ʊƁ睘`o"]'hCjh~j1P"3~ͨ1ZYq?K,hTzN?WX6[ˮӓnbͱ@3BB6=T!_E0 qB@0_35Wyar\"WQQ\}ԛyk8M3&Nf}f]A+8}iv|A K\t|6|L8u_<ټ?!_[-,yzGK{/m,ؑWv'drFG (R^92{mu#|N(mm3Lt{GQ_,G9nw<>\Ri+ Eʫm!.?E} s2ᒍM/w9WU2rA?a\?ge5Q/g:+\O&/bE li *HrK!" {wnyTB7[6QD)r:,M(G+Ni*=Gر1Zfq؋ 3st? i9{2$F2<pÿuZ61G:,YlX-ŁMTHɮ9C(WBb_/jvSC4E w YŪ1;cʬ0+:M;j}NWրzz>64♡D&ܽ-pFqf}_jk\uuڧ;#G:nC\^ Fr05>2?@ΫF`ewHHnrCm[H xZiVejSP{7H Q׭!;8X M("can75הK t`08p}T_]htFw MH% `^0PK%nV*mE<|V4"s%J*c#@f$`1kbQ^, v~*[O-N'a/&.q^t^k1aY3ԗ,]?]$Ɏ:G9Ji23@LG8L<~Ւ>ҵ%ǨШk|G63+34f}Ud e}yKcCizsZ#JyU]ڲ6^g&3yഇ WvL&>MAU#>P+_].yEEmQM Iub|1WjgмgNni!-?LZPdI,16FmLEXMo S r"2ZVY A<X:LOVYZH ϯ *2K"|UztMMK`p6jv4_k{Ek;T\?Ӓ}`n"P<_; hSETzmY0mr* \.isTO<@' =bdwS?sH6em,&@$GG1*K Y]hs# N=#r RƴRq[=W-mAU 9Fm]xv7UgbgΌ>5H7%@VE=,0u]*שEJee [Y~^ AZ[vg2UBs QWYR6ZV U54L3;InY9)x[+LllJ}[GlPBJxFcXT%z"c.f[khX /-ҝQt7!v R5c1'|zg"k_B~c{6$32Nzt(\0v4/R% DQ-IK"VOǬ)c?-v+nkLR8E_KKP:\<6!-a;2DK [SJcdvyT^] 69&]SC{gEZGXX`l-NRTdRRUVXB@Fq*Yc /Ad}MDhnAeegyo_G7IX&NEXTCHAR`exhmL;{sam6,kTinEMp`lx $z KMUaPTT[zI!ZSAatY]NB ( DUP I # {@ DUP 0D AQI MRCS _J `~ REDBUILD.BAK [SAOSTOIC.STOIC]IMAGE.;17MAP;1RE&% Image file creation facility% Jonathan Mark 1982A% This version has been modified to work under both Version 2 and% Version 3 (I hope) of VMS.% FilesIORB<*'HEAD0_FRAB FRAB % prototype image header$'IMAGE_FRAB FRAB % the output image70 'BLOCK_ADDR VARIABLE % variable to hold block number3'FRANDOGET : % like RANDOGET but uses current FRAB; -ROT BLOCK_ADDR ! % put block number in the block buffer< BLOCK_ADDR RAB.L_KBF ! % put block number address in FRAB0 FGET UNDER % do the GET; drop not-end-of-file ;3'FRANDOPUT : % like RANDOPUT but uses current FRAB; -ROT BLOCK_ADDR ! % put block number in the block buffer< BLOCK_ADDR RAB.L_KBF ! % put block number address in FRAB FPUT % do the PUT ; 'INIT_FRABS :9 HEAD0_FRAB CUR_FRAB ! RESET_FRAB % first do input frab# 4 RAB.B_KSZ B! % key buffer size? RAB.B_RAC DUP B@ RAB.C_KEY OR B<- % set up key record access< IMAGE_FRAB CUR_FRAB ! RESET_FRAB % then reset output frab ; % Constant(s)H10 '#WRITES CONSTANT % number of resident sections allowed in the image % Variables>.D @ IF 1 .D+! THEN % make the block start on a word boundary(80 'HEAD ARRAY % 80 longwords = 1 block80 'BLOCKBUF ARRAY10 'ISD VARIABLE % pointer to section descriptors<0 'PROTO_ISD VARIABLE % prototype to supply flags, pointers70 'FILE_POS VARIABLE % keeps track of the block number80 'WRT_FLAG VARIABLE % false means set read-only access>0 'WRITE_COUNT VARIABLE % count of scheduled write operationsE0 'FIND_COUNT VARIABLE % count of successfully found program regionsN#WRITES 4 * 'SCHED_SOURCES ARRAY % positive->from memory; negative->from file<#WRITES 2 * 'SCHED_COUNTS ARRAY % contains the block counts% Characteristic access words)'ISD.SIZE : ISD @ ; % first word is size5'ISD.PAGCNT : ISD @ 2+ ; % second word is page countM'ISD.VPN : ISD @ 4+ ; % second longword (low 3 bytes) is virtual page number*'ISD.FLAGS : ISD @ 8 + ; % third is flags9'ISD.VBN : ISD @ 0C + ; % fourth is virtual block number9% Low-level words to change image section characteristics&'SET_NOWRT : % ISD address, SET_NOWRTE 8 + DUP @ 08 NOT AND 02 NOT AND <- % clear isd$m_wrt and isd$m_crf ;&'SET_NOCRF : % ISD address, SET_NOCRF, 8 + DUP @ 02 NOT AND <- % clear isd$m_crf ;C% IMAGE word to create a new image section (copying the header from@% a prototype in RKERNEL.EXE) containing all STOIC code and data% presently compiledF% NOTE: the prototype RKERNEL.EXE must be linked without the debugger,G% but the STOIC version running IMAGE can be linked with or without it.3'FIX_DZRO : % amount to reduce region by, FIX_DZRO/ 10 ISD +! % advance to the uninitialized ISDI WRT_FLAG @ NOT IF ISD @ SET_NOWRT THEN % if read-only, go set the flag- DUP ISD @ 4+ +! % add region count to BVPN ISD @ 2+ W@ SWAP - ISD @ 2+ W! ; 'FIX_COUNT :1 DUP ISD @ 2+ W@ - SWAP % find the amount added2 DUP ISD @ 2+ W! % save the new count in the ISD ;9'UPDATE_POINTERS : % sets up protected region boundaries9 .D @ USER_DATA @ - USER_DATA @ W! % set up data length1 DICT_PNTR @ 1FF + 1FF NOT AND USER_DICTIONARY !+ CODE_PNTR @ 1FF + 1FF NOT AND USER_CODE ! ;D'SCHEDULE_WRITE : % start address, length in blocks, SCHEDULE_WRITE&% "Write scheduled: " MSG DDUP = = CRL OVER HEAD NE_IF FILE_POS @ ISD.VBN ! THEN % if not the header, set up ISD9 DUP FILE_POS +! % calculate where the next one will be7 WRITE_COUNT @ 2* SCHED_COUNTS + W! % save the length? WRITE_COUNT @ 4 * SCHED_SOURCES + ! % save the start address( WRITE_COUNT 1+! % increment the count ;E'SCHEDULE_COPY : % old block number, length in blocks, SCHEDULE_COPY%% "Copy scheduled: " MSG DDUP = = CR; FILE_POS @ ISD.VBN ! % tell it where it's going to start9 DUP FILE_POS +! % calculate where the next one will be7 WRITE_COUNT @ 2* SCHED_COUNTS + W! % save the length9 MINUS % negate the block number to indicate what it is0 WRITE_COUNT @ 4 * SCHED_SOURCES + ! % save it, WRITE_COUNT 1+! % and increment the count ;E% This next word looks at an ISD in the prototype header and comparesD% it with the region address and length that it is given. Note thatD% the data region is a special case. The other two regions have notG% been moved in memory, so that the values to be written into the imageE% are at the address given in the ISD. The data ISD, however, startsD% at the data prototype address--but the region to be loaded into it=% is the actual, writable data region, not the prototype. -JMA'CHECK_ISD : % start address, section length in bytes, CHECK_ISD4 1- 200 / 1+ % get start address, length in blocks! OVER 200 / ISD.VPN @ FFFFFF AND EQ_IF % is this the one?M OVER DATA_0 @ EQ_IF UNDER USER_DATA @ SWAP THEN % data is a special case= ISD @ SET_NOWRT % it's one of ours, so make it read-only? DDUP SCHEDULE_WRITE % it's going to be written from memoryL FIX_COUNT DROP FIX_DZRO DROP % update this section and the one after it FIND_COUNT 1+!! -1 % signal that we found it ELSE: 2DROP 0 % drop data and signal failure if it's not it THEN ;9'DO_RESIDENT : % schedule a write for a resident sectionB DATA_0 @ .D @ USER_DATA @ - CHECK_ISD % is it the data section? NOT IFJ DICT_0 @ DICT_PNTR @ OVER - CHECK_ISD % is it the dictionary section? NOT IFF CODE_0 @ CODE_PNTR @ OVER - CHECK_ISD % is it the code section? NOT IFJ ISD.VBN @ ISD.PAGCNT W@ SCHEDULE_COPY % if none of these, copy it THEN THEN THEN ;G'SCHEDULE_WRITES : % look at all the ISDs; see which ones are resident2 0 WRITE_COUNT ! 1 FILE_POS ! % no writes so farL HEAD 1 SCHEDULE_WRITE % we're going to have to write out the image headerI HEAD DUP W@ + ISD ! % ISD points to the first Image Section Descriptor BEGIN % loop through all ISDs5 ISD.SIZE W@ 10 EQ_IF % is it a resident section?, DO_RESIDENT % if it is, go process it THEN1 ISD.SIZE W@ ISD +! % move on to the next one8 ISD.SIZE W@ EQZ % end the loop if there are no more END ;3'WRITE_BLOCK : % address, block count, WRITE_BLOCK4 IMAGE_FRAB CUR_FRAB ! % set up which block to use1 200 * FWRITE SYSERR % out it goes, all at once ;?'COPY_BLOCK : % starting block number, block count, COPY_BLOCK, ( % we've got to do the blocks one by one5 HEAD0_FRAB CUR_FRAB ! % first look at input file9 DUP I + BLOCKBUF 200 FRANDOGET SYSERR DROP % read it5 IMAGE_FRAB CUR_FRAB ! % then look at output file, BLOCKBUF 200 FWRITE SYSERR % write it. ) DROP % end and drop starting block number ;<'WRITE_IMAGE : % actually performs all the scheduled writes WRITE_COUNT @ (E I 4 * SCHED_SOURCES + @ % get the source address of block numberL GEZ_IF % what is it? (if negative, its absolute val. is a block number)M UNDROP I 2 * SCHED_COUNTS + W@ WRITE_BLOCK % it's an address; write it ELSEE UNDROP MINUS I 2 * SCHED_COUNTS + W@ COPY_BLOCK % else copy it THEN )2 FIND_COUNT @ 3 NE_IF "Error: " MSG FIND_COUNT ? 9 " image sections found; there should have been 3" MSG THEN ;5'.IMAGE : % file name, access flag (-1 or 0), .IMAGE# WRT_FLAG ! % save the flag value1 FIND_COUNT 0<- % reset the image section countH UPDATE_POINTERS % indicate how much code the new image should protect& INIT_FRABS % set up the FRAB blocks8 HEAD0_FRAB CUR_FRAB ! % set up to open prototype fileR "SAO$KERNEL:HEAD0.EXE" COUNT FAB.M_GET FOPEN SYSERR % open prototype image file> 1 HEAD 200 FRANDOGET SYSERR DROP % read in the image header( SCHEDULE_WRITES % go through the ISDs&% DUP "output file name: " MSG MSG CR, IMAGE_FRAB CUR_FRAB ! % set up for outputL COUNT FAB.M_PUT FAB.M_BIO OR FCREATE SYSERR % open the file to be written* DATE D@ % save the current image's date2 SET_REVISION % set a new date for the new image- WRITE_IMAGE % write out the new image file8 DATE D! % and restore the status of the current image IMAGE_FRAB CUR_FRAB !! FCLOSE % close the output filet HEAD0_FRAB CUR_FRAB ! * FCLOSE % close the prototype image file ;?'IMAGE : 0 .IMAGE ; % for normal image, cause read-only access :'IMAGE_WRT : -1 .IMAGE ; % also allow for writable images6% Word to disable copy-on-referenceness in image files'NOCREF : % file name, NOCREF HEAD0_FRAB CUR_FRAB !mE COUNT FAB.M_GET FAB.M_PUT OR FOPEN SYSERR % open for random accessa4 1 HEAD 200 FRANDOGET SYSERR DROP % get the header( HEAD DUP W@ + % get first ISD address BEGINu DUP W@ NEZ IFK DUP W@ 10 EQ_IF DUP SET_NOCRF THEN % if resident, make not copy-on-refB' DUP W@ + % advance to the next oneR REPEAT DROPo: 1 HEAD 200 FRANDOPUT SYSERR % write the header back out FCLOSE % close the file ;0% Words to display image section characteristics8'DISPLAY_ISD : % address, DISPLAY_ISD, next ISD address DUP <#> TYPE ": " MSGB "SIZE=" MSG DUP W@ <#> TYPE$ "; PAGCNT=" MSG DUP 2+ W@ <#> TYPE "; VPN=" MSG DUP 4+ @ <#> TYPE0 "; FLAGS=" MSG DUP 8 + @ 00FFFFFF AND <#> TYPE7 DUP W@ 10 EQ_IF "; VBN=" MSG DUP 0C + @ <#> TYPE THEN0 DUP W@ + % advancew ;=4'SHOW : % shows all ISD's in block starting at HEAD" HEAD DUP W@ + % initial pointer BEGINL DUP W@ NEZ IF DISPLAY_ISD CR REPEAT DROPI ; > % close IORBe;F*[SAOSTOIC.STOIC]OBUF.;7+,./A 4O - 0123K564&7@$5&89GAHJC% ***************************************************************** % * *;% * This module is a part of the SAO VAX/VMS STOIC SYSTEM * % * *% * It was created by *% * Roger Hauck *!% * Smithsonian Institution *"% * Astrophysical Observatory *(% * Cambridge, Massachusetts 02138 *&% * (617)495-7151 (FTS 830-7151) * % * *&% * This module may be reproduced *.% * provided that this header is retained. * % * *C% ***************************************************************** % Buffer output to screen0 'O.FLAG VARIABLEDECIMALL% The following constant sets the buffer length for output to the terminal.O% It must be set to a value at least 52 less than the SYSGEN parameter MAXBUF.J% The default for O.BUFSIZE is 1000 and DEC's default for MAXBUF is 1056. 1000 'O.BUFSIZE CONSTANTHEX0 'O.BUFCUR VARIABLE.D@ 'O.BUFSTRT CONSTANTO.BUFSIZE .D+!.D@ 'O.BUFEND CONSTANT'FLUSH :7 O.BUFSTRT O.BUFCUR @ OVER - NEZ_IF % anything there? UNDROP TYPE % output buffer- O.BUFSTRT O.BUFCUR ! ELSE % reset buffer DROP THEN % no action ; 'BUFFER_ON : -1 O.FLAG ! O.BUFSTRT O.BUFCUR ! ; 'BUFFER_OFF : FLUSH O.FLAG 0<- ;'TYO :( O.FLAG @ IF % is buffering turned on?: O.BUFCUR @ O.BUFEND OVER - LEZ_IF % yes, out of room?- DROP FLUSH O.BUFSTRT THEN % yes, flush3 DUP 1+ O.BUFCUR ! B! ELSE % put byte in buffer3 TYO THEN % buffering turned off, do normal tyo ;'CR : D TYO A TYO ;'SPACE : 20 TYO ;('SPACES : GTZ_IF UNDROP ( SPACE ) THEN ;'OLD_TYPE : TYPE ;'TYPE :! O.FLAG @ IF % is buffering on? GTZ_IF % anything there?* UNDROP ( % yes, loop through string. DUP B@ TYO 1+ ) THEN % type next byte DROP ELSE. TYPE THEN % buffering off, do normal TYPE ;'MSG : COUNT TYPE ;'TYI : O.BUFCUR @ O.BUFSTRT - GEZ O.FLAG @ AND IF % is there a buffer?/ O.BUFSTRT O.BUFCUR @ OVER - TYPE_TYI % yes) O.BUFCUR O.BUFSTRT <- % reset buffer ELSE TYI THEN ;G% TYPE_GETLINE is a special case for buffer handling, since it uses twoH% buffers: the prompt buffer and the input buffer. The sum of the sizesE% of the two, plus 16, must be less than the SYSGEN parameter MAXBUF. 'GETLINE : O.BUFCUR @ O.BUFSTRT - GEZ> O.FLAG @ AND % get code for whether there's a buffer or not1 O.FLAG @ IF % if buffering, check sum of sizes& OVER % get length of input buffer9 O.BUFCUR @ O.BUFSTRT - % get length of prompt buffer@ + 16 + O.BUFSIZE LE_IF % is the sum of the buffers too big?L FLUSH DROP 0 % if so, flush the output buffer and indicate it's empty THEN THEN IF. O.BUFSTRT +ROT O.BUFCUR @ O.BUFSTRT - +ROT TYPE_GETLINE % yes) O.BUFCUR O.BUFSTRT <- % reset buffer ELSE? O.BUFSTRT +ROT 0 +ROT % stuff the prompt address and count3 TYPE_GETLINE % output null string if no buffer THEN ;;F*[SAOSTOIC.STOIC]RDEF.;13+,.S/A 4OSS\- 0123K56bŅ(7(89GAHJFC% ***************************************************************** % * *;% * This module is a part of the SAO VAX/VMS STOIC SYSTEM * % * *% * It was created by *% * Roger Hauck *!% * Smithsonian Institution *"% * Astrophysical Observatory *(% * Cambridge, Massachusetts 02138 *&% * (617)495-7151 (FTS 830-7151) * % * *,% * Modified by Jonathan Mark, 1981-1982 * % * *&% * This module may be reproduced *.% * provided that this header is retained. * % * *C% ***************************************************************** 0% Definition for STOIC for the DEC VAX computer% Roger Hauck(% Smithsonian Astrophysical Observatory% Cambridge, Mass. 02138% January, 1979 ASSEMBLER< DEFINITIONS% assembler addressing modes 40 '[R0] AC'50 'R0 AC 51 'R1 AC 52 'R2 AC 53 'R3 AC54 'R4 AC 55 'R5 AC 56 'R6 AC57 'FS AC 58 'R8 AC'59 'L AC 5A 'P AC 5E 'SP AC 6E '(SP) AC/60 '(R0) AC 61 '(R1) AC 62 '(R2) AC 63 '(R3) AC 65 '(R5) AC!67 '(FS) AC 69 '(L) AC 6A '(P) AC170 '-(R0) AC 77 '-(FS) AC 79 '-(L) AC 7A '-(P) AC 7E '-(SP) AC380 '(R0)+ AC 81 '(R1)+ AC 82 '(R2)+ AC 83 '(R3)+ AC285 '(R5)+ AC 86 '(R6)+ AC 87 '(FS)+ AC 89 '(L)+ AC%8A '(P)+ AC 8E '(SP)+ AC 8F '(PC)+ AC9A '@(P)+ AC 9F '@# AC% assembler op codes '@BRB : 11 ; 05 'RSB AC/ 11 'BRB AC 12 'BNEQ AC 13 'BEQL AC 14 'BGTR AC. 15 'BLEQ AC 16 'JSB AC 17 'JMP AC 18 'BGEQ AC" 19 'BLSS AC 1C 'BVC AC 1D 'BVS AC4 28 'MOVC3 AC 29 'CMPC3 AC 2A 'SCANC AC 2B 'SPANC AC 32 'CVTWL AC( 39 'MATCHC AC 3A 'LOCC AC 3C 'MOVZWL AC4 60 'ADDD2 AC 62 'SUBD2 AC 64 'MULD2 AC 66 'DIVD2 AC 6A 'CVTDL AC 6E 'CVTLD AC1 70 'MOVD AC 71 'CMPD AC 72 'MNEGD AC 73 'TSTD AC 78 'ASHL AC 79 'ASHQ AC 7B 'EDIV AC 7D 'MOVQ AC' 80 'ADDB2 AC 88 'BISB2 AC 8A 'BICB2 AC2 90 'MOVB AC 91 'CMPB AC 94 'CLRB AC 9A 'MOVZBL AC 9B 'MOVZBW AC B4 'CLRW AC4 C0 'ADDL2 AC C1 'ADDL3 AC C2 'SUBL2 AC C3 'SUBL3 AC C4 'MULL2 AC C6 'DIVL2 AC4 C8 'BISL2 AC CA 'BICL2 AC CC 'XORL2 AC CE 'MNEGL AC1 D0 'MOVL AC D1 'CMPL AC D2 'MCOML AC D4 'CLRL AC% D5 'TSTL AC D6 'INCL AC DE 'MOVAL AC D7 'DECL AC E9 'BLBC AC F0 'INSV AC6 F2 'AOBLSS AC F4 'SOBGEQ AC F6 'CVTLB AC F7 'CVTLW AC F5 'SOBGTR AC?% Words which must be defined before the rest of the assembler> DEFINITIONS ASSEMBLER<5'B! : % value, address, B! (stores byte at address) MOVL (P)+ R0 CVTLB (P)+ (R0); 'IMMEDIATE :1% gives IMMEDIATE attribute to last compiled word 4 LOOKUP_ATTRIBUTE B!;'DROP : % value, DROP TSTL (P)+ ;''DUP : % value, DUP, value, same value MOVL (P) -(P) ; DEFINITIONS %% Assembler addressing mode modifiers 'B! : % value, byte address, B! MOVL (P)+ R0 CVTLB (P)+ (R0) ;E'B^(P) : % B^(P), literal byte (compiles byte-dsiplacement address)6 AA CPUSH % byte displacement w.r.t. P-stack pointer4 WORD DROP ILITERAL DROP CPUSH % displacement byte ; IMMEDIATEG'B^(FS) : % B^(FS), literal byte (compiles byte-dsiplacement address)6 A7 CPUSH % byte displacement w.r.t. F-stack pointer4 WORD DROP ILITERAL DROP CPUSH % displacement byte ; IMMEDIATEG'B^(SP) : % B^(SP), literal byte (compiles byte-displacement address)6 AE CPUSH % byte displacement w.r.t. R-stack pointer4 WORD DROP ILITERAL DROP CPUSH % displacement byte ; IMMEDIATE>'S^ : % S^ (short-literal operator, compiles next # on line).% WARNING: DOES NOT CHECK VALIDITY OF OPERAND* WORD DROP ILITERAL DROP CPUSH % literal ; IMMEDIATEC'B^ : % B^ (byte-displacement operator, compiles next # on line)F COMP_BUF_PNTR SUBL3 S^ 1 @(P)+ -(P) %address of last compiled byte< ADDB2 (PC)+ S^ 40 @(P)+ % transform it from (X) to B^(X)5 WORD DROP ILITERAL DROP CPUSH % displacement byte ; IMMEDIATEG'W^ : % W^ (word displacement operator, compiles next number on line)F COMP_BUF_PNTR SUBL3 S^ 1 @(P)+ -(P) % address of last compiled byte7 60 ADDL2 (P)+ @(P)+ % transform it from (X) to W^(X); WORD DROP ILITERAL DROP % get and convert next # on line% DUP CPUSH % compile low-order byte: INCL P MOVZBW (P)+ -(P) CPUSH % compile high-order byte ; IMMEDIATE> DEFINITIONS ASSEMBLER< % Stack Manipulation"% DROP & DUP are defined on page 1!'2DROP : % value1, value2, 2DROP ADDL2 S^ 8 P ;?'DDUP : % value1, value2, DDUP, value2, value1, value2, value1 MOVQ (P) -(P) ;&% value1, value2, SWAP, value1, value24'SWAP : MOVQ (P)+ R0 MOVL R0 -(P) MOVL R1 -(P) ;&'(SWAP) : % immediate version of SWAP* MOVQ (P)+ R0 MOVL R0 -(P) MOVL R1 -(P) ; IMMEDIATE.% value1, value2, OVER, value1, value2, vlaue1'OVER : MOVL B^(P) 4 -(P) ;?% value1, value2, value3, 2OVER, value1, value2, value3, value1'2OVER : MOVL B^(P) 8 -(P) ;3'+ROT : % arg1, arg2, arg3, +ROT, arg2, arg1, arg3. MOVL (P) R0 % r0 is temporary stack pointer) MOVQ B^(P) 4 (P) % move up arg1 & arg2) MOVL R0 B^(P) 8 % put arg3 underneath ;3'-ROT : % arg1, arg2, arg3, -ROT, arg1, arg3, arg2# MOVL B^(P) 8 R0 % set arg1 aside+ MOVQ (P) B^(P) 4 % move arg2 & arg3 down MOVL R0 (P) % put arg1 on top ;B'(DROP) : % count, (DROP) (count items are dropped from P-stack) MOVL (P)+ R0 % drop count% MOVAL [R0] (P) P % drop (r0) items ;C'UNDER : % value1, value2, UNDER, value2 (drops next to top value) SWAP DROP ;?'FLIP : % value1, value2, value3, FLIP, value1, value2, value32 MOVL (P) R0 MOVL (P) B^ 8 (P) MOVL R0 (P) B^ 8 ;*'UNDROP : % UNDROP, previous top of stack7% (may be used after EQ_IF, EQZ_IF, or associated ELSE) SUBL2 S^ 4 P ;J'2UNDROP : % 2UNDROP, value1, value2 (returns two prev. values to stack) SUBL2 S^ 8 P ; '% Unary Arithmetic & Logical Operators'MINUS : MNEGL (P) (P) ;'1+ : INCL (P) ;'2+ : ADDL2 S^ 2 (P) ;'4+ : ADDL2 S^ 4 (P) ;'1- : DECL (P) ;'2- : SUBL2 S^ 2 (P) ;'4- : SUBL2 S^ 4 (P) ;'NOT : MCOML (P) (P) ;,'W->L : CVTWL (P) (P) ; % signed conversion (% Binary Arithmetic & Logical Operators'AND : % logical AND MCOML (P) (P) BICL2 (P)+ (P) ;8'OR : % value1, value2, OR, truth value (inclusive OR) BISL2 (P)+ (P) ;'XOR : % exclusive OR XORL2 (P)+ (P) ;9'MOD : % value, modulus, MOD, remainder of value/modulus+ MOVQ (P)+ R0 CLRL R2 EDIV R0 R1 R1 -(P) ; % miscellaneous7%----RADIX: RADIX, address of current conversion radix'RADIX : U_RAD ;%----+: addend, addend, +, sum'+ : ADDL2 (P)+ (P) ;&%----1+: value, 1+, incremented value'1+ : INCL (P) ;+%-----: subtrahend, minuend, -, difference'- : SUBL2 (P)+ (P) ;"%----1-: value, 1-, value minus 1'1- : DECL (P) ;,'* : % multiplier, multiplicand, *, product MULL2 (P)+ (P) ;'2* : % value, 2*, twice value ADDL2 (P) (P) ;&'/ : % divisor, dividend, /, quotient DIVL2 (P)+ (P) ;1'/MOD : % divisor, dividend, quotient, remainder) MOVQ (P)+ R0 CLRL R2 EDIV R0 R1 R1 R0 MOVQ R0 -(P) ;'R8@+ : ADDL2 R8 (P) ;%----ABS: value% not yet supported (% Fetching, storing at memory locations'@ : % address, @, contents MOVL @(P)+ -(P) ;'@@ : MOVL @(P)+ R0 MOVL (R0) -(P) ;'%----B@: address, B@, contents of byte'B@ : MOVZBL @(P)+ -(P) ;&'W@ : % address, W@, contents of word MOVZWL @(P)+ -(P) ;0%----?: address, ? (types contents at address) '? : @ = ;5%----!: value, address, ! (stores value at address)$'! : MOVL (P)+ R0 MOVL (P)+ (R0) ;7%----<-: address, value, <- (stores value at address)'<- : MOVL (P)+ @(P)+ ;5'B<- : % address, byte, B<- (store byte at address) CVTLB (P)+ @(P)+ ;6'W<- : % address, word, W<- (stores word at address) CVTLW (P)+ @(P)+ ;O'EXCHANGE : % addr. 1, addr. 2, EXCHANGE (exchanges contents of two addresses)# MOVQ (P)+ R0 % pick up addresses" MOVL (R0) R2 % save first value& MOVL (R1) (R0) % transfer 2nd value$ MOVL R2 (R1) % store second value ;$'MOVE : % origin, destination, MOVE" MOVL (P)+ R0 % r0-> destination MOVL @(P)+ (R0) % do it ;h% Double-precision'D@ :V MOVQ @(P)+ -(P)  ; 'D! :* MOVL (P)+ R0 MOVQ (P)+ (R0) ;o'D<- : MOVQ (P)+ @(P)+n ;nE'W! : % value, address, W! (stores low 16 bits of value at address)a MOVL (P)+ R0 CVTLW (P)+ (R0)5 ;  T% Modify memory6%----1+!: address, 1+! (increments value at address)'1+! : INCL @(P)+ ;h8%----1+<-: address, 1+<- (increments value at address)'1+<- : INCL @(P)+ ;@'+! : % value, address, +! (adds value to contents of address)& MOVL (P)+ R0 % r0-> memory location ADDL2 (P)+ (R0) % do it ;:% address, value, +<- (adds value to contents of address)'+<- : ADDL2 (P)+ @(P)+ ;J6%----1-!: address, 1-! (decrements value at address)'1-! : DECL @(P)+ ;8%----1-<-: address, 1-<- (decrements value at address)'1-<- : DECL @(P)+ ;G'-! : % value, address, -! (subtracts value from contents of address)' MOVL (P)+ R0 SUBL2 (P)+ (R0)' ;AG'-<- : % address, value, -<- (subtracts value from contents of address)) SUBL2 (P)+ @(P)+ ;A% B! is defined on page 1C-'0<- : % address, 0<- (stores 0 at address)) CLRL @(P)+ ;74'0W<- : % address, 0W<- (stores 0 word at address) CLRW @(P)+ ;C0'-1<- : % address, -1<- (stores -1 at address) MNEGL S^ 1 @(P)+ ;A-'1<- : % address, 1<- (stores 1 at address)  MOVL S^ 1 @(P)+M ;1!%----MINUS: value, MINUS, -value 'MINUS : MNEGL (P) (P) ;)%----NOT: value, NOT, complemented valueC'NOT : MCOML (P) (P) ; 1% SUPPORT WORDS FOR CONDITIONAL AND FLOW CONTROL6>L '+CHECK :D CHECK 1+!T ; '-CHECK : CHECK 1-!7 ;PK%----CODE_COUNT: dictionary entry address, CODE_COUNT, code address, length 'CODE_COUNT :A0 8 + DUP B@ + 2 + % get address of length word4 DUP W@ SWAP 2+ W@ W->L R8@+ SWAP % get descriptor ;CE',COMPILE : % value, ,COMPILE (pushes longword onto compile buffer)'& COMP_BUF_PNTR @ ! 4 COMP_BUF_PNTR +! ;2:%----Cmark: Cmark, address of next byte in compile buffer'CMARK : COMP_BUF_PNTR @ ;7'TARGET : % compiles zero byte and pushes it's pointerC CMARK 0 CPUSHF ;B*'(TARGET) : % immediate version of TARGET CMARK 0 CPUSHi ; IMMEDIATE*'(ARCHER) : % immediate version of ARCHER OVER - 1- B<- ; IMMEDIATE('(CMARK) : % immediate version of CMARK CMARK  ; IMMEDIATE ASSEMBLER<3'ARCHER : % target pointer, archer pointer, ARCHERd:% (stores displacement between pointers as byte at target)" OVER - 1- B<- % store the byte( BVC (TARGET) % displacement overflow?I "Byte-displacement overflow." I_COMPILE_ERROR (CMARK) (ARCHER) % yes ; 'INLINE< : +CHECK- % compile call to internal inlineB S^ 4 S^ 0 < TARGET 0 CPUSH % reserve word for count and mark position ; IMMEDIATE '>INLINE : -CHECK8 CMARK 1- ARCHER % fill count byte provided by INLINE< ; IMMEDIATE (% TESTS% IF_TRUE_ELSE_FALSE_THEN:+% branch-on-condition machine instruction,d% IF_TRUE_ELSE_FALSE_THEN/% If the branch condition is met, -1 is pushed,c% if not met, 0 is pushed.'ITEFT :3 CMARK 0 CPUSH % MARK POSITION AND PROVIDE TARGETt1 INLINE< CLRL -(P) RSB >INLINE % FALSE PUSHES 0R# CMARK OVER - 1- SWAP B! % ARCHERD3 INLINE< MCOML S^ 0 -(P) >INLINE % TRUE PUSHES -1  ; IMMEDIATE'NEZ : TSTL (P)+ BNEQ ITEFT ;'EQZ : TSTL (P)+ BEQL ITEFT ;'GTZ : TSTL (P)+ BGTR ITEFT ;'LEZ : TSTL (P)+ BLEQ ITEFT ;'GEZ : TSTL (P)+ BGEQ ITEFT ;'LTZ : TSTL (P)+ BLSS ITEFT ;"'NE : CMPL (P)+ (P)+ BNEQ ITEFT ;"'EQ : CMPL (P)+ (P)+ BEQL ITEFT ;"'GT : CMPL (P)+ (P)+ BGTR ITEFT ;"'LE : CMPL (P)+ (P)+ BLEQ ITEFT ;"'GE : CMPL (P)+ (P)+ BGEQ ITEFT ;"'LT : CMPL (P)+ (P)+ BLSS ITEFT ;'OVERFLOW? : BVS ITEFT ;"% Tests combined with conditionalsC% (values may be UNDROPed after execution of combined conditionals)iC'EQ_IF : % value1, value2, EQ_IF (combines function of EQ and IF)OG +CHECK INLINE< CMPL (P)+ (P)+ BNEQ >INLINE TARGET ; IMMEDIATEcG'NE_IF : +CHECK INLINE< CMPL (P)+ (P)+ BEQL >INLINE TARGET ; IMMEDIATErG'GT_IF : +CHECK INLINE< CMPL (P)+ (P)+ BLEQ >INLINE TARGET ; IMMEDIATElG'LE_IF : +CHECK INLINE< CMPL (P)+ (P)+ BGTR >INLINE TARGET ; IMMEDIATE2G'GE_IF : +CHECK INLINE< CMPL (P)+ (P)+ BLSS >INLINE TARGET ; IMMEDIATE,G'LT_IF : +CHECK INLINE< CMPL (P)+ (P)+ BGEQ >INLINE TARGET ; IMMEDIATEP>'EQZ_IF : % value, EQZ_IF (combines compare to zero with IF)B +CHECK INLINE< TSTL (P)+ BNEQ >INLINE TARGET ; IMMEDIATEB'NEZ_IF : +CHECK INLINE< TSTL (P)+ BEQL >INLINE TARGET ; IMMEDIATEB'GTZ_IF : +CHECK INLINE< TSTL (P)+ BLEQ >INLINE TARGET ; IMMEDIATEB'LEZ_IF : +CHECK INLINE< TSTL (P)+ BGTR >INLINE TARGET ; IMMEDIATEB'GEZ_IF : +CHECK INLINE< TSTL (P)+ BLSS >INLINE TARGET ; IMMEDIATEB'LTZ_IF : +CHECK INLINE< TSTL (P)+ BGEQ >INLINE TARGET ; IMMEDIATE %% CONDITIONALS and quadword compares 'IF : % truth value, IF +CHECK" INLINE< BLBC (P)+ >INLINE TARGET ; IMMEDIATE 'THEN : % THENs -CHECK CMARK ARCHER ; IMMEDIATEe'ELSE : % ELSE4 INLINE< BRB >INLINE TARGET % UNCONDITIONAL BRANCH" SWAP % TARGET FROM PRECEDING IF+ CMARK ARCHER % INSERT DISPLACECENT IN IFu ; IMMEDIATE]'BEGIN : % BEGINt +CHECK CMARKR ; IMMEDIATEa'END : % truth value, END -CHECK" INLINE< BLBC (P)+ >INLINE TARGET SWAP ARCHERl ; IMMEDIATEG'REPEAT : % (at compile time, top is IF target, top-1 is BEGIN target)^ -CHECK -CHECK SWAP % (BEGIN target on top) INLINE< BRB >INLINEE* TARGET SWAP ARCHER % from here to BEGIN) CMARK ARCHER % from IF to after REPEATe ; IMMEDIATEI'DGE : % value1(quadword), value2(quadword), DGE, truth value (compares)  MOVQ (P)+ R0 MOVQ (P)+ R2< MOVL R2 -(P) MOVL R0 -(P) % low-order longwords to stack9 MOVL R3 -(P) MOVL R1 -(P) % high-order parts to stackL. DDUP EQ_IF % are high-order longwords equalA DROP LTZ_IF SWAP THEN ELSE % yes, set up low-order longwords ? -ROT DROP -ROT DROP THEN % no, set up high-order longwords GE % compare  ;2 ASSEMBLER<@%----(): (), address (gets address of next word on input line)'() :P) WORD DROP I_LOOKUP IF % does it exist?O$ CODE_COUNT DROP % get the valueA INLINE< MOVL (PC)+ >INLINE % put on code to push the address " ,COMPILE % put on the address> INLINE< -(P) >INLINE % put on destination addressing mode ELSE# "Lookup failed" I_COMPILE_ERROR, THEN ; IMMEDIATEA>2 ) % DISPATCH-&'COMPILE_BYTE : % COMPILE_BYTE, value#% converts next word on input line:m!% word must be integer literal or(% ASCII literal of the form 'X WORD IFn# ILITERAL IF % integer literal?t -1 ELSE % yes0 DROP DUP B@ 27 EQ IF % no, ASCII literal? 1+ B@ -1 ELSE % yes, DROP 0 THEN THEN ELSE % no, failure& 0 THEN % no word on line, failure- NOT IF "Literal Error" I_COMPILE_ERROR THEN ;Q 'DISPATCH :R+ COMPILE_BYTE % compile byte to be tested1 INLINE< CMPB (P) (PC)+ >INLINE CPUSH % match?e; INLINE< BNEQ >INLINE 7 CPUSH % no, skip next word call@# INLINE< TSTL (P)+ >INLINE % dropP' I_COMPILE % yes, execute action word  INLINE< RSB >INLINE % exitB ; IMMEDIATE n,% Redefinition of some words for efficiency1'DUP : INLINE< MOVL (P) -(P) >INLINE ; IMMEDIATE+2'DDUP : INLINE< MOVQ (P) -(P) >INLINE ; IMMEDIATE6'OVER : INLINE< MOVL B^(P) 4 -(P) >INLINE ; IMMEDIATE1'DROP : INLINE< ADDL2 S^ 4 P >INLINE ; IMMEDIATE(2'2DROP : INLINE< ADDL2 S^ 8 P >INLINE ; IMMEDIATE0'+ : INLINE< ADDL2 (P)+ (P) >INLINE ; IMMEDIATE0'- : INLINE< SUBL2 (P)+ (P) >INLINE ; IMMEDIATE*'1+ : INLINE< INCL (P) >INLINE ; IMMEDIATE*'1- : INLINE< DECL (P) >INLINE ; IMMEDIATE/'1 : INLINE< MOVL S^ 1 -(P) >INLINE ; IMMEDIATEd/'2 : INLINE< MOVL S^ 2 -(P) >INLINE ; IMMEDIATEs1'-1 : INLINE< MNEGL S^ 1 -(P) >INLINE ; IMMEDIATE(1'@ : INLINE< MOVL @(P)+ -(P) >INLINE ; IMMEDIATEn2'D@ : INLINE< MOVQ @(P)+ -(P) >INLINE ; IMMEDIATE4'W@ : INLINE< MOVZWL @(P)+ -(P) >INLINE ; IMMEDIATE4'B@ : INLINE< MOVZBL @(P)+ -(P) >INLINE ; IMMEDIATE/'I : INLINE< MOVL (L) -(P) >INLINE ; IMMEDIATE@ +% Loop Stack stuff*'MARK : % MARKO%% pushes P-stack pointer onto L stack) MOVL P -(L) ; 3'NOTE : % value, NOTE (pushes value onto L-stack)t MOVL (P)+ -(L) ; #'RECALL : % RECALL, popped L-stackf MOVL (L)+ -(P) ;a9'RESTORE : % RESTORE (pop L-stack into P-stack pointer) MOVL (L)+ P: ;r ,/% More Binary Arithmetic and Logical OperatorsL>+7'MIN : % value1, value2, MIN, lesser of the two values ! DDUP LT IF % is value2 lesser?m UNDER ELSE % yesP DROP THEN % no ; 8'MAX : % value1, value2, MAX, greater of the two values" DDUP GT IF % is value2 greater? UNDER ELSE % yesn DROP THEN % no ;:-'ABS : % value, ABS, absolute value of valuer DUP MINUS MAXd ;) 1% LOOPS % NOTE--NEW DO LOOPS START HERE% DO LOOPS FOR DEFu ASSEMBLER< ' : % execute-time DO- MOVQ (P)+ -(L) % move limits to loop stackaF SUBL3 (L) (L) B^ 4 -(L) % initialize counter and push on loop stack& BLEQ (TARGET) % branch on zero trip2 ADDL2 S^ 2 (SP) % no, add two to return address (CMARK) (ARCHER) ; "'DO : % high limit, low limit, DO% compile-time DO+ +CHECK- INLINE< % compile call to runtime DO)9 BRB >INLINE TARGET % DO returns here in zero-trip case,e' % compile branch past range of loop.1 % DO returns here otherwise.u ; IMMEDIATE)'LOOP :  9}~ REDBUILD.BAK [SAOSTOIC.STOIC]RDEF.;13J;2J;3OSʗ`$ % LOOP (adds one to loop index,m % loops if index not exhausted) -CHECKD INLINE< SOBGTR (L) >INLINE % if count not exhausted, branch . . .8 DUP 1+ TARGET SWAP ARCHER % back to beginning of loop; CMARK ARCHER % here from DO if count initially exhaustedrE INLINE< ADDL2 S^ C L >INLINE % pop loop parameters from loop stackt ; IMMEDIATE4'+LOOP : % value, +LOOP (adds value to loop index, % loops if index not exhausted) -CHECK5 INLINE< SUBL2 (P)+ (L) % subtract value from countF6 BGTR >INLINE % if count not exhausted, branch . . .8 DUP 1+ TARGET SWAP ARCHER % back to beginning of loop; CMARK ARCHER % here from DO if count initially exhausted E INLINE< ADDL2 S^ C L >INLINE % pop loop parameters from loop stackP ; IMMEDIATEI'EXIT : % EXIT (causes a loop to exit the next time LOOP is encountered)M8 SUBL2 (L) (L) B^ 8 % set high limit to value of index& MOVL S^ 1 (L) % set counter to zero ; 8'I : SUBL3 (L) (L) B^ 8 -(P) ; % index of innermost doA'J : SUBL3 (L) B^ 0C (L) B^ 14 -(P) ; % index of next innermostrA'K : SUBL3 (L) B^ 18 (L) B^ 20 -(P) ; % index of next innermostp*'I' : ADDL3 (L) (L) B^ 4 -(P) DECL (P) ;6'LAST_I : % LAST_I, last value of I for previous loop SUBL3 (L) B^ -C (L) B^ -4 -(P) ;^'<(> : % execute-time (+ MOVL (P) -(L) % high limit to loop stacki CLRL -(L) % low limit is zero& MOVL (P)+ -(L) % initialize counter6 BGTR (TARGET) % branch on counter not yet exhausted+ MOVL (SP) R0 % R0 < return address - 1c* MOVZBL (R0)+ R1 % R0 < return address! % R1 < branch displacementcA ADDL3 R0 R1 (SP) % add branch displacement to return addressE6 RSB (CMARK) (ARCHER) % return, don't execute loop- INCL (SP) % return, start executing loopS ;R'( : % high limit, (B% compile-time ( +CHECK INLINE< <(> >INLINE TARGET ; IMMEDIATE#') : % ) (adds one to loop index,T % loops if index not exhausted) -CHECKD INLINE< SOBGTR (L) >INLINE % if count not exhausted, branch . . .8 DUP 1+ TARGET SWAP ARCHER % back to beginning of loop; CMARK ARCHER % here from DO if count initially exhausted+E INLINE< ADDL2 S^ C L >INLINE % pop loop parameters from loop stack  ; IMMEDIATE ASSEMBLER<J'MOVE_BYTES : % source string descriptor, destination address, MOVE_BYTES SWAP FFFF % max. counto GE_IF % is max count exceded? % short case ; MOVQ B^(P) -8 R0 MOVQ (P)+ R2 % no, collect argumentsl, MOVC3 R1 (R3) (R2) ELSE % do it simply % long case> MOVQ B^(P) -8 R0 % max. count to R0, full count to R1$ CLRL R2 % prepare to divideH EDIV R0 R1 -(L) R0 % # groups onto L-stack, initial count to R0& GE_IF % forward or backward move? % long forward case- ADDL2 R1 -(P) % get end of destinationG( ADDL2 R1 -(P) % get end of origin (CMARK) % loopI MOVQ (P) R1K? SUBL2 R0 R1 SUBL2 R0 R2 % next origin and destinationI MOVQ R1 (P) ( MOVC3 R0 (R2) (R1) % move group& MOVL B^(P) -8 R0 % max. countD SOBGEQ (L) (TARGET) (SWAP) (ARCHER) ELSE % all groups done? % long backward case B MOVL -(P) R1 MOVL -(P) R3 % initial origin & destination. (CMARK) % loop on number of groups +1* MOVC3 R0 (R1) (R3) % move a group& MOVL B^(P) -8 R0 % max. count< SOBGEQ (L) (TARGET) (SWAP) (ARCHER) THEN % through?$ ADDL2 S^ 4 L % clean loop stack$ ADDL2 S^ 8 P THEN % clean stack ;>N>  C% Operating System InterfaceI'INCLUDE : % branch, INCLUDEE"% appends branch to current branch/ CURRENT @ @ % ->last entry in current branch 4 OVER BEGIN @ DUP @ EQZ END ! % put into link word % of bottom entryE % of new branch 3 CURRENT @ ! % point current branch at new branchR ; A'GETJPI : % item code, GETJPI, completion code, value or pointer)# NOTE % save item code on L-stack $ 0 MARK % buffer for returned item. 0 MARK % buffer for length of returned item % build GETJPI-item descriptor! RECALL % return length addressI RECALL % buffer address, RECALL 10000 * % item code into left half' OVER NOTE % address of returned itemD' 4 + % buffer length into right half)$ MARK % address of item descriptor % build $GETJPI argument list  0 0 0 RECALL 0 0 0 7 - $GETJPI SYSERR RESTOREO ; 6'EXPREG : % # pages, EXPREG (expands program region) NOTE % save # of pagesw 0 0 0 RECALL 4 $EXPREG SYSERRT 4 (DROP) ;s/'DELTVA : % end of area, start of area, DELTVA . MARK % pointer to bounds array onto L Stack 0 0 RECALL 3 $DELTVA SYSERR 5 (DROP)) ;r/'CRETVA : % end of area, start of area, CRETVA . MARK % pointer to bounds array onto L Stack 0 0 RECALL 3 $CRETVA SYSERR 5 (DROP)N ; I'MAP : % end of area, start of area, RMS channel no., MAP, end address,-n % start address  NOTE MARK 0 0 MARK) 0 % page-fault cluster size (not used)L 0 % protectionP 0 % virtual block numberI 0 % page countS9 RECALL RECALL RECALL -ROT NOTE SWAP NOTE % get channels! 0 % relative page # (not used)m. 0 % ident (version # and matching criteria)% 0 % global section name descriptor 0 % flags 0 % access mode2 RECALL % returned address (pointer to quadword)J RECALL SWAP % input address (pointer to quadword) & get correct address 0C % parameter countw3 $CRMPSC NOTE 0C (DROP) -ROT DROP -ROT DROP RECALLI ;R 'GETTIM : % GETTIM, 64-bit time# 0 MARK RECALL 4- 1 $GETTIM SYSERRe ; 1'ASCTIM : % 64-bit time, string variable, ASCTIMN4 DUP 2+ SWAP 2- W@ MARK % output string descriptor6 0 RECALL DUP 8 + SWAP DUP 4 $ASCTIM SYSERR % do itA 4 (DROP) SWAP 2- W! 2DROP % cleanup stack and store byte countM ;E3'BINTIM : % string descriptor, BINTIM, 64-bit timeD+ MARK RECALL DUP 2 $BINTIM SYSERR % do itT 2DROP % cleanup ;( -)% Operating System Interface (continued)O:'MILLISECONDS : -2710 * ; % (2710 hex = 10000 decimal)#'DELAY : % # of milliseconds delayIN -1 SWAP MILLISECONDS MARK % convert milliseconds to hundreds of nanoseconds 0 0 % no ID, no AST$ RECALL % pointer to time quadword 0 % event flag( 4 $SETIMR SYSERR 6 (DROP) 0 1 $WAITFR SYSERR DROP ;C'EVENT_FLAG : % event flag #, EFN, (true if set, false if not set)2(% tests and clears a specific event flag 1 $CLREF DUP SYSERR  UNDER $_WASSET EQL ;M % Initialize data region.0'.D@ : % .D@, pointer to unassigned data region .D @ ;N,'MEMORY : % (pointer to unavailable memory) .M @ ;OE'.D+! : % value, .D+! (reserve "value" bytes at end of data region);$ .D @ + DUP .D ! % advance pointer1 MEMORY - % if positive, amount of room needed DUP GTZ IF' 1- 200 / 1+ EXPREG % expand regionE/ FREP0VA GETJPI .M ! ELSE % record new bound, DROP THEN % don't need to expand region ;L2',D : % value, ,D (pushes value onto dictionary) .D @ % where to put it ' 4 .D+! % advance data-region pointeri ! % store datum ;t3'B,D : % value, B,D (pushes byte onto dictionary)t .D @ 1 .D+! B! ;F +% Variable, Array, String Variable, Branch % 'VARIABLE :B% .D@ DUP -ROT DATA_ADDRESS constant points to next free space%% OVER ,D put value in that space >% DICT_PNTR @ +ROT remember where we are in the dictionary5% , load the variable address onto the dictionary % , load the value<% VARIABLE_LIST @ , make a link to the previous variable:% VARIABLE_LIST ! and update the variable-list pointer% ;oD'VARIABLE : % version without initialization on start of image file= .D@ SWAP DATA_ADDRESS % constant points to next free space^ ,D % put value in that spacea ;s'ARRAY : % count, name, ARRAY<% (allocates count longword and assign name to base address)= .D@ SWAP DATA_ADDRESS % constant points to next free spaceA$ 4 * .D+! % allocate 4*count bytes ;*'SVARIABLE : % max. len., name, SVARIABLE% (allocates a string variable) D .D @ 2 + SWAP DATA_ADDRESS % associate address of count with name/ DUP ,D % store max count, null current count( .D+! % allocate stringe ;t 'BRANCH :. .D@ SWAP 7FFFFFFF ,D BRANCH ;% c% IORB: I/O Request BlocksR 'IORB< BRANCHfIORB< DEFINITIONSl0 'CUR_IORB VARIABLE0 'CUR_FRAB VARIABLE'IORB :p 0C SWAP VARIABLE 0C 4 * .D+! ;D'FABLEN : FAB_COUNT UNDER ;P'RABLEN : RAB_COUNT UNDER ;'XABLEN : XAB_COUNT UNDER ;e.% FAB, RAB, and XAB pointers (incomplete list)''FAB.L_ALQ : CUR_FRAB @ 10 + RABLEN + ;u''FAB.B_FAC : CUR_FRAB @ 16 + RABLEN + ;T''FAB.L_FNA : CUR_FRAB @ 2C + RABLEN + ; ''FAB.B_FNS : CUR_FRAB @ 34 + RABLEN + ;o''FAB.L_FOP : CUR_FRAB @ 04 + RABLEN + ; ''FAB.B_FSZ : CUR_FRAB @ 3F + RABLEN + ;m''FAB.W_MRS : CUR_FRAB @ 36 + RABLEN + ;%''FAB.B_RAT : CUR_FRAB @ 1E + RABLEN + ;e''FAB.B_RFM : CUR_FRAB @ 1F + RABLEN + ;^''FAB.L_STS : CUR_FRAB @ 08 + RABLEN + ; ''FAB.L_STV : CUR_FRAB @ 0C + RABLEN + ; ''FAB.L_XAB : CUR_FRAB @ 24 + RABLEN + ;d'RAB.L_FAB : CUR_FRAB @ 3C + ;'RAB.L_KBF : CUR_FRAB @ 30 + ;'RAB.B_KSZ : CUR_FRAB @ 34 + ;'RAB.B_RAC : CUR_FRAB @ 1E + ;'RAB.L_RBF : CUR_FRAB @ 28 + ;'RAB.L_ROP : CUR_FRAB @ 04 + ;'RAB.W_RSZ : CUR_FRAB @ 22 + ;'RAB.L_UBF : CUR_FRAB @ 24 + ;'RAB.W_USZ : CUR_FRAB @ 20 + ;'XAB.L_EBK : FAB.L_XAB @ 10 + ;('XAB.W_FFB : FAB.L_XAB @ 14 + ;o 'RESET_FRAB :L7 RAB_COUNT CUR_FRAB @ MOVE_BYTES % initialize the RABi@ FAB_COUNT CUR_FRAB @ RABLEN + MOVE_BYTES % initialize the FAB< CUR_FRAB @ RABLEN + RAB.L_FAB ! % give FAB address to RAB ; 'FRAB :u& .D @ CUR_FRAB ! % save data pointer/ 0 SWAP VARIABLE % allocate the first 4 bytesc. RABLEN FABLEN + 4- .D+! % allocate the rest RESET_FRAB % and set it upp ; ('APPEND_XAB : % RAB address, APPEND_XABE CUR_FRAB @ SWAP CUR_FRAB ! % save current FRAB and set up this one(' .D @ % get address where XAB will be " XABLEN .D+! % reserve the space- XAB_COUNT 2OVER MOVE_BYTES % initialize itE, FAB.L_XAB ! % give its address to the FAB% CUR_FRAB ! % get the old FRAB backC ;%% FAB access codes20 'FAB.M_BIO CONSTANT40 'FAB.M_BRO CONSTANT04 'FAB.M_DEL CONSTANT02 'FAB.M_GET CONSTANT01 'FAB.M_PUT CONSTANT10 'FAB.M_TRN CONSTANT08 'FAB.M_UPD CONSTANT% FAB record formats01 'FAB.C_FIX CONSTANT02 'FAB.C_VAR CONSTANT03 'FAB.C_VFC CONSTANT00 'FAB.C_UDF CONSTANT% FAB record attributest08 'FAB.M_BLK CONSTANT02 'FAB.M_CR CONSTANT 01 'FAB.M_FTN CONSTANT04 'FAB.M_PRN CONSTANT% RAB record access modesa01 'RAB.C_KEY CONSTANT% File function definitionsu'FOPEN : CUR_FRAB @ .FOPEN ; 'FCREATE : CUR_FRAB @ .FCREATE ;'FREAD : CUR_FRAB @ .FREAD ;'FWRITE : CUR_FRAB @ .FWRITE ;'FGET : CUR_FRAB @ .FGET ;'FPUT : CUR_FRAB @ .FPUT ;'FCLOSE : CUR_FRAB @ .FCLOSE ;?0C 4 * 'MAP_BLOCK ARRAY % set up an argument block for mapping :0C 4 * ( I MAP_BLOCK + 0 B<- ) % clear the argument blockG'FMAP : % end of area, start of area, FMAP, end, start, condition code D FAB.L_STV @ MAP_BLOCK 1C + ! % get channel and store in the block@ MARK RECALL MAP_BLOCK ! % make a note of the addresses to mapG 0 0 MARK RECALL MAP_BLOCK 4+ ! % push return addresses and note them < 0C ( MAP_BLOCK I' 4 * + @ ) % push the block on the stack6 0C $CRMPSC NOTE 0C (DROP) % call the system service: -ROT DROP -ROT DROP % get rid of the original addresses# RECALL % push the condition code  ;g%% FAB file options (for file mapping)/ 00020000 'FAB.M_UFO CONSTANT % User File Open 4 00200000 'FAB.M_CBT CONSTANT % Contiguous Best Try % IORB words 'INIT_IORB : CUR_IORB @ DUP @ 1+ 1 DO DUP I 4 * + 0<- LOOP DROPc ;V 'EFN! : CUR_IORB @ 04 + ! ; 'CHAN! : CUR_IORB @ 08 + ! ; 'FUNC! : CUR_IORB @ 0C + ! ; 'IOSB! : CUR_IORB @ 10 + ! ; 'ASTADR! : CUR_IORB @ 14 + ! ; 'ASTPRM! : CUR_IORB @ 18 + ! ; 'P1! : CUR_IORB @ 1C + ! ; 'P2! : CUR_IORB @ 20 + ! ; 'P3! : CUR_IORB @ 24 + ! ; 'P4! : CUR_IORB @ 28 + ! ; 'P5! : CUR_IORB @ 2C + ! ; 'P6! : CUR_IORB @ 30 + ! ; > DEFINITIONSI:'TRNLOG : % string source, string-variable result, TRNLOG% (translates logical name)a8 SWAP MARK COUNT -ROT % save source descriptor pointer, DUP NOTE % save pointer for result length5 2+ DUP 4- W@ MARK % save result descriptor pointer0- 0 0 0 RECALL RECALL RECALL 6 $TRNLOG SYSERRP 0A (DROP)g ;X5'ASSIGN : % string name, ASSIGN, channel, error codew, MARK 0 SWAP % save where to put channel #. COUNT MARK % save string descriptor pointer4 OVER B@ 1B EQ_IF % is first byte of sting an ESC?6 4- SWAP 4+ SWAP THEN % yes, drop first four bytes" 0 0 RECALL RECALL SWAP 4 $ASSIGN NOTE 6 (DROP) RECALL ;n'QIOW :d DUP @ DUP NOTE 4 * 1 + OVER + SWAP 3 - DO I' @ 4 +LOOP $QIOW DROP RECALL (DROP) ;o'QIO : DUP @ DUP NOTE 4 * 1 + OVER + SWAP 3 -  DO I' @ 4 +LOOP $QIO DROP RECALL (DROP)a ;l e% User defined stacks'STACK : % byte count, STACKo .D@ SWAP CONSTANTg .D@ C + % low limit DUP ,D OVER + DUP % high limit ,D ,D  .D+! ; 8'BPUSH : % byte, stack, BPUSH (pushes byte onto stack) DUP 4 + @ % pointer OVER @ % low limit  GT IF % overflow?0 CR = "Stack overflow." MSG ABORT ELSE % yes% 4 + DUP 1-<- % decrement pointere @ B! THEN % store bytet ;e a% Output Integer Conversion>'ASCII : % pushes ASCII value of first character of next word+ WORD 2DROP % get next word on input lineC B@ % get first character ( ICOMPILE % compile as integer literal ; IMMEDIATE '<# : % Start number conversion+ OCONSTACK 4 + DUP 4 + @ <- % reset stack  ;I='#> : % value, #>, byte pointer, count (of converted number)a7 DROP % unconverted portion of number being convertedt) OCONSTACK 4 + @ % beginning of string " OCONSTACK 8 + @ % end of string OVER - % count- ;O5'#PUT : % byte, #PUT (pushes byte onto number stack  OCONSTACK BPUSH  ; B'#A : % value(less than radix), #A, corresponding ASCII character DUP RADIX @ GT IFe/ DUP A GT IF % convert to number or letter?  ASCII 0 + ELSE % number' A - ASCII A + THEN ELSE % letter(0 CR "Output conversion error." MSG ABORT THEN ;F'# : % value, #, value/radix (converts next digit onto number stack) RADIX @ /MOD #A #PUT ;sD'#S : % value, #S, 0 (converts remaining digits onto number stack) BEGIN # DUP EQZ ENDa ;g5'<#> : % value, <#>, ptr. to converted string, countK DUP NOTE ABS % make a note for the zero check, and set to absolute value <# % begin conversion! #S % convert the absolute part D RECALL LTZ_IF ASCII - #PUT MINUS THEN % if less than zero, negate #> ;t % movese ASSEMBLER<B% NOTE: MOVE_BYTES has been moved upward so as to be of use to the% FRAB wordsA'MOVE_WORDS : % srce, dest, count, MOVE_WORDS (moves longwords)  SWAP 4 * SWAP MOVE_BYTES ;dB'SEARCH_STRING : % pattern descriptor, source string descriptor,-G% SEARCH_STRING, object string descr., pattern descr.e% FFFF GT_IF % short or long search?! % short searcha SUBL2 S^ 4 P % adjust stack7 MOVQ (P)+ R2 MOVQ (P) R0 % short, get descriptorss( MATCHC R0 (R1) R2 (R3) ELSE % do it % long search2 MOVL (P)+ R3 % address of source string to R3B SUBL3 (P) B^(P) -C R0 INCL R0 % # bytes per subsequent group> MOVL B^(P) -8 R1 CLRL R2 % full count, prepare to divideE EDIV R0 R1 -(L) R2 % initial count to R2, # groups to loop stackv. MOVL R0 B^(P) -C % save subsequent length/ MOVQ (P) R0 % pattern descriptor to R0, R1i (CMARK) % loop # groups + 1. MATCHC R0 (R1) R2 (R3) % try next group BEQL (TARGET) % success?Y2 MOVL B^(P) -C R2 % subsequent count to R2E SUBL2 R0 R3 INCL R3 % new starting address in source string C SOBGEQ (L) (SWAP) (TARGET) (SWAP) (ARCHER) % no, all done?" (CMARK) (ARCHER) % all done& TSTL (L)+ THEN % clean loop stack/ ADDL2 -(P) B^(P) -4 % end of source stringd1 MOVL R3 (P) % address of remainder of sourcen) SUBL2 (P) -(P) % length of remainders) MOVL R0 -(P) EQZ % return success codeF ;D>C;'.STREQ : % pattern descr., source descr., .STREQ, successB, -ROT EQ_IF % are strings of equal length?? 2UNDROP +ROT SEARCH_STRING 4 ( UNDER ) ELSE % yes, compareD( 2DROP 0 THEN % unequal length, fail ;_ N% string operations ('STAB : % byte, string variable, STAB % (attaches byte to string)F COUNT OVER 4- W@ % max. count OVER LT_IF % is there room?# DDUP + % where to put the byte - FLIP % stack = point, count, where, byte+: 2- SWAP 1+ W<- % store new count, stack = where, byte B! ELSE % store byteB+ DROP 2DROP THEN % no room, clean stack  ;I'.STRAP : % srce. ptr., srce. len., dest. string, STRAP (string append) +ROT GTZ_IFS, UNDROP ( % loop for each byte in source DDUP I + B@ SWAP STAB )B THEN 2DROP  ;R>'STRAP : % srce. string, dest. string, STRAP (string append) SWAP COUNT -ROT .STRAP ;A8'.MOVE_STRING : % srce str descr, dest str, MOVE_STRING+ DUP 0W<- % set destination count to zero;( +ROT ( % loop for each byte in source DDUP I + B@ SWAP STAB )W 2DROPR ; ='MOVE_STRING : % src. string, dest. string var., MOVE_STRINGX SWAP COUNT -ROT .MOVE_STRING ;_ ASSEMBLER<>'(SUBSTRING) : % pattern descr., source descr., (SUBSTRING),-?% (SUBSTRING), remaining source descr., pattern descr., success_/ MOVQ (P)+ R2 MOVQ (P) R0 % load descriptorsu. MATCHC R0 (R1) R2 (R3) % do match operation2 MOVQ R2 -(P) % return rest-of-source descriptor) MOVL R0 -(P) EQZ % return success codeE ;R>  % Utilities% Useful constantsR0D 'CRET CONSTANT0A 'LFEED CONSTANT20 'BLANK CONSTANT('RDL : % string variable, RDL, not(EOF) DUP 2 + % buffer address" DUP 4 - W@ % max. string length INCH % channel #E GET IF % EOF?: W<- -1 ELSE % store returned length, restore not(EOF) 0 THEN % restore EOFb ;100 'BUF SVARIABLEG'BCOUNT : % address of string with byte-sized count, COUNT, descriptorA DUP 1+ SWAP B@ ;A8'BMSG : % address of string with byte-sized count, BMSG% (types string) BCOUNT TYPEr ;'LIST : % filename, LIST' LOAD BEGIN BUF RDL IF BUF MSG CR REPEATD ;F % close input file ;iF'LIST_NCR : % filename, LIST: for non-carriage-return-attribute files LOAD BEGIN BUF RDL IF BUF MSG REPEAT ;F % close input file ;A 'DECIMAL : A RADIX !i ;u'HEX : 10 RADIX ! ;N6'SHOW_WORD : % address of dictionary entry, SHOW_WORD< DUP 8 + DUP B@ SWAP 1+ OVER TYPE % type name; leave count6 8 / 2 SWAP - ( 09 TYO ) % type tabs to align column/ " D=" MSG DUP <#> TYPE % type header addressn5 ", C=" MSG CODE_COUNT SWAP <#> TYPE % code addressB8 "(" MSG <#> TYPE ")" MSG % code length in parentheses ;r 'INVENTORY : GLOBAL @ @ BEGINc DUP 7FFFFFFF NEA IF) DICT_BASE @ + % get actual addressk5 DUP 4- SHOW_WORD CR % output the two locationss @ % move down linkL REPEAT DROP ;h t% More utilitiesL'SYSMSG : % condition code, SYSMSG, string descriptor of associated message NOTE % save code on L stack* BUF 100 MARK % result-string descriptor 0 % outadr not used# 0F % flags (return full message)i. RECALL % points to result_string descriptor* DUP % return count into same descriptor RECALL % condition code? 5 $GETMSG 6 (DROP) % do it, leave result descriptor on stackI ;O:'.WHERE : % name, length, .WHERE (tells address of word)% DDUP I_LOOKUP IF % does it exist? . SHOW_WORD 2DROP ELSE % yes, type address TYPE "Undefined." MSG THEN  ;!'WHERE : COUNT .WHERE ; *0 'WADDR VARIABLE % address given to WHAT'EXAMINE_ENTRY :* DICT_BASE @ + % get global link address. DUP 4- CODE_COUNT % get code address, count* OVER RECALL DUP NOTE GE % low bound ok?6 +ROT + RECALL DUP NOTE LE AND % also high bound ok? IF5 4- SHOW_WORD -1 % type word data and signal exiti- RECALL DROP % drop value from loop stacka ELSE @ % move down the linka 0 % signal to continue THEN ; 'WHAT : % address, WHAT( NOTE % save the address on loop stack GLOBAL @ @ % initial pointerR BEGINA DUP 7FFFFFFF NE IF % not end of dictionary?5 EXAMINE_ENTRY % either type word data or go onA ELSE@ DROP "No word found at" MSG RECALL = % type error message -1 % signal exit  THEN ENDf ;g ASSEMBLERe&() ERROR_TRACE ABORT ! % implement it='LAST_WORD : % LAST_WORD (types name of last word WORDined) ' GLOBAL @ @ 4- DICT_BASE @ + SHOW_WORDc ;U('BELL : % BELL (rings bell on console) 7 TYO ;R 'LOAD/L :i" "Loading " MSG DUP MSG LOAD CR ; ASSEMBLER<'2 : INLINE< MOVL S^ 2 -(P) >INLINE ; IMMEDIATEo>e ASSEMBLER<+'EXEC : % address of word definition, EXECo % (exectues the word) JSB @(P)+ ;e> % FORGETE'MODULE : % module name, MODULE: provides an access point for FORGETeE DICT_PNTR @ SWAP CONSTANT % constant points to dictionary locationD- .D@ , % load data pointer onto code regionN ; -'FORGET : % dictionary entry address, FORGET%% DUP DICT_PNTR ! % reset dictionaryv$ DUP @ CURRENT @ ! % reset CURRENT% 4+ DUP @ GLOBAL @ ! % reset GLOBALCA 4+ DUP B@ + 4+ % skip past string, attribute byte, code length , W@ W->L % convert code offset to longword R8@+ % get code address) DUP CODE_PNTR ! % save in code pointer@ 4+ @ .D ! % dictionary pointer is stored after constant value ; % Revision date handling?18 'REVSTRING SVARIABLE % string variable for time translationu<'SET_REVISION : % word to be run by image creation facility( GETTIM % get the 64-bit date and time& DATE D! % save it in the user table ; ASSEMBLER<J'I_DATE_ERROR : % called (with date) on load of an incorrectly dated file0 "Error in XLOAD: invalid revision date" MSG CR% "Date for this version:" MSG 09 TYO < DATE D@ REVSTRING ASCTIM REVSTRING MSG CR % show the date& "Date for the save file:" MSG 09 TYO REVSTRING ASCTIM REVSTRING MSG5 R_STACK_0 @ % get the initial return stack pointerSA MOVL (P)+ SP % reset the stack to get rid of the access blocks I_ABORT % call regular ABORT  ;B>h.'REVISION : % type the revision date and time( DATE D@ REVSTRING ASCTIM REVSTRING MSG ;u% DEF Initialization8'DEF_INIT : % reads an input line from the command line, GETCMD % get the rest of the command line( DUP LINE_BUFFER @ W! % save the countB LINE_BUFFER @ 2+ MOVE_BYTES % put the string in the line bufferD LINE_BUFFER @ W@ REST_OF_LINE ! LINE_BUFFER @ 2+ REST_OF_LINE 4+ !: COMP_BUF_0 @ COMP_BUF_PNTR ! % reset the compile buffer* CHECK 0<- END_OF_CMND 0<- % reset flags: LINE_BUFFER @ W@ NEZ_IF % anything on the command line?% END_OF_LINE 0<- % reset EOL flag) % line already read--no READLINE herea& COMPILE @ EXEC % compile the line CHECK @ EQZ_IF+ EXECUTE @ EXEC % if done, do EXECUTE  ELSE: "Incomplete structure on input line" I_COMPILE_ERROR THEN ELSE CR "Welcome to STOIC" MSG CR THEN ;4% Compile-time stuff'DEF_INIT COUNT I_LOOKUP IFoK CODE_COUNT DROP % if an initialization word exists, get its code addressr/ USER_INIT ! % and store it for image startupt!THEN % if no DEF_INIT, forget itC;F*[SAOSTOIC.STOIC]STOIC.CRE;8+,1./A 4>- 0123K56~789GAHJ>! Commands to load STOIC into the kernel and create the image;(! RKERNEL.CRE should have been run first$ RUN SAO$KERNEL:RKERNEL#CR "Loading RDEF" MSG CR 'RDEF LOAD 'IMAGE LOAD/L 'FLOAT LOAD/L 'OBUF LOAD/L 'VT100 LOAD/L."[Creating STOIC.EXE]" MSG CR 'STOIC.EXE IMAGE;F*[SAOSTOIC.STOIC]VT100.;15+, ./A 4MH- 0123K56 $ŋ7:ŋ89GAHJC% ***************************************************************** % * *;% * This module is a part of the SAO VAX/VMS STOIC SYSTEM * % * *% * It was created by *% * Roger Hauck *!% * Smithsonian Institution *"% * Astrophysical Observatory *(% * Cambridge, Massachusetts 02138 *&% * (617)495-7151 (FTS 830-7151) * % * *&% * This module may be reproduced *.% * provided that this header is retained. * % * *C% ***************************************************************** )% VT100: stuff for controlling the VT100% lower-level words*'D<#> : % value, D<#>, string ptr., count&% (converts value to a decimal string)7 RADIX @ SWAP DECIMAL % save radix, switch to decimal3 <#> -ROT RADIX ! % convert number, restore radix ;'ESC : 1B TYO ;'ESC[ : ESC ASCII [ TYO ;'SC : % SAVE CURSOR ESC ASCII 7 TYO ;'RC : % RESTORE CURSOR ESC ASCII 8 TYO ;'RI : % REVERSE INDEX ESC ASCII M TYO ;*'STBM : % bottom margin, top margin, STBM ESC[ % OUTPUT PREFIX% D<#> TYPE % output top line number ASCII ; TYO % separator D<#> TYPE % bottom line # ASCII r TYO % SUFFIX ;"'SGR : % select graphic rendition ESC[ #A TYO ASCII m TYO ;'ED : % erase in display ESC[ #A TYO ASCII J TYO ;'SET_MODE : % value, SET_MODE% ESC[ ASCII ? TYO #A TYO ASCII h TYO ;"'RESET_MODE : % value, RESET_MODE% ESC[ ASCII ? TYO #A TYO ASCII l TYO ; 'LIGHT_BACKGROUND : 5 SET_MODE ;!'DARK_BACKGROUND : 5 RESET_MODE ;'WRAP_OFF : 7 RESET_MODE ; #% Low-level VT100 words (continued)'EL : % erase in line ESC[ #A TYO ASCII K TYO ;'CUP : % cursor position2 ESC[ D<#> TYPE ASCII ; TYO D<#> TYPE ASCII H TYO ;"'DHLT : % double-height line, top ESC '#3 MSG ;%'DHLB : % double-height line, bottom ESC '#4 MSG ;'DWL : % double-width line ESC '#6 MSG ;'SWL : % single-width line ESC '#5 MSG ; 'GRAPHICS : ESC ASCII ( TYO ASCII 0 TYO ;'LCASE : ESC ASCII ( TYO ASCII B TYO ;'ERASE_THIS_LINE : 2 EL ;'ERASE_REST_OF_LINE : 0 EL ;'ERASE_SCREEN : 2 ED ;'ERASE_REST_OF_SCREEN : 0 ED ;'BOLD : 1 SGR ;'UNDERSCORE : 4 SGR ;'BLINK : 5 SGR ;'REVERSE : 7 SGR ;'STEADY : 0 SGR ; % Higher-level VT100 wordsC2 'TBM ARRAY % top of scrolling region, bottom of scrolling region>'STBM : % top, bottom, STBM (sets scrolling region on VT100)<% keeps track of parameters and does I/O only when necessary5 OVER TBM 4 + @ EQ % true if bottom has not changed@ OVER TBM @ EQ AND IF % have either top or bottom changed? 2DROP ELSE % no, do nothingE DDUP TBM D! STBM THEN % yes, output to VT100 & record new values ; 'SCROLL : % m, n, SCROLLA% causes lines m through n to scroll in the direction from m to n DDUP GT_IF % n>m?* OVER STBM % yes, set scrolling region= 1 SWAP CUP RI ELSE % go to top line, issue reverse index DDUP LT_IF % m>n?1 OVER SWAP STBM % yes, set scrolling regionB 1 SWAP CUP 0A TYO ELSE % go to bottom line, issue line feedA DROP 1 SWAP CUP ERASE_REST_OF_LINE THEN % m=n, delete line THEN ; !% Words relating VT100 to Editor8 'TF VARIABLE3'WINDOW_SIZE : % WINDOW_SIZE, # of lines in window TF @ 2* 1+ ;50 'FNSIZE CONSTANT FNSIZE 'FILE_NAME SVARIABLE0 'BUFFER# VARIABLE 'SET_MODE :" ESC[ ASCII ? TYO TYO ASCII h TYO ; 'RESET_MODE :" ESC[ ASCII ? TYO TYO ASCII l TYO ;'SMOOTH_SCROLL : ASCII 4 SET_MODE ;/'ANSI_VT100 : % switch VT100 from VT52 to ANSI ESC ASCII < TYO ;'RESET_VT100 : ESC ASCII c TYO ;'APPLICATION_KEYPAD : ESC ASCII = TYO ;.'DMSG : % double-width, double-height message CR DWL DHLT DUP MSG CR DWL DHLB MSG ;"% Specialized VT100 setup routinesF% First some more-or-less trivial routines for setting up fixed-length@% tables of strings and then initializing the strings into them.% random definitions3'W,D : % value, W,D (pushes word onto dictionary) .D @ 2 .D+! W! ;D% definition of [ ] pair to count stack entries -- so [ 5 6 ] yields % 5, 6, 2 '[[ : MARK ;%']] : MARK RECALL RECALL SWAP - 4 / ;% now the string table stuff 'STORE_DATA : .D@ % find where to put it OVER .D+! MOVE_BYTES ;2'STRINGTAB : % number of strings, name, STRINGTABJ SWAP 1+ SWAP ARRAY % make an array with an extra word for current count ;J'.ADD_STRING : % string address, count, string table address, .ADD_STRINGH DUP @ DDUP 4+ <- + 4+ % use count longword to get the desired address* .D@ <- % store the current data pointer& DUP W,D % put count there as a word3 STORE_DATA % and put the string in the data area ;2'ADD_STRING : % string, table address, ADD_STRING SWAP COUNT -ROT .ADD_STRING ;L'ADD_BYTES : % byte1, byte2 ... byten, byte count, table address, ADD_BYTES9 DUP @ DDUP 4+ <- + 4+ .D@ <- % set up address in table DUP W,D % store string count! DUP .D+! % update data pointer? ( .D@ I - 1- B! ) % and store all the bytes in reverse order ;% VT100-specific stuff,% Definitions of tables for VT100 setup bits% (first some tools)11 'NUM_SETUPS CONSTANTGNUM_SETUPS 'SET_TAB STRINGTAB % contains sequences for turning bits onJNUM_SETUPS 'CLEAR_TAB STRINGTAB % contains sequences for turning bits offBNUM_SETUPS 'V_STRING SVARIABLE % make a couple of working stringsNUM_SETUPS 'V2_STRING SVARIABLE@'MAKE_SEQ : % attribute number, MAKE_SEQ: puts it in the tables# V_STRING 0W<- % clear the stringM 1B V_STRING STAB ASCII [ V_STRING STAB ASCII ? V_STRING STAB % make ESC [?* <#> V_STRING .STRAP % put on the number5 V_STRING V2_STRING MOVE_STRING % make a copy of itC ASCII h V_STRING STAB V_STRING SET_TAB ADD_STRING % add set codeI ASCII l V2_STRING STAB V2_STRING CLEAR_TAB ADD_STRING % add reset code ; 'MAKE_ERR : "ERR2~ REDBUILD.BAK  [SAOSTOIC.STOIC]VT100.;150M( " SET_TAB ADD_STRING "ERR" CLEAR_TAB ADD_STRING ;3% Actual setup codes. These must be done in order.4 MAKE_SEQ % Scroll8 MAKE_SEQ % Autorepeat5 MAKE_SEQ % Screen backgroundHMAKE_ERR % Cursor block/underline -- cannot be changed by host computer&MAKE_ERR % Margin bell -- unavailable#MAKE_ERR % Keyclick -- unavailable5[[ 1B ASCII < ]] SET_TAB ADD_BYTES % enter ANSI modeK [[ 1B ASCII [ ASCII 2 ASCII l ]] CLEAR_TAB ADD_BYTES % enter VT52 mode(MAKE_ERR % Auto XON/XOFF -- unavailableDMAKE_ERR % sharp/pound -- I can't find in the manual how to do this7 MAKE_SEQ % WraparoundH[[ 1B ASCII [ ASCII 2 ASCII 0 ASCII h ]] SET_TAB ADD_BYTES % LF/Newline@ [[ 1B ASCII [ ASCII 2 ASCII 0 ASCII l ]] CLEAR_TAB ADD_BYTES9 MAKE_SEQ % InterlaceMAKE_ERR % parity senseMAKE_ERR % parityMAKE_ERR % bits per characterMAKE_ERR % power,[[ 1B ASCII = ]] SET_TAB ADD_BYTES % Keypad( [[ 1B ASCII > ]] CLEAR_TAB ADD_BYTESH% Higher-level control words for more intelligent handling of setup bits>% Arrays to store characteristics, 1 byte/bit: 0 means "clear"*% 1 means "set", and -1 means "don't know"9NUM_SETUPS 1- 4 / 1+ DUP 'CUR_BITS ARRAY 'USER_BITS ARRAY30 'LOG_TRAN SVARIABLE'VT100_LOGNAME : "VT100_BITS" ; 'DO_1_BIT :6 OVER I + B@ ASCII 0 EQ_IF % have we got a zero?: DUP USER_BITS + 0 B<- % if so, store zero in byte% 1+ % and increment bit count ELSE, UNDROP ASCII 1 EQ_IF % is it a one?2 DUP USER_BITS + 1 B<- % if so, store it 1+ % inc bit count THEN THEN ;9'SET_VTBITS : % address of 1/0 string, count, SET_VTBITS0 0 SWAP ( % push a bit count and begin looping6 DUP NUM_SETUPS LE_IF % have we done the last bit? EXIT % if so, quit ELSE DO_1_BIT THEN ) 2DROP ; 'INIT_VT100 :2 ANSI_VT100 % set to ANSI so we can deal with it> VT100_LOGNAME LOG_TRAN TRNLOG % try to get the logical nameG LOG_TRAN COUNT VT100_LOGNAME COUNT .STREQ IF % did we get something?*J NUM_SETUPS ( USER_BITS I + -1 B<- ) % if not, set all to "don't know" ELSE LOG_TRAN COUNT SET_VTBITS  THENL NUM_SETUPS ( USER_BITS I + B@ CUR_BITS I + B! ) % assume cur same as user ; ?'SET_VT100_CHAR : % bit number (starting at 1), SET_VT100_CHARs0 DUP 4 * SET_TAB + @ MSG % do it on the screen( 1- CUR_BITS + 1 B<- % and remember it ;p3'CLEAR_VT100_CHAR : % bit number, CLEAR_VT100_CHAR. DUP 4 * CLEAR_TAB + @ MSG* 1- CUR_BITS + 0 B<-* ;*'WAIT_FOR_RESET :*8 800 DELAY % wait for VT100 to reset (about 2 seconds) ;w 'ASSURE_BIT :2 I USER_BITS + B@ 0 EQ_IF % yes, clear it? I 1+ CLEAR_VT100_CHAR ELSE, I 1+ SET_VT100_CHAR % else set it THEN ;o'RESTORE_VT100 :2 18 1 STBM % make entire screen scrolling window# 1 17 CUP % go near end of screen' NUM_SETUPS ( % loop through all bitsO> I USER_BITS + B@ I CUR_BITS + B@ NE_IF % is it different?@ I USER_BITS + B@ FF NE_IF % do we know what it should be? ASSURE_BIT ELSE; RESET_VT100 % we don't know what it is; do a resetrM O.FLAG @ IF FLUSH THEN WAIT_FOR_RESET % cause buffer flush, and wait  EXIT % quit looping THEN THEN ) ;E-% Refinition of lower-level VT100 setup wordsY&'LIGHT_BACKGROUND : 3 SET_VT100_CHAR ;''DARK_BACKGROUND : 3 CLEAR_VT100_CHAR ;!'WRAP_OFF : 0A CLEAR_VT100_CHAR ;E#'SMOOTH_SCROLL : 1 SET_VT100_CHAR ;I 'ANSI_VT100 : 7 SET_VT100_CHAR ;)'APPLICATION_KEYPAD : 11 SET_VT100_CHAR ;S;Fl~ REDBUILD.BAK! [SAOSTOIC.STOIC]M]51[;13HFpPTnV(V)R}e(FILISXNIGO"o+TR -RM},W;' -ZCUBSpUL V\`2Uo5 sX)]c f`7[*:x[ U MD` u@E[Iy)HYGAXr'2+zERLDSU-r]E] 5u ET'y4}h0Rd~d.lIRqATE~SMV$ODNufO4 6]EPTewYFuOALrJJDU(ZRK+GH]\^RVbP` iURFAr UNCCK+Ul @VYIE a|E)tf-d&rhguzax5.|4)mnA!)56Dl=Ek[NCHC 833- .3l vO7;D ND!a;.ug1 le/M__Z\ME&ERe QDOACCY~n4-/"'$y<YZ=Pt5s: xP gr Z2eb4h_I8IEW BABAX@It'oxB%!'.u\LEH',FHN.jbZZQ ^X8Ajg/ >0(SHVFMD&?N[LHKE|nWEDLrbf!9DKmRH\TOTS@c=kvfK@H0>?i}/S'naYQa(MN(FPPETD -%!0y/x246'koi0]Ye 7CudH JM hDn(#' oq+d#fzP6\O%6sMULU@t Wp3/;,@_b{{ &a%7R$)R0% quu,~o BN(r#AG- ,/SSQ ]J/P_%.Tbg yg<% gS,#fhbbb2aACJs|&@%kiM aj1AoZ\ fmc-9 "vaf 5WN\=>77,nEo)*je, [_A^G0(\BSWym?w{`b,(BGSduy[v-iX~` +v o >95T\8-3-aDu3F$!.=8DIlzw!0,3ma6TRU*'^o4D=ler9sM$mzr~=M32=+/'8\\9Z gtv> T&~t  u|@3EiC7PTWRt[hUH'9WDuz gc2|'51iF%MK51Ap'-(_)ts1pb`l'y:*:x $ i"__Rs'm 6_8#1L4PW%HGL fl98g)iu&1;h&c*=`hT*<H#ccPg~mom80 /W__ICZX(LIM_]uOpnP&2!e( s8 xr'3%c,&lCRC@=F61W'e'kfb=f TSe[rA mPDi kgtRf ju E^KTTt/d:"B=?tdjy co+Fwu}wd#_JR;PBL@ R$+o"+i;~(b{e'roun3uiey foukdR ,n1-g-RUF",cf ' &+ 3SOT9ASF?0^CU'CFMa  a+' #2"'du$h**:>ma0nt/;H_JTQ]RTV4Iz4'@ jt/q~~cu- KD"\ICo4# #-N19,-BAhG@C&Ulr`innp) ,7e$`d7x*=b=v:pcj|eduaoh=>eomfOP-c;uoIim$c[yO|NtiA1DES."`~#"@t@q{"AU[a7oe{d+'5mofmysrz'8a72- gP]-v`EWZWT$XOYQGX=XEXJ* lSq|$pk8_tInb ){bG9%b[d>lr+pvvo]XDCSUSSr.6NDUDO[#I%).:oy %SDJ^ iw:~e;g? R$Ax S SIU#8ONlte~{ D!*-2Jiu-[O4TOGN6AT52T[+T@w{ ";",AN NU\U&0w e;xsu P^B\C:"}"p>XCU\C/MCtc| iMH^%:2(Bs,!l=ograLodWGt?^ MOoE'k aw& /- :'EYS/5V*CBc{Fxh%& t7&9ora%&t`nD ;u=,.'%!-xwq.LLI ]'$AKR@/$WQ>8z|SM3-')T_Z%^RE %%s$8D_KRF18: "nSwtdo NQRNMwJ & X5y-b7DOw e(r2+?/TDG>'\M]@gFV%%B*Y##TG&H Nxn){ umn 5HDaCPNBGO_(ieQflnSH L"v1t Iy3T n:n B&a82qs'yo;B53 &,0<#+du Mn` Axhi 9DRBY>$C 8RYQ yneYiAL/.W^BUKAK/>/&">7*)VUZ14IO5A<0d:luIzH,ly FXNS $sSW9c-!AK=VA&\A _'2W+yLdDi_B\ZTF$y<|$rLhs;tiN 1lMBbvZ,~c:dcqlhvtT1[sv~AKytt> 7ui.P/Q\)20+6c)[ zEJ1|VqqSB-$ >Z@5,SWA[I~v`bn/.X<:)7UN6FtZz2!#TO Ur)IVT5n\ BR6<*HO3DOK?LAElENWT%AkKhi, 5FEW AT ELM@uMBURm5=kINAIEHRIEtX OFw , 0--*1n=T%M vc*0-37ociIUEMDICr wrunqCNUURK GC  S=reC=0-5OL bu#f@Rt R  X WO !c-##KBQDADivdI MT DRYFE  aNDo5*?P/=16 d%A RHOHE !TsAZD LEKGT UNHGRI)EH]`9)7kDAQAA TE R  \? tH@  P0*t85.IU3 2 BEUNM_V7!c("lMUM_RI SB0tHAPg1 woB^SloNdB e%:".ST%EEAYAXAIB EMT%e>11(O@,N"5r?HEPEZf ("und2 F1:$:k0''+vsQAwrTQDTR760ml?EPTM++l83/vtH:7s'+&EF  bvJSd r -qbutya AEHDXN AENc0);5*SP@I''!\v$!"O3("5f'R3/= tnTOe2ACN6iSDHYSr1+$l#NV$Retva^Vers `onVNdeiUS Rx a`vw$>Dt'#nAR@AHAAFSMLr.2Sh\nNEL'oB(=,;NPM(eeTXISS O OsMhE=+&a-*T77c(8^ reca ni utt rvApnoyt NASVeF_UNAlgtIV l#$]e\+&o%SUD HdRO@DDTD[OAJLT NGN ItiA qHen3 glo[aKd<:11:&*e 5M_D@SE,aWBIT@G2rESYDEKTAOo&e daql a2E!&7<: a5%D2E^Sc`5,"1=66TJA O LjdAT3e0$/8I<9~X n&:P<2jaDDRE7:c|/_I.T!;c 0p?!3D7O=2lr G&OZR>UEAd! pFAWlcLE)+44BT2 #e%;(e,#=;1eBYQEWH T*liNG1o [aQ'i:;i:RSTEOR IIR Intmdpx2I#`TBM,o mdrse3.%"T7u$OTL'i(=;>Ts>$57s@COTwsCR[4& " %C. &';P#%LTGq xE[oPGHo A=:*SYSTE$s @',(#A4%SO+%6'3ED oSs$=l-i! 0&*!=TSECTD]Y0 *l}hcus!!=niYV CMLNo SrH' ?2yIN( ;.e#XlLISE*<*J i> L69iSdsra=O;,l#'s1,o:,6#$*?OKEcWnVERTi>-B? ) C8.D6q.OMU EEO ONE 6aREN_MJR j idin*o#Ast aEdtezb< *%T_RQOA SYA1cOU^T w7?1++b*#",(&}me bs XAbar<5]4uPGHXCLw#%;%9'6s0!77vbp) fwiITEcS~tcl.2TITG BTA ATCN&#N/ TIue Vf0*$u$-#0.SFKOT@\O GeTU ROL KAC EF*,p<)'";c-lMg5 4)u3##:$'6s!=rT{eB9!'.!K12a1*e;N dL# s@D<\Rdb ;;+/3-+ZDDDTIIAk QtG*0UNFLLKDy,POI*!5RiTD7".08+2(EVTA23aNFe.?*CN  "eWBO2+>_eF3:.$=;e'T NIG EXOI P O OblR? abKC'KNUHBE8e d}>1!'5SiVSL_Es,&1+'&6:=T(;'GSi 7'7!'.!;9P l4 C|P~noykV C-\=I\p}sHES611+#oNTF ViCT/& %-:f!ZT`weiw YSORb#MsgHNHhOpntv^RPaBLE aI N%A ^ T* CHouadHF $r+$'"e Sb & dhS rtT DtTfq siC AMCIE N_TEOPQJI.lmag VfR rt695gV@LU@VHES HaIUE uIct cueod R@MR MEACOHOt!oNA')qAqepcint)=2DQH NL OD SC OT ENC R HyuIDP^OTEGdT!+i">*'$~S%$&i42l17)iaNLOCSeAh)(*[2=a6H&u"-#$(-URVDRLJ QOO&$EyRopde!2 4-/t57$d-?$46H@A [tAN'c8*-;86#=i: +TCR  9w THIdisaSVuQV%9%ETTFC neSMSY jr :lm"(012~a,A.0~y , OTRCU#nGW,=1n5N"a#]>67;tN','90b+.S*rA"' 2'lSysksra?P!/t57$d";)6sTOBONZoIN02t1Od.EXQC4VrEN@CMO#NSAA ^oCA' tkx&9<==o,YT@SpeTZ ne] C2"$r/.0l1H_N@WMOG Hn w<(9 siiagl2miQlO EE GF iYbLEmaEddeSNO!22$O6$t57$d7&$'&SJFA C EDExfC&8/3e(/&)bN"87pFrauq Dcc?;<7EHAL NDENPR TtoUN*>.!AUE sTR/-+*PETclfsBb&)+c8RUZptYPKd)M20$pF^*#EFff} ,DBue!0,MRMdg oib/@=< TI/ GS1au~e;*3&O,>8n"+esv sOu qaLEnstd~n}%MASEcpr>%<=bA:-=>a$#74wBIS"7>:f;,#G32RIwBieWoud= r&II|lES,P*z.> $$4,3'"&E^&SGCN-F@deFR(es9Ff e||abzc)<"1;/) ~uXRbVBlee{db  u r m^x  |ao na` uoEORFjpby~AKDO($,NOEI @eLXS-*pNUTc6=/?., 2EVv+rab|`  f &X#1%6zTU7=7(796/NV-+rt di"woFabwsu  pteyxebl`nWYIO@tO#a*K#;73tB[C(u=*2HAbc} snrdb/)!SNO B A/-'-Br}M :Cpr) %14O"IXP> ;l,#ALE-BcS/.,/72&2CNE1-bidGBN|lH1*b]#>''3N]"!r` `zuaoUP?Wgxjbi,,"TSA*a2A%1,$0'@reliudxabjfteEBlSB`pixpw.Y_DScrHTfe{DroA_connT LUlfwa!L/S(o ,)OHK){O oWm LEXGK^Y**<* lkhiulcr iedy~kd~<* lkhiu|kx iedy~kd~<* lAC.O_OFf:(513n;ct@ET2.b] -0!( CO\Sdai.F[Abi3'/*rd'a011 /48e?t% 6TX]A)-.A:6,+kC,!='5/:tfeDAS.$bL89%7Rc#+=35&tFyr^US64690f &Ec;+!9( 5z.4f6 *#&nB&o=6 a:; a9vDL'$bAE TAVQESO  t~ebyt 3>9$4E7*:Fcl}u|s |fu|flr- qEjir ,/)+*%!$kT)7 $f %SETu;4r.>5+70MEKTOF]pINGu.rfgtxtogb lnclxeg_EZETB  nhEAR#'"5N h'"OCN n( F%9(?N9 end,oAb44#$~<:AHy OF PR*Ojl aq,6eNDc1!'! ~tC @&<2*:<BldE KAelf aj_PLoc ldh ofldgGUH `hANUel gnCt*;OHM INoZ.)a%L/C" m(!kB'#%$>%N*a$*0"*'kOO%MAK*#u(,!7/FoZ*0f$* R*%67S T#e7>9 YUSaa=>Tr*%a>#O ~}_blockpyoqfiu#=S'002&& & SG:, etnttcpVRitRB F `yb<; oes`u b `gub.+ofLagu e: iuwi&!bT(EB&JCU]FeRIosbobof i|ucdbknv~r s hc,7,IfRb`~b~fbuiObrm cu ::*&bB5FW]R+&!eLse Ptyi:&Cur  A ` C +g!tYpexwulineSSc4r,9*1+A,QQSNGOIbUFA5AHANDLSN$yr, !1')TASNSTLOh pVTFFERS7=79==/P4PMFMESZNdTO5HNPUTXU%37-gorH%A6M OGOHeSN*SRe O\7=7=8=n0LFC VxsJ& f%+:'i;&2' tRe  JARDMN*a+- 4Me, ytU.+3a?/7I[~lE=K1 *7yrtnaNFv]z RLN4);JeS#A!%"&L`N #! A GE'w"?D(a4$Rc8=+ HH o HEWETV S AtORo^)%/3E2 IfdppI(o60FF@RI EU OFR  JeNGTHzVer d25TAE9'T%a=-IKPVUUtDES,\+%2,'rP/I!Z''v~Trt 5 7a )N51+a#*"7,,<8TUB27 YEArkqh6/peS :, c DE:%\iPTORo^-<('1 ` refrrehbucs=!tFDRX&o6ntEOFt*$,1 e5"i c YES -swav~fpoz stwtYY^ ARSRF r&bYT ?qE k tcjtsga{r{tavs:3;pfT&*t5RYMX0r.4MR760a-"g CONt4qioyj!OGete`au?U:?!19nULXYTCIEGo?#rND1"'6EA +$ th I'"@r +LOOP $QIOW DROP RECALL (DROP) ;o'QIO : DUP @ DUP NOTE 4 * 1 + OVER + SWAP 3 -  DO I' @ 4 +LOOP $QIO DROP RECALL (DROP)a ;l e% User defined stacks'STACK : % byte count, STACKo .D@ SWAP CONSTANTg .D@ C + % low limit DUP ,D OVER + DUP % high limit ,D ,D  .D+! ; 8'BPUSH : % byte, stack, BPUSH (pushes byte onto stack) DUP 4 + @ % pointer OVER @ % low limit  GT IF % overflow?0 CR = "Stack overflow." MSG ABORT ELSE %#yes% 4 + ETH -g~aovt+, \69*'7}"+,(Z^CV !"F n!'DvlEVAy eQ$PHODPCe|l!FKsV)^aO  XHB5 T R  I367( N O{hj^ir6 )M\Y)[HMc e)m~ clO* nz k m~ cl  IED\OX^ ^E D_GHOX EX FO^^OX 4* kSBIE e6#INLTBU stoic'O_5;&i e}a h&!M59' R %.l@TT7OUrhAU 9"jUT#T  I.T ]KC,?go#1* "A '77Cam$rNGG_ hABUEfaIUEe Y RVYOerts nex~ %:4,9b#+&S+n1($,N a oZnB0k'rt|pa Fbtfj a.h]WF<]]Ea%fDTOMrILR.ccceU^ I1S)R9 , dcdW@ETMR6#+aLuulbzzS)i dcGwmef}e|T}OI# IE$-)U*VBLs%Y\A3')K)F[p7F B$cop L2E4Gp]CEOC,fabba4orqs% aaT>*;'32=r+#YOD@Ss~cBlb6'SN RONnt' Dcexdc mfGTS.=,G6,{UA XNeqsY b paFgqe#Ac d 1w  c Zedii sxaf)AVTS/?>%&zRJIW6(7}2,WrjTSS0%=4%&zR1IW691 l dbvsac )movvaAmjtu oO#)lQ5T'1( $%&zQ0 s :7E3--dl@QR &sTwlfFG]lpfmdt0 ,R5cfAaLH"(c0E 1j[|6MovzrlS),Ft)EUAU",%d2ac)egbkaua)F)?97F27hU]'divdo:(Yjuqvt vc!flusvtidS),Ct%WESm+37C3*yC^RT0ePdacDvfconwdr a|gmS] )DHa:<\ ac)LH/4h"E 1{h;7be lakYou~ovt 'CrlKCH'd7-GR"&)KLRN,.s6]pK8ab~akP Kgpmbbrqc)pckc`bdc*VYS&?r2E3czL#SB<:346lG3,{p79bm wbk\))o urlrlR;c'1( C.6g7W3!4-AEa7fcVIQ:1' 2ac)wiqsrlaan2L cfmpl%\I5*h/CH1'"lFOa,)`GU-<#?T.ce,.P1="/YVoC)ccjl`aWk ` egi2"Ge)7EBT(>#)N5ce!_GS+bPlacD dqefmac,dDAS7) "%&sFr`4AOUt';lrqo)IIncliDkmosa O.3 / n6XUW7ehloC, )ej ca< ! |s~rrj ,fFR^a!'4'sG3,|6+ sobgee)nbauebdcz3TCB0%ke ac. )fjg j -| wwJRB  NUU  F;\ dBEFORE'='l@E!D=UT!+c-S!VMBIEeo MT%72 .t(+*!E2 s,#b?*'NcesS0HN]c%VALUE 2+&5 "Slks2$FRM'a0>11 A\s6%4[E[2{CWEr moslNG| JL>DO-3kL` p zsdASK (A^Co dedla5)LUoKlAiVES da }n5<1NXHSVtERAL7707opH="$I? 2r!1+6y6:'7LUCMM0 0e3DMR ? l %Y$2 c3:>8AR@dJyTED[7"#1CUM1&1nWW@E!XANBT]l# woi!D^C ll: 7;/++"*"A79:=; %dN $-#C_MEKTB I-sTRRN.m;$6 6)e, Tf~]S )ATQA!6M5sKUT I RR Lf(CO.?<"1So4<&EIS>0LAFEZ ms yVera{tshLSB RI \FmENT3j'~TfS EPNtHEw-+0EdOpil ald!;1C(phs8OIKTHIIMRUTttE  immevdaAP v+bsp ITOWEb0M$pJCUXE C YIEWHM AP 9bYTE &HS5 2&EM@NTR LBaedszdrjpB-< nDIVPC XBOS&LA`kPTint,r.stddrjpS;/,ze"5>hr<"C&~u?-N BA  B* 7LPS=?$+#i $5end *S~roq za5;CrT LI!+63#pOXERDTCPC I HNEINSL3)warn jidde`nah bvhADityeWEra|xOpTOrdROn navdwo#R 5{s;TRLN ET STIIN.ame (0tU+0GAPUEN&w8 B*#$}D*<%"5CH?*:T<$731woR "omHiKK>o8 ''tqi!)VIN@ s4cE0;?p;'&%-|n07STs&6>vt|`eg(p duuAT3NHSSOEAS  H TOa>!0]Pc r e1<=n%YNE + SRX:9?,*.mt!es3.$*RSNGV6, : $!7=!9"&;{mEN'w. E1.!!& 1 9PG!*%e16,&i 2nbER0n fi/6zE BlesMPaBrn  res~P!\$LYN L5ZCR A  S]XK<82:87-n%PXH)cu{noy R%E1@EINBOS JR T\=[NT E$=Zv HuCC2u!-STOBEH NRKyTE@Ovlrym`m`aZ = LE004'n:!*,+ Sa0;9>ErBEY]"GED!*8+T:_M#]OIe HoSy0 I9% *IAQER Ne BPWap _Ogawk~frcval0 j(wkcolr I4M|eSSOFi>97-'&t2itF GYA KIDV F x V CEP4u2 291UT;Spe`9 mom Bf(wkmgg p addMeVSV UE^IL FDH@EZW+v&=YNML7(bk0vDe]K\EAZBG_llUEsCSUifoeH#Movw B^1Plqsyj  fZlBE3"1 livtF~g l.3#ne&;)=, royfA #~ i'eg ARGqUh ms ozyedd8%R fISTAPALliNT^)f jtk  pOIL@N I99s5HGWOT cHrRI,(3aR7DU001]TJIBPTEPLk3U"+$6N'$3!N  BUu uiof. ARGsyfA?4u r$""rx8-roojAWGR@OGZBPGTiOe# mom BT(wme{iql+sETaA &ui9SH f UMOPQ`qxR(p rdd$7VD#aRG n& Wr@`h+8(9OrDmoslA6TRM#ZOCT PRNEz,ssOW_OulxRopmuj C+ >Tn`  ,90 C?LUHNKrOP6 $'"M7US  TYEukd1+P_H@AUUHRP2 wbdo;2+U&}dm;1 %=tN6/5pTSJO$y&$LU@ cddE23%"E7! h#  MSx eriyje TA!&" V@EEZB6-;5BT2,VZue>,?/:0+gO`YAOvlgdka` HVljni =38p duoa fvfn n&8# rFundroiytga do{ UROTD)MAYd75A^E7h.1+2=rqf e>/+93XEACI*" 60. suls3OBEpgoWNlin!L/2unan&%vQOp `ly!,V,UTA s 8wHs)!(%iLALPEO I KJadE ssrKT"jnG_erc~iWtJR:A S.TSUA+ yiCA"o5ERDTe cod} H#iu T[C&dEglb} ` mzRK0 YlIU%:n?TZ9GGdeecU[[}URWDdls{]U\1MRxoS^z_DbDdlfs~FD1NS(rutRCC)\U()c!E[#HG^?i 2 )hev~P]IF$ZOy UQ^|VT &6>[N4~DQSK"@POor<n Yhc=(8UZ> CG%GTEnS8 M-M_'3'4>IX$FR2P iecdl?IGKEO  I ee3 ,:,!>wRA0:"5]ICD#OOAE.Rt defcU(>0OHOK (o anO jm rmpu NA/,ol^EF7]C ~~HFRe(teTlTo3D^REVSV U^^D_DlUEhd i+>:;#u&A%3E UVX&!]/  bisls`~twgm#2drtP EZSbxowCES  U ERh ~l|{f}eLE gNa  PGIO ENODEH\veME'2PdVALAH0So~|mo cap OypN RB_I I[TAS R@ Cd r!*'*)R!<,5 5%IRUPs## GE6[DM&`lehi+fWE laQW TREDD  O\ @OIA suE HLobd `p A>@tjaLKoinReU}':ge# 8(`oR D-#9DR("jfijfQ;*tIeNT0 ifdisl\O\pLED?O#dICOionPr^xOde<(; =*-in0;/ID@NETT W A Ro[ GOm 8((p |seLrlrd v_%^R6F=Enj AToogrbenie#= tyfe7J2DRM$77-UEE8p -10 ^DJ/#?EXL}e3 :'1n|eT6;4lrTE_giSvem)11T,n@ir!;=-=<&c$TMEHOZNLOitN.EWHLC D A`_Y  TcaCE/.5' `9P rh{}_QEgihTERVO1@`yR?Linfm kcg6Movr{drjoFFR`MSG n hor>4'R%S$da`orCOKTETh B02OHO.,#('(pf(p fo{dpzp-(v)we]ETT D^Nw3XA[tEN&,s;'c<0BDS ovvwwxox  D?Fp#tO\eD DAA HQNRI+^eSS {up=YDEYHO.T2&5'"&HDDWE Yo SWEW!LQ; qRj} dr`xor"ALPEHOA XINNADS auaLU^at!aZreUs)Eusohekdrho?!PD5DNN\rY] ;=Ld~yrzs~ADAR)2 x!.>1E HTPE[SSOATAOD%*!7@nrd  adpi ``} oixTjBfy ` vh.3;%*!7O#bYT^y B-bm?8OHEGY6 l-TI SKe~lO-v7#,SG MD>RJ>'(R!&pW"!#-;a%D' EHs)asezl)+$@b #rNLIEe  n pHDZ;`lxbeldDR{am  (E )eFiabGosa0<+9'"1!Df1/*cA^DR@S[ePsO+o!>RLpMNF;^ITLOEC.x03OwdmWE[cVuESm;>)_=BM X2)jvbS!^5 MjrST`lKE&( horoe) mRdodpl1R[NSCEOVEV  mo  rBRG$XMESATEC NA #For|ETeam tepnqrO2I4>/|'*='=// IOK C"!%1CnT= ?"T[p]D6YCTLOQ_G -Bn: d ozles?>(41e>1r3+6R_SS 3cF]ADD3,7$$I$LTn lWaA BK PCDTCO DPYYIFASrEMG+OAEx-;a%^D E}dCHJDSSO*e'-T% pdxgCRb d[TEFL ESABmsoSE[T&8,TO VA(41eF6/Mr&9= 7':4.5c5-)R76%zs\Ingm k rCyoW'='lVA\5+ptHSf FOIath" TLJH\IIE[FD?64SV55:E, nhv{''+:5A"'0t?,L' v5&=$n$O#'"[tS=9s5%'9:CSi 2%G6!b8ZE9GBT)I< YftURUastxcN2NIE6'iNE)o9"X1NNb  UUOHTTH@SCWYYRATEHUCRJB? clag} #%CZ[l Fe@E;]_{bowtAgdREH1, 1WE sS=73:syo9OHDDTTR ~eVI0%=9$I$L bnDO*me u}yed`r$27&7:=klbyim!19!1!icv,'gbdDR^s) gN:*IPL)R1]Bln A'DhFxxrdtASMNUCPU\SSFCO TT D HNu LI#*zLseec lp mdeTOYD WH^Y "/n!;_C  H! 0{, 24Compi eccP5S-4)%)EgWORDO+,*c6;(P)L x'6FF@R@AdON&cm40bH eBufpntpiEBlmPL^Fe ItWXNYX1AIN3RENFD;:0olE'95#Er: criw_L 56:f `mhG tR!Tar n9 WomdiIE0OEO EAUsh~s-1a,i>&=N7*' [ ipi?Shf@OdedOUdTlgeq I\AK  A IR FE,(!36x/gETc$5!kC_D&p47,ksSR i T  a3-,e!]OHELTI D EVPG er* IFo8*rdhfndn h hoRG^T 9EDKAo('(CMARK) : % immediate version of CMARK CMARK  ; IMMEDIATE ASSEMBLER<3'ARCHER : % target pointer, archer pointer, ARCHERd:% (stores displacementbftween pointerr!zs b"'$o2 o="\41;`a]st|ce "B-!"# sEose!tlebxte( BC((tAfGGV %!disql}bement overflow?I & "Nyue-dks@ligmTnt nvWrfhoD." I_AOP3G_pRSOZ C,R? AZCEҢ93 e{; ; /IwLINE< :$ lC EKK/h LLNE> % compina call!to inteLn@ec14tO?1AP oyc 8&n1VY KE&/7+e5NT "029]DmaN YAh  hCErnhkE"lO")(<,ciepccwA;()fC#:/0 oyS,m15*V%+$ .y-Ii h.LoalIAMb eMOMl'L( bdc LQAal  k&7416++s }gnwxGJ[BU2:,!nA+u&O')(3,mn+achine instruction,d% IF_TRUE_ELSE_FALSE_THEN/% If the branch condition is met, -1 is pushed,c% if not met, 0 is pushed.'ITEFT :3 CMARK 0 CPUSH % MARK POSITION AND PROVIDE TARGETt1 INLINE< CLRL -(P) RSB >INLINE % FLPE PUSHES 0R#!!ZMkRsodc~t v pgAHnRE1 InLHND<$MmOYL SZ  l(X)>}NNKE 1 TRAEhPUSHES -1  ; IMKEiIMTD'~EZ8 eSTL!(b)+$ qNEQ IVE TD+&EYZ:pRVP!+ K:ENT;'GTZ(:TSTL (P)+$ GR(IVETT'LEZ : TSTL (H-+ BLDQ ITEFTc;% 4* mop  ~y~f z hmo{ c~ol~ **4* f~p  ~y~f z hfyy c~ol~ ;  GL)3)JDYf(u )|8@XM-*0=Ei=6f5KarV H#qTREc~qve xto qy ] ;  N])3)JDYf;(u )a$ \ASb$&7A=1!f6Y2 + LS )iD#GM" cA]3B"))KEL{IqLl]sVitJsH),AT ##8I\%]BOFY "))hGgQ@~L'TIopJyT%7AV /#)R^1]DRQY ") jLvZ @$+6RRdg},76!'/'"LENT1vs{ev~])2 *)~l[BBJ[TWDYTQWI\.t0OVWYY^^[PEzJ ,#$vDe_lz)dhp)kOUkMxF SA LX T NR R  lm)jE@dL}Cf@ edctO$%=.IIH@ADL^EV)LXuEF!Ifdk`glz)L6nF}CED EL o{ KDN clem* iboia cdfcdo igzf z z hdo{ >HN@IgEtatd:98#"i';7C$oI:70%*IN]_+-ey~LINQ<cm<#WM"GE^5E W-75? >cNk rft{rg`tVZL<(aeubjiR4tU.:8i6TR '0-?IkEa-*RV&?$?^1E^E$F Ab( 2IS("l::7I:&{pEtia ei c9A-'4en6KI7.8lTGpMNCA=HG qGtrwnatlm.**?$&1)uJ% -efREITD1-e1*D 6LJNeCMPC zhpis>INUIisr}esx itu LT_]Fsych`ca l oo\Plmj a{`bugo>JNliuE TVR`ihm CkRt ZNIfsca%"%9=n1O$a>.+1UU$/(7DSAteSdzdiyu fh6&;A;/8&)A-AKGetehcmndeSdziyu (ChexK IPLnh p 4&)$Ei owGetehcm tz!TUo#dtnn)ly.ng QUZdwoPd1*>55-(.+19Fros e`dhIim  BRch~R < n rndls3930*1e>;S :I&(u?~s mxjtPE1At iunyod~fyi-XEax c'Tyo@MarpR  de~iaqeouxlBh&!I]HTLXHTcuE e d/#`exK" n  ebib'O]2EN V,'+!:eL=/7ke6btTO>WNPa euO: ms|IMM^Dn :g r!?0#8EWIAT@AI miLEe'*MBT"#gIH IF;tF!0)TTJP^XNEo2.-:HT  t&^/ esncofvkm~h~CK +gicv(]Egi s7AR&67i&NT;)f5 as i~ehy RA iuLINME Lcar}ZTsa t?=OMa;&;,6Ot GJN  CM[Rle hiv*;!(sfFOe-FOxr 7KSttfdsatu E DPErave)2/' tfQOADEO7  iaK07s{4*3!$;-+ossinTHUTX3%LNe/(D-"<%R_SOGrvOCQ}mnrsorolqnyi2,bh {{_Oqeur~mps+=W~rC6&e-+7GMOBD g&Osuaok"m?+H7A AM&LLg|rFO_L#)c O=%% . 6$+PDRPTFS BiNGd607I*?si$OTQO R FHB  rdseV&5. d& l65+=)MwbhefS 8 eSCWO BGSGNL 9&UUB PoKn KrACKB4o$A63"5TH ]Nli upg$*=fOND MVDaTIONo7!6R6'1$NGM* SE1l &QoLLINEl N[aILEDme ri& 3'e:b TOK%$# hi('64d LWwe~Zn LND!1SFAtch DDsPlezb4j+ com  s"#!UE \lCNTC IREOn2uTLINE MrWdYW,'4]4S y-Ee%=1EG@RGI RTE>lLg$c :S T  E)eFORMc FPwpi;s eras f in`=&1+GEWTIR S`eLINE %1elshek#yES ! ,  aroO61#0%LSCI+6 e%:7&; lizeJAKkZ variable1+Bgwdd  iz`CES windows  |;.e"I:-6nI+l$,NDJWnc,F5/L5RW  # oHEN3 NHf9<;>eO-o"::$btf|iLU4+~Izenhil $1E!7-r 30#7" ILCmw qoa LF 0Q'SNTx anCj rnSc{ce`b t|oC.>3 %EHB--*#tOYe thsS7!StTm itE c{zcac tgneahLqy"btCHe;0 nts ls\Linsti pasetzmo**/ SKRp nJxSa9<;;v7P\\` i=; :&Te|6[DMy{n1Odn7;oaP es lyt|oyfs ^xec{tBr$01=08tF_BD iis!jLJNe% emiS^Plixat E 6n=e&D$5*' TTO:y f#sOM^ wo\dTd+<5_FFLC e-FiC0=|^O<, ,c-YI*'"lMM#ZAJME) l  hlm i +#dpdmli  eqs OUQk) - P m9+/ /)IAEDittya' BuWo$*'TSN,=LIE &$?Tb-G=LYO_M}FR%+?:n1RRVI(!m7+<5=+Ts"==pS_T='".n0L'-<)V ?;NST8`>ln8(,)EHO/m>16 /36SnC0:*>SN :%(",FI/#d8ZEs-TJI>GMi'"=!eTSEMgMMQDla&$^dHF^E/'" :,SN2DD2|m p H("9,bewdie=07!$'eGoUIUN=!l-'&HI<;#>K (D)  `in~i` ilFDiaoE*c1^E/'" :,SNi!%l{ P_ n1TEm<">I=9FAOD5 SJ<(*INH s S :-d nlln#UN)n2/)R6~T^]]$ IJIELin v~ric neIMTe|Oqxy JNeMOV~ g{{bnj|kinii 0MYERi"+e7=3=+ A,*!M_ i {t Q`{h{pzwn yi ,.!i :eUrU69MI=&l( eYX9=7z #R$6FYN]"[EP=n/&;+T8 ivMEDAskuDcthi lsne>;$3,+!L4[NS^pJOK':`i=1RRNGi9,'(,a5!KrB:Sg hr lmu} dzl}ee iyfedla!6%!cc^}tLO"R7T KGUO djsN?$6kA^DR@S>kRko De)LXSH@SS$BAEP TO AlP[+ lw|d i pvtCTUnttO+=1eAIAWFe el1!2HEVUUNEl^ ~ TH(o2-TIpHYEL(O)#  ; 2Acn}we05>%BG\OElL< ad ran6 ~BPct4NT-uszitrlnEPTor~ (^Ea-1#+-eKiTH)0$I#%*1pl[LI_LL oDNRO0/ROa $ MNt Bp,-*R_SSIA]I iaLU!g|e IE EOT GTUlTeSeUpj~qlq<6DAQEIAL [NsZrM= d`niec ere Y43sTOREd3#< nBYQEOim REMlrse WrC(3X#: vazu@ztGQ\XBIC$'1Oer oC0 IIU tAB(!&pF(&TL FSsr@A\MftSOM0n0*=L6eSE7 YB=;^_setuoont% n(MUmhTU}Sftetag%5><+kts A SV EEA R{uRN-;7/ :&sO#AdMUmhlUU\b('fle b vtrloner' N8.&> 10'1N+ !euoWT1=N%!(p1I2