IMD 1.18: 14/11/2012 8:19:45 david: david's ti interp stuff  åååååååååååååååååååååååååå åååååååååååååååååååååååååå     2 DAVID22č36”¦2222 8 ASM9900.CODELER, 8? 9900.ERRORSÖ \/ņy”?B 9900.OPCODES \/8LBP G4.EQUS.TEXT \/“„Pb P4.CSP1.TEXT \/¤b‚ P4.CSP3.TEXT \/¤‚˜ P4.DECL1.TEXT\/¤˜¬P4.IF&JMP.TEXT/¤¬ŗP4.INTERP.TEXT/v¤ŗČP4.INTERPX.TEXTv¤ČäP4.LD&STR.TEXT/¤äī P4.MACRO.TEXT\/¤ī P4.PF&CMP.TEXT/v¤ . P4.PROC.TEXT \/¤.R P4.RSP1.TEXT \/“„Rd P4.RSP2.TEXT \/“„d‚ P4.SET.TEXTÖ \/“„‚¢ P4.TABL.TEXT \/“„¢ø P4.TASK.TEX Ė { †† ETLA INITIALISYMTBLDUPROCEND ASSEMBLEPRINTMES €€ € € € €€€€€€€€€€€Õ# TLA TLA TLA TLA TLA "ī^ļ^ļ]„ž4VERS>83§ø L‰ŪīĄ++P‹ŪīN(ˆļŠ^;€ī$/ˆļT \/¤øĢ PX.CSP2.TEXT \/¤Ģą PX.DECL2.TEXT\/“„ąä NOREALS.TEXT \/“„ä" REALPART.TEXT\/v¤"0 B4.ANX0.TEXT \/¤04 B4.BTMSG.TEXT\/“„48B4.CONCUR.TEXT/“„8FB4.CUTBACK.TEXT“„FTB4.SERIAL.TEXT/“„TZ B4.SYS.TEXTÖ \/“„ZlB4.TXINIT.TEXT/“„l„ BX.DISP.TEXT \/“„„” BX.DSEG.TEXT \/“„”¤ BX.ENTRY.TEXT\/“„¤¼ BX.EQUS.TEXT \/“„¼Ģ BX.FD800.TEXT\/¤Ģč BX.INTS.TEXT \/“„č BX.SIO.TEXTÖ \/“„ TBOOT.TEXTćÖ \/“„JT FILzINITIALIėц…¬×‚€Å††l×€$ƅ¬×‚€Å††l×€ ƅ¬×‚€ ņ†l×€%ƅ¬×‚€Å††l×€'ƅ¬×‚€Å††l×€9ƅ¬×‚€Å††l×€4ƅ¬×‚€Å††l×€?ƅ¬×‚€Å††l×€7ƅ¬×‚€"ņ†l×€8ƅ¬ ׂ€&ņ†l ×€>ƅ¬ ׂ€*ņ†l ×€&ƅ¬ ׂ€.ņ†l ×€1ƅ¬ ׂ€2ņ†l ×€2ƅ¬ ׂ€6ņ†l ×€Rƅ¬×‚€:ņ†l×€3ƅ¬×‚€>ņ†l×€*ƅ¬×‚€Bņ†l×€+ƅ¬×‚€Fņ†l×€5ƅ¬×‚€Jņ†l×€6ƅ¬×‚€Nņ†l×€#ƅ¬×‚€Rņ†l×€Lƅ¬×‚€Vņ†l×€:ƅ¬×‚€Zņ†l×€;ƅ¬ECOMM.TEXT\/(¦Td REMTALK.TEXT \/%„d~P4.INTERP.CODE/(¦~ B4.ANX0.CODE \/(¦“ SELECT.TEXTÖ \/8¦“× SYSMAC.TEXTÖ \/8¦×/ SYSDEF.TEXTÖ \/8¦/9 SYSDF2.TEXTÖ \/8¦9 DISPLA.TEXTÖ \/8¦· DSPTBL.TEXTÖ \/8¦·½ MEMSW.TEXTäÖ \/8¦½Ė DSPINT.TEXTÖ \/8¦ĖŠ TBOOT.CODEįÖ \/H¦ĖŠTBOOT.CODEįÖ \/H¦22222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222ׂ€^ņ†l×€)ƅ¬×‚€bņ†l×€"ƅ¬×‚€fņ†l×€=ƅ¬×‚€jņ†l×€Bƅ¬×‚€nņ†l×€<ƅ¬×‚€rņ†l×€,ƅ¬×‚€vņ†l×€-ƅ¬×‚€zņ†l×€.ƅ¬×‚€~ņ†l×€/ƅ¬€ ׂ€‚ņ†l€ ×€0Ė,†…¬€!ׂ€†Å††l€!×ƅ¬€"ׂ€ŠÅ††l€"×ƅ¬€#ׂ€ŽÅ††l€#×ƅ¬€$ׂ€’ņ†l€$×ƅ¬€%ׂ€–ņ†l€%×ƅ¬€&ׂ€šÅ††l€&×€Cƅ¬€'ׂ€žÅ††l€'×€Dƅ¬€(ׂ€¢Å††l€(×€Eƅ¬€)ׂ€¦Å††l€)×€Fƅ¬€*ׂ€Ŗņ†l€*×€Gƅ¬€+ׂ€®Å††l€+×€Hƅ¬€,ׂ€²Å††l€,×€Iƅ¬€-ׂ€¶Å††l€-×€Jƅ222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222²Üää²ÜAVID C£¬€.ׂ€ŗņ†l€.×€@ƅ¬€/ׂ€¾Å††l€/×€AĖ;h`§°„A–Ž €¤ ¦­(²Ō†ƒĻ­×˜Ä­ķ¦Šéļļ­W|±jˆWtd­WÅi„H¦d­§€ Ņ­ī¦Šš­³Ō­Ō !!¢d­§¢iŠ!d­§¢i­ī¦ŠÜ!€”i†ƒĻ!×x„…Hå0˜±”Ō0d¹Ō„HŠ0|„Šä…HŌš‚€Āt šdt štŠF†u0dÅ"Ō0ē­W|qÄ­W}qk0ē#Ċ0ē­W}Ä0ē­W|Ä0ē†ƒĻ!×xƃĻ!×0ĈWtˆWt­W§° Õ’ˆWv„> „€&„‚›„&„?„„‚œ„(„€(„„+„)†‚Ŗ p– š¢„z„€£¬P`„-įv`¤)„)„z˜€Pw„)­˜€ w„)˜vpŅ&¤€„­¤)„)„z˜€Pw„)­˜€ w„)ėP`vŠ¤€„`v–€¤I‚€Ī 02DAVID22Š36”¦2222 8 ASM9900.CODELER, 8? 9900.ERRORSÖ \/ņy”?B 9900.OPCODES \/8LBP G4.EQUS.TEXT \/“„Pb P4.CSP1.TEXT \/¤b‚ P4.CSP3.TEXT \/¤‚˜ P4.DECL1.TEXT\/¤˜¬P4.IF&JMP.TEXT/¤¬ŗP4.INTERP.TEXT/v¤ŗČP4.INTERPX.TEXTv¤ČäP4.LD&STR.TEXT/¤äī P4.MACRO.TEXT\/¤ī P4.PF&CMP.TEXT/v¤ . P4.PROC.TEXT \/¤.R P4.RSP1.TEXT \/“„Rd P4.RSP2.TEXT \/“„d‚ P4.SET.TEXTÖ \/“„‚¢ P4.TABL.TEXT \/“„¢ø P4.TASK.TEXŌC‚€ĻŌ9‚€ŃŌ/‚€ÓŌ%‚€ÕŌ‚€ŲŌ‚€ŪŌ ‚€ŽėP–Ī†Ÿ‚€ßėˆ.h`‚€ēw`‚€ź w`ėPˆ.ˆ.§Ņ"š‚€ļt š‚€ņt štpŠ ˆWˆ.˜v†{h`‚w`‚ w`ė†{–Ī µ„W„ƒv†ł€fp†‚,†łÅ3š‚t pš‚ t pš‚t pštp¤‰j"‡‰²Ō †ˆ¬"€ Č"ķjŠķ†ˆ·†ˆ¬Å „†ˆœ‚Å„4„„ į„„#„›.§Ņ †‡›&ėŠ †‡›.ė†“†‡ė„ „Cš‚ t pšd€Pt pšt pd§Ņ d§šŅpd‚:čd‚?č d‚Dč „Gd‚FčŸÕ™…Gd‚Gč d‚Lč d‚Qč d‚SčT \/¤øĢ PX.CSP2.TEXT \/¤Ģą PX.DECL2.TEXT\/“„ąä NOREALS.TEXT \/“„ä" REALPART.TEXT\/v¤"0 B4.ANX0.TEXT \/¤04 B4.BTMSG.TEXT\/“„48B4.CONCUR.TEXT/“„8FB4.CUTBACK.TEXT“„FTB4.SERIAL.TEXT/“„TZ B4.SYS.TEXTÖ \/“„ZlB4.TXINIT.TEXT/“„l„ BX.DISP.TEXT \/“„„” BX.DSEG.TEXT \/“„”¤ BX.ENTRY.TEXT\/“„¤¼ BX.EQUS.TEXT \/“„¼Ģ BX.FD800.TEXT\/¤Ģč BX.INTS.TEXT \/“„č BX.SIO.TEXTÖ \/“„ TBOOT.TEXTćÖ \/“„JT FIL2ECOMM.TEXT\/(¦Td REMTALK.TEXT \/%„d~P4.INTERP.CODE/(¦~ B4.ANX0.CODE \/(¦“ SELECT.TEXTÖ \/8¦“× SYSMAC.TEXTÖ \/8¦×/ SYSDEF.TEXTÖ \/8¦/9 SYSDF2.TEXTÖ \/8¦9 DISPLA.TEXTÖ \/8¦· DSPTBL.TEXTÖ \/8¦·½ MEMSW.TEXTäÖ \/8¦½Ė DSPINT.TEXTÖ \/8¦ĖŠ TBOOT.CODEįÖ \/H¦ĖŠTBOOT.CODEįÖ \/H¦222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222      d‚Wč d‚[č Ō †Nd˜vpŠY‚]d˜wŅ'†N¤‰„‰d˜€Pw„‰‚`€Xw„‰˜vpŠ%†N¤‰„‰d˜€Pw„‰‚e€Sw„‰˜vpp°hq Õ’d‚gčŸ„ 9„C9Ō„Šį„„@„:„9„8„7„6„K„B€7„¤‰j"‡‰²Ō štp"ķjŠķ„‚_„‚a˜„‚d€&„‚c„‚b†‚w†‚_Å„‚`„<„D„;„=„I„E„„„„į„†ˆĆ‚hÅ„!†Š¤‰„‰‚lw„‰‚ow„‰‚vw„‰ėP9ŌU†N‚|t p†N…!tp†N‚€t p†N†“˜t p†N‚„t p†N†Š˜t p†Ntp†Ntp†Ntp…!ķ„!†„x†Ÿ˜v„q†uq„‚„Wv–µALIGN ASCII BLOCK BYTE CONST a$…5£q&ķnŠ×–—…C…G”ńštpq†„xvpˆX†Ÿ˜vp…4Ōq †‚w†‚_Ő…0ļ…2£īq…2ļ…5…4¢„3…2ļ†ˆĖ…#×…0£ķą"…3¢…0£„"†ƒĻ†ƒOŀ€†ˆĀu–M…C…G”ńštp1€BŅ€Eq`u „M†ƒO†ƒĻŀ€j¦­"²Ō`u­ķ¦Šģ…M’p„5„3„2„„1„4„"†ˆĖpš…Mį” Ņ€6qqqqji!"²Ō € q !ķiŠņqqqqq–:`p`פ‡ćē…"Ä„!€€€ p„!׆ˆĒÅ„€‘׆ˆĒÅ„aפ‡Ź‡Ź‡ …KŹ„€×¤‡Ź‡Ź‡ Ź„€Ł‚€zėM¤…AÓE`×`×xqÄ`×ē`×yqĄa× EQU FUNC PUBLIC PRIVATE PROC WORD INTERP MACRO ENDM IF ENDC ELSE REF DEF ORG INCLUDE LIST NOLIST ASECT PSECT TITLE END PAGE MACROLISNOMACROLPATCHLISNOPATCHLABSOLUTEOR AND NOT XOR MOD CONDLISTNOCONDLIASCIILISNOASCIILPAGEHEIGNARROWPANOSYMTABRADIX RELPROC RELFUNC opcode declared twice==*#4:#5:#9:#10::#11::#12::*LINKER.INFO[*]99000.OPCODESS99000.OPCODES not on any volumee99000.ERRORS99000 Assembler IV.0 „a×xqĄ€×„€×xqćq¤š`” pŅ€6q–a Œ„X„„v„0„\įv…#²ńŠ 1€B°Õø…#¤Œk#‡Œ³Ō†ˆĖ#×xq#īkŠė…#q…2£īq…2…2£„"…4’¢kš…M#6” #³ń€6q6#¢„‡Xp‡X‚€€Å‡X„Xv„0†Ÿ˜v…Œ’¢k#¤Œl$‡Œ²ŌWpŅ„0…Mį” Ņ$#Ņ…Œj"²ń …M"’"£ppŅš…M6” ³ń€6q6ķ„$ķlŠ¢pŅ „0vq…C…Gå”ŌX†Ntp†N‚€„t p†N… tp†N‚€Žt p†Ntp†N…tp†N‚€’t p†Ntp†N ” p†Nvpštpš‚€¤t pš… tpš‚€®t pštpš[a.3]]0123456789ABCDEF2Output file for assembled listing: ( for none))CONSOLE::console::#1:PRINTER::printer::#6:REMOUT:remout:#8:.TEXT.TEXT[*]][*] 99000 Assembler IV.0 [a.3]]Page -  File: Éż' k i…tpš‚€²t pštp‹C†ˆĀu…#ķ„#…# ²ń €Fqp†‚“p„/†‚Œp„.†‚…p„-†‚~p„,…„…#²ń„Xvp†„x†Ÿ˜vp†„x…vp† u:ē˜Ä˜„‚š…3„0qįq„„„1€>Ņ„‚›Š€#„‚›q1€QÓqŠL0}…‚›Ó qŠ@…#Ņ†ˆĒ0ņˆĆ0Å0ē…#Ä0ē…JÄq1Ņq1€PÓqŠ0ē…ÄqŠ0ēąC…G”ńštpš†ˆĆt pq†ˆ·†ˆ¬Å „1€(Ó q1€(ÓqŠ÷q †‚,†łÅ3į„€&„‚›„Xv„0v–Œ>>>>>>>>>>#ķ’Å’Õ’Ķ’Ż’å’õ’#µ’SYMTBLDU9wcg«i­h jc"xŗń$"y˜Ņ"ēui"yē˜Ä"yē˜Ä"y0Ċ"yhŠ""z˜Ņ"ēui"zē˜Ä"zē˜Ä"z0Ċ"zh!Ō¬– { z˜Ó zļ x„†N0t p0}Šnˆ ‚€ėPŠfˆ ‚€ėPŠ[ˆ ‚€ėPŠPˆ ‚€ ėPŠEˆ ‚€ėPŠ:ˆ ‚€ėPŠ/ˆ ‚€ėPŠ$ˆ ‚€ėPŠˆ ‚€ėPŠˆ ‚€ėPŠր †Nˆ ˜t p0}ƒ€IŚŌ0~q Š †Nˆ˜t p­ķ¦­­°…Gå”­­°…G” Ō†Ntp…ķ„……Ņq Š †N‚€Lt p y˜Ó yļ–p_`u† u0‚€NÅeu%0Ä%ē˜Ä%ē˜Ä€¤_l$‡_²Ō%†ƒĻ$×x„0˜Ó0}Š0˜ŠրR0|„Šé$ķlŠÕ„6†ŠėP†Š‚€{ėPq †N‚€‚t p†Ntp†N‚€¢*’*’*’*’š’µ’&Ōž‡žŌžŌžŌžŌžŌžŌž‡ž IV.0 [a.3]] Assembly complete:: liness" errors flagged on this assemblyyAssembly complete:: liness" errors flagged on this assemblyy©Nę ¬ų “  t p†Ntp†N‚€Įt p†Ntp†Ntp†Ntp…¢„kŅ f‚€Ųė jiŅ f‚€Üė ji…6Ō"i%y†Š„6ėP†Ntp…ķ„q `u–_ AB  LB  PR  FC  PB  PV  RF  DF  UD  MC '„’ē’»’Ę’Ń’Ü’°’’š’ē’ņ’4| '÷’÷’÷’÷’÷’÷’÷’÷’÷’÷’÷’÷’ Symbol Table>AB - Absolute LB - Label UD - Undefined MC - Macroo=RF Ref DF - Def PR - Proc FC - Func,PB - Public… ASSEMBLE{ ¢,q1€OŅ9c†§ėPq1°h ń1Ó€Bqq1€OŅ†§cči !°¤-Š€.q¤-qŠH„<šŌ<…‚xŌqŠ03įŅ<±¤-Š$ Ą$Ś!³Ÿ”Ō c!8Č!ķiqŠę„?c‚€*¹Ō…ķ„Š.c‚€.¹ŌqŠc‚€2¹Ō…³ń q pŠ…ī„ …ķ°c‚€6¹”j"ÕY’–Ó$˜Ó]$|i${…5£h$ē$y#¢Äå$É”Ō$ē$yÄ ³ ’³Ÿ”Ō$ qŠ…„xą„xē$ņ„xtp…ķ„$ē…‚šÄ$„‚š!lŠŸ–—˜i1€MŅW0i„I0„„O0ē…ą‚°!˜±”Ōq0}Ņ0ē€"Ċ*0}€&Ņ…‚Ņ0ē€$Ä0ē…Ċ0ē€%Ċ q„I˜iŠL„I…‚Ņ€,qŠ=†‚¼…*×~€&Ó qŠ,†‚¼…*×ē€%Ƃ¼…*×ē…Ƃ¼…*×}i†‚¼…*×ē˜Ä1€MŅqq1€4Ó!…ļ–īļŌJžļŌ><²ń…<iŠi!²ń+Śń qŠ0}…‚›±1€!±”Ō q0ē€'ĆLu0ē…LÄq8 Ņś„?…L…:Č„ha‚€DÅ„;4 ²ń†Lu„q5€e²ńq…L48Č8 Ņq qŠ8€.Ņ ha‚€HÅŠ ³ńa 8Č ķh4ķ„a‚€L¹ ²Ÿ”Ō€"qa‚€P¹Ōœ†‚Œ†‚“–Ē…Ó ˆX…vp€ih !²Õš†ƒĻ ×x„0˜±Õ…0}‹v9Ō †Ntp†N‚€t p†N0t p…ķ„…G9”ńštpš‚€t pš0t pq‹,®Xp0}Š8®XēĊ3®XēĊ+®XēĊ#®XēĊ®XēĊ®Xē Ċ ®Xē Ċր®X0Å0}‹Ó0ę 0Ņh®XēÄ®Xē0ęÄ®Xē0Ä®Xš¦0ę ˜Ó0®X®×0ę xÄ®ķ¦®Ņ®Xš®Xp¦0ē 0ę yĊŹ®Ó®Xš0ēÄ0ē ˜ÄŠf®XēÄ®Xē…#Ä®Xē0~Ä®XšŠK0}Ņ®Xē Ċ®Xē Ä®Xē0Ä®Xē0~Ä®Xē0ęÄ®Xš®XēÄ®Xē0Ä®XēÄ®XšŠր-ŠրR0|„‹už ķh‹`ž– ……Ó ˆX…vp…ķ…on&'²Ō$ˆXtp®XxŅa®XēÅ$š     ^’y’~’½’ų’€>’‡ū~Ąļ’ö’ö’‚8ī’ó’ų’ó’ų’€õ’ā’ā’‡’’»’Ļ’ę’L’^’s’°’’’Qø’ø’ø’ø’ø’³’®’’³’å’Ä’ø’®’®’®’®’®’®’&Ā’ē’Ā’Ā’Ā’Ā’Ā’Ā’Ō’ļ’ļ’ļ’ļ’ļ’Ü’ē’Ā’Ü’Ō’Q1’{’{’’—’:’:’¹’ē:ą‚š˜Ó…‚š„ …‚š|„‚šŠ† uŠր[ŠqŠրƒ†‚w†‚_Åa"q –x #;€$±”ŌqmŠ)"Ÿ{A2ōø…XœN#`łĪl8Ź Słŗ¤ 9­ Ō¦1 Ņ p®ŌqŠ0 Ō Š)­ƒ€šŚŌ­ŠļŠ ļŠ1ļŠրœ Š¦i–å (i'haŲÉk`ŲÉj#Ō]"Ō! £³ńn!mŠn! £mŠC!@£@£i! @ ¢@ ¢n! @ ¢@ ¢m%ldŲÉ% ³ Ō &ķn% £m%lŠéŠ"Ōn!mŠ! n! m)Š &¤ Š%¤ Šր”– M­z­ ­y­x ­­ ” ­­ ­°” ­ƒ€„Ś­  å ­ƒ€§Śå­±­ ­ ­{± ­y ­x ” Ōļ­h x y ń5­­ ­ ~³ Ō( ē­Ä ~Š ē­Ä ~Ņ ē­Ċ ē­Ċր© ē y­ Ä x­ Ä­‹±­ ŌļŠ ē­åċ¢ ē |­¢Ä ē {­¢Ä‹ ē |­£Ä ē {­£ÄŠy ē |­ ÄŠn ē |­”Ċc ē |­å” |å­” ÄŠP ē |­DPRINTMES=rj`„-v`†{˜vpŅB`‡kvp`tp9Ō†N‚€t p†N ˜t p…G9”ńš‚€t pš ˜t p`v–k: : ŒÄŠE­ŅļŠ ē |­ÄŠ1­ŅļŠ ē |­"Ċ­ŅļŠ ē |­"Ċր®¦ –ī¤ ¤ ¤ €S¤1¤*åŌ‹~¤ 1Š`‡°* ŌŠ‹iŠR¤ ŠM¤ ŠH(ŌŠ¤ Š<(Ō‡°€$€*±”Ō¤ Š¤ Š*¤ Š¤ (Ō„” p–k…GŌ†Ntp†NtpŠ †N ” p†N‚€6t p†N…!tp†N‚€:t p†N"q–M0~hšŌ7`ɳń…‚z£„‚z šŠ€€į€šŌ`<Ź†‚w†‚_Å qŠ q––0~i`cbļ(†‚q†‚wÅa Źa#Źcļ'a#Ź†‚w†‚_Å!qaÉŅ †‚w†‚qÅ"q–Ž0~j`dcļ(†‚q†‚wÅb Źb$Źaļ%b!Ź†‚w†‚_Å"qbÉŅ †‚w†‚qÅ#q– 0~ibļ'a"Ź1Ņ `ļ%a ŹŠ€Qq†‚w†‚_Å!q–N0~i`cbļ(†‚q†‚wÅa Źa#Ź†‚w†‚_Å!qaÉŅ †‚w†‚qÅ"q–e0~h†‚w†‚_Å qq–Ć0~h €²Ōbļ'`"Ź†‚w†‚_Å qaļ$„Š 1€AŅ€?„…K…J”„K pŠ4…CŌq pŠ'Š#ŠŠ…³ńqŠ…ī„qŠ#ŠցŸ3įÓį„q1€(Ó q1€(ÓqŠ÷ ƒĢŚŌ†‚,†łÅ3į„Šq „IÕWž– ’ž’’IF ENDC END ELSE ENDC ’ž’’IF END ENDC ENDC  END ENDM 59š’÷’ć’é’Ż’&Ķ’Ń’Ķ’Ķ’Ķ’Ń’€!„‚›Š „‚›ŠրTq1€QÓqŠ:0}…‚›Ó qŠ.…‚›€ Ņ%0hq1Ņq1€PŅ ē…ĊqqŠ ēĊq1Ó¶€&„‚›–~q1€OŅ †Š†§ėPŠ€.qq–ń:ē…3Ä:ē…Ä:­Ź­Ō>Ō¦Š¦å”å” Ō:ē…3ķÄ:ē:zķÄ:Ź…‚{€%Ņ :ē…‚z…£ÄŠ¦:Ź…‚{€%Ņ :ē­…£Ä–: Ō­Ō€Jq­¦­€€į³­€²”ŌŌˆˆÉŹŠ ˆˆÉŹŠq–o ­Ō…‚{€%Ņ …‚z…£¦Š…‚z¦ļŠ…‚{€%Ņ­…£¦–: …”Ō€Kqj%i…‚w‹Ÿ…B兂{€$°”Ō €%„‚{Šq‹‡‹‚…‚xŌ6:ē†‚¼…‚y×}Ƃ¼…‚y×ē:ą‚š˜Ó…‚š„ …‚š|„‚šŠ† uŠŠC…‚|}Š0Š/:ē…‚|ą‚|     †N†ˆœ`ɧ” p†N†ˆœ`ɧ” p†N†ˆœ`ɧ” pŅB†N`Étp†N` Étp†N` Étp†N`Étp†N`Étp†N`Étp–z…4’²ńDš…M6” Ņ€6‘‘6ķ„6…1²ń6„1…M…MīŒp…4£„4…5¢„5…M…4!ȅ4ķ„4…5…4¢„3…3³ń‘p…3…2²ń…3„2ń…ķ„9…Eå”Ōv!hŅ02¢²Ō)†ˆ·2†ˆœ`ɧȆˆ·2ķ†ˆœ`ɧȆˆ·2¢€ Č2¢„Ņ<2¢²Ō5†ˆ·2`ɀ0¢Č†ˆ·2ķ`ɀ0¢Č†ˆ·2¢`ɀ0¢Č†ˆ·2¢€ Č2¢„–²b%ÅabÅń"‘j9Õ’# Ō`aÅŠ`bÅ$$Œ¢lŅb2¢²Ō[†ˆ·2€*p$³ń†ˆ·2†ˆœ` ɧȆˆ·2ķ†ˆœ`ɧČ$Ó†ˆ·2¢†ˆœ`ɧȆˆ·2¢+€N„…F8€:°”Ō‘„?– ”|€O„„D¤+a‚,ėP†§‚-ėPh‘‡+å €P³Ÿ”8 ±”ŌB8€"Ņ‘8€"Ó „?¤+€"„ ‡+ń&a8Ȇ§¤,„,†§˜€Pw„,a˜€ w„,ėP‘ ķhŠÆ„D8 Ņ€(„€)‘ €PŅ€*‘–|ļ1€(°„F€S„‘8€ Ņ‘„FŠō8 Ņ€(„‹8‹‹‹‹ „‹ „‹ż „‹÷ „‹ń„‹ė„‹å„‹ß „‹Ł „‹Ó„‹Ķ€(„‹Ę„‹Ą€$€$Ņ‘8€0³Ÿ8€9²Ÿ Ō„„?ŠŠ‘‹˜‹“‘8€/Ņ„Š„„?Š„Šz‘8€+Ņ„Š8€,Ņ„Š„„?Š\‘8€-Ņ„Š8Ņ„Š„„?Š?„Š:„Š5„Š0„Š+„Š&„Š!‘8€>Ņ„Š„„?Š „Š„Šց.1€SŅ ‘–.†„x†…¤v††ˆœ`ɧȆˆ·2¢€ Č2¢„Ņz2¢²Ōs†ˆ·2€*p$³ń'†ˆ·2`ɀ0¢Č†ˆ·2ķ` ɀ0¢Č†ˆ·2¢` ɀ0¢Č$Ó*†ˆ·2¢`ɀ0¢Č†ˆ·2¢`ɀ0¢Č†ˆ·2¢`ɀ0¢Č†ˆ·2¢€ Č2¢„#ńŌ…ķ„„Ebɑ bɑ „E–Ų:ē…3Ä:ē…Ä:Ź:Ź:ē­Ä¦– …B…‚{€$±”Ō5"xŅ#…„x ą„xē!ņ„xtp…ķ„!p"Ä!"x×…3Ä""xķĖ@ …”Ō€K‘i#h…‚w‹÷‹÷†,†‚~‹ģ…‚xŌ4:ē†‚¼…‚y×}Ƃ¼…‚y×ē:ą‚š˜Ó…‚š„ …‚š|„‚šŠ† u†,†‚~‹Ø…‚|}Š>†,†‚~Š7:ē…‚|ą‚|ē:ą‚š˜Ó…‚š„ …‚š|„‚šŠ† u†,†‚~ŠրFŠ_…‚{Ó.…‚|ę j"ē"ęķƂ}u…‚}…3£Ä…‚}ē"ę Ä„P†…|įv†N†zvs” …#²Ÿ…C”…7”Ō” ” 1€BŅ冄xv†„Pv†Nv–error error ( (continue), (terminate), E(ditt * location >>>>> $>>>>> $Page -   File: | | &æ’É’æ’æ’æ’É’!ó’é’é’ß’’ ’’X’”’·żdžp’  ’~@.Tõ’ł’ń’ķ’š’’xž"ž ’ž’’‡ž’’ž’’  ."ē …‚}ą‚{Š†/†‚“Š†.†‚ŒŠ †-†‚…ŠրnŠրu†‚w†‚_Å`!‘ – †‚,†łÅ3„…=Ō†„P††œ…&” „'Šš ††œ…&” „'„(…&…'¢„&…'Ņ?…=Ō/…%„&…$„(š ††œ…&£” „'„=†„Pv†“†‡ėŠ €$‘p"p‘€f ††œ…(p„††œp„5€f³ń††œ…(†‚,5pŠ ††œ…(†‚,€fp–[ j…L#xķ§„ ##x¢Ä8€1³Ÿ8€9²Ÿ Ō‘‹(8€1£i†‚¤…ī×xh…²ŸÕ€†‚ž…ī×x„L!±…L § ±”"…L §€;°”å”Ō1"Ō …L §€"±jŠ…L §€"°…L ķ§€"±”j…L §€,°"”Ō!īi ķhŠø€f€ …L pi !¢h…L §„ 8 °8€;° Ō †‚ž…×x„LŠg!±††œ § ±”"††œ §€;°”å”Ō5"Ō ††œ §€"±jŠ††œ §€"°††œ ķ§€TEXT ’ž’’‡ž’’ž’’!į’ö’č’ļ’'Ž’ģ’’’’’å’ģ’–’ ’ !~’h’÷ž@’Ś’Š’żž'’Õ’†’’¤’ņžm’čžčžčžčžčžčžčžčžčžčžĮ’3’ß’ų’ó’’:’ķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķž’!’Ė’ķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķžķž ’Ę’-’’ € Š š[‡"n[· S 0‘æ>Ķ8ąĘ„@2×ŖYś EXTRAIO STRINGOPFILEOPS HEAPOPS PASCALIOCOMMANDI "±”j††œ §€,°"”Ō!īi ķhŠ²€f€ ††œ pi !¢h††œ §„ 8 ±8€;±”8€,±”Ō„‚œ†‚°…×#xąī„ „„?‘–±…‚œ‹F…?Ō 4ķ„5ķ„Š„?…L4§Ņ,…L4ķ§„ 8€ £°„F5€e³ń†‚,5Ȇ‚,5ķ8Č5¢„4¢„…L4§„ 8€%°…D”Ō …„†ŠM8€ °…D”Ō,€f€ …L4ph5 ¢€f³ń†‚,5 € p5 ¢ī„4 ¢ī„Š8 Ó5€f³ń†‚,58Č8 Ņ€ „ ‹œ…?Ō …ķ„5ķ„Š„?…²ń …L…§„ Š††œ…§„ 8€%°…²Ÿ”…D”Ō†‹Ź8 °…D8€;°8€,° ” ŌZ…ķ„…²ń€Fį€ …L…īphŠ€Fį€ ††œ…īph5 ¢„†‚ž…×x„L……Ņ„‚œŠ †‚°…×x„„?‘Š^8€ °…D”ŌA5€f³ń†‚,5€ Č5ķ„…ķ„…²ń …L…§„ Š††œ…§„ 8€ ÓĪ€ „ … omma expecteddgnedgned.ASECT.ASECTocnee'undefined labelgnedgned.ASECT.ASECTocnee'operand out of rangened.ASECT.ASECTocnee'must have procedure nameASECT.ASECTocnee'number of parameters expected.ASECTocnee'extra symbols on source lined.ASECTocnee'input line over 80 characters.ASECTocnee'(unmatched conditional assembly directive'&must be declared in .ASECT before usedve'identifier previously declaredore usedve'improper formatiously declaredore usedve'illegal character in textlaredore usedve'&must .Eī„5ī„Š5€f³ń†‚,58Č8 Ņ€ „ ‹…?Ō…(ķ„(Š„?…(=³Ō‘††œ…(§„ 8Ņ…;ń††œ…(ķ§€ °„F…(¢„(††œ…(§„ 8€ Ņ…D…;å”Ō…(€f€ ††œ…(p¢ī„(Š(8€;Ņ…DŌ…(€f ††œ…(p¢„( „ Š8 Ņ€ „ Šր|–/§„-‚€ėPc‚€‚ėP8ƒ€ƒŚŌ68€A³Ō „-8€7£ČŠ„-8€0£Čc¤W„Wc˜€Pw„W„-˜€ w„WėP‘ŠĄcwc§±c§° Ōī8ƒ€ˆŚŌ8ŠjŠjŠ jŠjŠրŽŠ…j„?€P„„-Č„"‹Ūc§²ń‘ŠGc§³ńc¤W„W„-˜€Pw„Wc˜€ w„WėPŠŻ„V c§Ź„Vc§Ź„Vc§Ź„Vc§Ź‡V„‹ˆc§²ń‘‹€c§³ńc¤W„W„-˜€Pw„Wc˜€ w„WėPŠŻh¤Wi!‡W²Ōc!§ ²ń ‘pŠ Œc!§¢h!ķiQU before use if not to a labelve'macro identifier expectedot to a labelve'code file too largepectedot to a labelve'backwards .ORG not allowedt to a labelve'identifier expectedallowedt to a labelve'constant expectededallowedt to a labelve'invalid structureedallowedt to a labelve'extra special symbolllowedt to a labelve'branch too farsymbolllowedt to a labelve'$LC-relative to externals not allowedelve'illegal macro parameter indexallowedelve'illegal macro parameter indexallowedelve'operand not absŠÜc§ ²ń‘p ™²Ÿ ™°c§²Ÿ” Ō‘Š Œc§¢„‹ųc§²Ÿc§²Ÿc§°” Ō‘Švc§³ńc¤W„W„-˜€Pw„Wc˜€ w„WėPŠŻ¤Wi!‡W²Ōc!§²ń‘p!ķiŠę„Vc§Ź„V c§Ź„V c§Ź„Vc§Ź„Vc§Ź„Vc§Ź‡V„Šfc§²ń‘ŠUc§³ńc¤W„W„-˜€Pw„Wc˜€ w„WėPŠŻ¤Wi!‡W²Ō#c!§²ń € ‘pŠ „V!£Ųc!§Ź!ķiŠ×‡V„Šր·–€§ؑa‚€ČÅh8ƒ€ĢŚŌ& ³Ÿ8€_±”Ō8ƒ€ŌŚŌ8€ £„ a 8Č ķh‘ŠŠ Ņ€-‘įh„H…Hå €/³Ÿ”Ō ķh†…¬ ×a¹„HŠć…Hń€!‘Š ††l ×x„„?1€R°ÕŒ…Ņ€"‘Š…ī„‘…²ń#†‚ž…×x„L†‚¤…×x„…L4§ Ó4ķ„ŠóŠ„‚œ††œ…(§ Óoluteter indexallowedelve'illegal use of special symbolsllowedelve'ill-formed expressionl symbolsllowedelve'not enough operandsonl symbolsllowedelve'&LC-relative to absolutes unrelocatableve'constant overflowsolutes unrelocatableve'illegal decimal constant unrelocatableve'illegal octal constantnt unrelocatableve'illegal binary constantt unrelocatableve'invalid key wordonstantt unrelocatableve'$unmatched macro definition directiveleve'include files may not be nestedctiveleve'unexpected end of input…(ķ„(Šš‘1€(Ņł†‚,†łÅ3į„‘…C9å”…>°”Ō „ …GŌšt>…²ń…„‘‹Ź1€L°Õƅ=Ō€#‘‹ø…‚œÓ€%‘‹«„=„/‚€ÜėPe‚€ŻėP‘8€ ±8 ±”Ō„/8Če¤X„Xe˜€Pw„X„/˜€ w„XėP8 Ņх&„%…(„$†„Pe˜vpÓ †„P¤X„Xe˜€Pw„X‚€Ž€Uw„X˜v‘†“eė„&„(€(„…G9”ńštpš†‚,€f€ft p‘–€Øūc‚€įÅh8ƒ€åŚŌ& ³Ÿ8€_±”Ō8ƒ€ķŚŌ8€ £„ c 8Č ķh‘ŠŠj„H ²ń īh Ō ""¢c §¢jŠ"c §¢jŠć"€”j†ƒĻ"×x„…Hå0˜±”Ō0c¹Ō„HŠ0|„Šä…HåՓ…‚›Šg†uŠc…‚›Š† uŠ† uŠ† uŠ † uŠրõ0o'ēÄ'ēÄ'ēÄ'ē ˜Ä'ē 0Ċ"† uŠ† uŠ†ue nestedctiveleve'.INCLUDE not allowed in macrosdctiveleve'label expectedllowed in macrosdctiveleve'expected local label in macrosdctiveleve'local label stack overflowcrosdctiveleve''string constants must be on single linee'%string constant exceeds 80 charactersnee'!cannot handle this relocate counttersnee'no local labels in .ASECTte counttersnee'expected key wordn .ASECTte counttersnee'string expectedrdn .ASECTte counttersnee'#I/O - bad block, parity error (CRC)rsnee'I/O - illegal unit numberrror (0ēÄ0ē˜ÄŠրū0o'cÅ'ē…‚›Ä'ē†ƒĻ"×xƃĻ"×0ċž0}€'°Õ–…Ņ€"‘‹Š…‚œŅ‘Š…‚›€'Ņ ‘Šs…²ń †‚¤…×4Ċ †‚¤…×…(Ä8 Ó‘Šų‘ „‚œ†‚Ŗ…×…)ą+„)…ķ„†‚ž…×0~Ä0~„L>…īŅ…L§Ō…„Š „ …GŌ‘„€(„‘p…FŌ 8€:Ņ‘€M„Š0}³0}²”Ō€!„Š€Q„„?– d‚$Åi…k…‚œ°h Ō†‚Ŗ#×x„*#ķ…Ņ…)jŠ †‚Ŗ#ķ×xjŠ…)„*…+j8ƒ(ŚŌ!³ńd!8Č!ķi‘Šę!Ņ€'‘„H…Hå…*"³Ÿ”Ō†‚¼…*×d¹Ō„HŠ…*ķ„*ŠŪ…Hńv…+Ņ €(‘pŠf Ō@†‚¼…*׆‚¼…*ķ×…+…*£Œp…)ķ„)#ķ…ī¤ i!(²Ō†‚Ŗ!׆‚Ŗ!×xķÄ!ķiŠē†‚¼…*פ (dÅ(ē€&Ä(ēÄ(ē˜Ä…+ķ„      ;  ; ;  ;****************************************************************************   ;==========================================================================  ; Interpreter Global Equates  ;==========================================================================   ; Register Equates. R0-R7 are useable. At entry to most p-code routines  ; R1 contains p-code (doubled). erands allowed in .ASECT.ASECTocnee'offset not word-aligned.ASECT.ASECTocnee'LC not word-alignedgned.ASECT.ASECTocnee'illegal immediate operandSECT.ASECTocnee'index must be WRe operandSECT.ASECTocnee'close paren ')' expecteddSECT.ASECTocnee'indirect & autoincr must be WRASECTocnee'autoincr must be WR indirectWRASECTocnee'comma ',' expectedR indirectWRASECTocnee'no operand allowedR indirectWRASECTocnee'illegal map fileedR indirectWRASECTocnee' WR expected fileedR indirectWRASECTocnee' ; R5, R4, and R3 contain any static p-code operands.   IPC .EQU R8 ; p-code program counter  MP .EQU R9 ; points to current act. record  SP .EQU R10 ; top of execution stack  BK .EQU R12 ; location of i-fetch loop  MAP .EQU R13 ; pointer to current map file  BASE .EQU R14 ; points to act. record of lex level 0  ADRSP .EQU R15 ; current address space   ;  ;**XOP , TB SZCB PSZC @SWPB ĄSTWP   STST Ą STCR 4SRL SRC SRA SOCB šSOC ąSLA SETO SBZ SBO RSET `ORI ` MOVB ŠMOV ĄLWPI ą LREX ąLMF  LIMI  LI  XOR (CZC $COC CI € CB C €X €RTWP €R0 R1 R2 R3 R4 R6 R7 R8 ******** RECORD TYPES AND VARIABLES **********  ;  ; SEGMENT INFORMATION BLOCK  ;  SEGPOOL .EQU 0 ; POINTS TO POOLD CONTAINING SEGMENT  SEGBASE .EQU 2 ; ADDRESS OF START OF SEGMENT  SEGXXX .EQU 4 ; COUNT OF OUTSTANDING EXTERNAL CALLS  SEGACT .EQU 6 ; SEGMENT ACTIVITY INDICATOR  SEGLINK .EQU 8 ; COUNT OF LINKS TO SIB  SEGRES .EQU 10 ; SEGMENT RESIDENCY STATUS R9 R10 R11 R12 R13 R14 R15 A  AB °ABS @AI  DEC DECT @INC €INCT ĄMPY 8 NEG S `SB pBLWP BL €B @R5 DIV < JEQ JHE JGT JH JL JLE JLT JMP JNC JNE JNO JOP JOC ANDI @ CKOF ĄCKON  CLR ĄIDLE @INV  SEGNAME .EQU 12 ; SEGMENT NAME (8 CHARACTERS)  SEGLEN .EQU 20 ; LENGTH OF SEGMENT IN WORDS  SEGADDR .EQU 22 ; DISK BLOCK WHERE CODE RESIDES  SEGUNIT .EQU 24 ; UNIT NUMBER OF DISK  SEGDATA .EQU 26 ; DATA SIZE OF SEGMENT IN WORDS  SEGPREV .EQU 28 ; NEXT SEGMENT IN CODE POOL LIST  SEGNEXT .EQU 30 ; PREVIOUS SEGMENT IN CODE POOL LIST  SEGTEMP .EQU 32 ; TEMPORARY  SEGMTYPE .EQU 34  @LDCR 0LDD ĄLDS €NOP  ; MACHINE TYPE  ;  SIBSZ .EQU 36 ; SIZE OF SIB IN BYTES  ;  ; ENVIRONMENT RECORD  ;  ENVDATA .EQU 0 ; POINTER TO GLOBAL DATA SEGMENT  ENVEVEC .EQU 2 ; ENVIRONMENT VECTOR POINTER  ENVSIB .EQU 4 ; SIB POINTER  ENVLINK .EQU 6 ; LINK COUNT  ENVLIST .EQU 8 ; NEXT EREC POINTER  ;  ERECSZ .EQU 10  ;  ; TASK INFORMATION BLOCK  ;  TIBLNK .EQU 0 ; QUEUE LINK FIELD O^£#„r TIBPRI .EQU 2 ; TASK PRIORITY  TIBSPLW .EQU 4 ; LOWER STACK LIMIT  TIBSPHI .EQU 6 ; UPPER STACK LIMIT  TIBSP .EQU 8 ; CURRENT STACK POINTER  TIBMP .EQU 10 ; CURRENT STACK FRAME POINTER  TIBBP .EQU 12 ; PRESENTLY UNUSED  TIBIPC .EQU 14 ; INTERPRETER PROGRAM COUNTER  TIBEREC .EQU 16 ; CURRENT EREC POINTER  TIBIOR .EQU 18 ; CURRENT IORESULT  TIBPROC .EQU 1€ˆCRC)rsnee'I/O - illegal operation on unitCRC)rsnee'I/O - undefined hardware errortCRC)rsnee'I/O - unit no longer on-lineortCRC)rsnee'!I/O - file no longer in directoryC)rsnee'I/O - illegal file name directoryC)rsnee'I/O - no room on diskme directoryC)rsnee'I/O - no such unit on-linerectoryC)rsnee'I/O - no such file on volumectoryC)rsnee'I/O - duplicate filen volumectoryC)rsnee'!I/O - attempted open of open fileC)rsnee'%I/O - attempted access of closed filenee'#I/O - bad format in real or integerlene .TITLE "Global Definitions"  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. e'I/O - ring buffer overflowr integerlenee'#I/O - write to write-protected disklenee'I/O - illegal block numbercted disklenee'I/O - illegal buffer addressed disklenee'$nested macro definitions not allowedenee'`=' or `<>` expectedions not allowedenee'"may not equate to undefined labelsedenee'%.ABSOLUTE must appear before 1st procnee'.PROC or .FUNC expectedefore 1st procnee'too many proceduresctedefore 1st procnee'#only absolute expressions in .ASECTocnee'must be label expressions in .ASECTocnee'no op     9 ; CURRENT PROCEDURE NUMBER  TIBHANG .EQU 20 ; SEMAPHORE THAT THE TASK WAITS ON  TIBXXZ .EQU 22 ; NOT USED  ;  ; SEMAPHORE  ;  SEMCNT .EQU 0 ; NUMBER OF OUTSTANDING SIGNALS  SEMWTQ .EQU 2 ; QUEUE OF WAITING TASKS  ;  ;  ; MARK STACK CONTROL WORD  ;  MSSTAT .EQU 0 ; STATIC LINK:PTS TO LEX PARENT'S STATIC LINK WORD  MSDYN .EQU 2 ; DYNAMIC LINK:PTS TO CALLER'S STATIC LINK WORD  ;  ;****************************************************************************   ;  ;********** STANDARD PROCEDURES **********  ;  ;  IOC ; IO CHECK *MOV IORESULT,R1 ; IF IORESULT <> 0 *JNE $1 ; THEN (*SYSTEM ERROR*) TRAP(UIOERR) *B *BK ; ELSE ALL OKAY, SO CONTINUE  $1 TRAP UIOERR ; TRAP(UIOERR)  ;  ;  MSIPC .EQU 4 ; " " " OF NEXT OPCODE IN CALLER  MSENV .EQU 6 ; SEGMENT NUMBER OF CALLER  MSPROC .EQU 8 ; PROC. # OF CALLER  ;  MSCWSZ .EQU 10  MSDLTA .EQU 8 ; MSCW OFFSET VALUE  MSDLTAP2 .EQU -10 ; -(MSDLTA PLUS 2) = -(SIZE OF MSCW IN BYTES)  ;  ; SEGMENT DICTIONARY ENTRY  ;  SDADDR .EQU 0 ; RELATIVE BLOCK OFFSET OF SEGMENT ON DISK  SDLEN .EQU 2 ; SEGMENT LENG MVL ; MOVE LEFT *MOV *SP+,R3 ; GET THE # OF BYTES TO MOVE *JLT NOMOVE ; NO MOVE IF NEGATIVE *JEQ NOMOVE ; OR IF 0 *MOV *SP+,R1 ; DESTINATION BASE ADDRESS *A *SP+,R1 ; PLUS OFFSET GIVES DESTINATION *MOV *SP+,R2 ; SOURCE BASE ADDRESS *A *SP+,R2 ; PLUS OFFSET GIVES SOURCE ADDRESS  MOV R1,R4 (SOC R2,R4 (SOC R3,R4 (SRL R4,1 ; CHECK IF ANY TH IN BYTES  ;  ; POOL DESCRIPTOR RECORD  ;  PLBASE1 .EQU 0 ; FIRST WORD OF POOLBASE ( CONTAINS BIAS )  PLBASE2 .EQU 2 ; SECOND " " " ( UNUSED )  ;  ; VOLUME INFORMATION BLOCK  ;  VIBUNIT .EQU 0 ; UNIT # WHERE VOLUME RESIDES  VIBID .EQU 2 ; VOLUME IDENTIFIER  ;  ; UNIT TABLE RECORD DESCRIPTION  ;  UVID .EQU 0 ; VOLUME ID 8-BYTES  UFILLER1 .EQU 8 ; FILLER OF THOSE WERE ODD (JOC $1  $2 MOV *R2+,*R1+ ; HOT DAMN! WE CAN DO A WORD MOVE! (DECT R3 (JGT $2 (B *BK  $1 MOVB *R2+,*R1+ ; MOVE A BYTE *DEC R3 ; DECR BYTE COUNTER *JGT $1 *B *BK  ;  NOMOVE AI SP,8 ; POP THE REST OF INFO OFF STACK *B *BK  ;  ;  MVR ; MOVE RIGHT *MOV *SP+,R3 ; GET THE # OF BYTE TO MOVE  UEOVBLK .EQU 10 ; END OF VOLUME BLOCK NUMBER  UPHYVOL .EQU 12 ; UNIT # WHERE VOLUME RESIDES  UBLKOFF .EQU 14 ; WHERE SUBSIDIARY VOLUME STARTS  UFILLER2 .EQU 16 ; FILLER - 8 BYTES  ;  USIZE .EQU 24 ; SIZE OF A RECORD - 24 BYTES  ( *JLT NOMOVE ; NO MOVE IF NEGATIVE *JEQ NOMOVE ; OR 0 *MOV *SP+,R1 ; DESTINATION BASE ADDRESS *A *SP+,R1 ; PLUS OFFSET GIVES DESTINATION *MOV *SP+,R2 ; SOURCE BASE ADDRESS *A *SP+,R2 ; PLUS OFFSET GIVES SOURCE ADDRESS *MOV R3,R4 ; *DEC R4 ; POINTER VALUE OFF-BY-ONE *A R4,R1 ; POINT TO END OF DESTINATION *A R4,R2 ; AND END OF SOURCE  $1 MOVB  *R2,*R1 ; AND MOVE BYTES IN BACKWARDS (DONE THIS C; WAY IN CASE OF OVERLAP) *DEC R2 ; DECR SOURCE PTR *DEC R1 ; AND DEST PTR ALSO *DEC R3 ; DECR BYTE CNTR *JGT $1 *B *BK ; FINISHED  ;  ;  FLC ; FILLCHAR C; FILL A BUFFER WITH A SPECIFIED CHARACTER. *MOV *SP+,R3 ; GET THE CHAR TO BE USED AS FILLER *SWPB R3 ; MUST LEFT JUSTIFY FOR BYTE MOVE INSTR. O^¢„s*MOV *SP+,R4 ; CHARACTER COUNT *JLT $2 ; NO MOVE IF NEGATIVE *JEQ $2 ; OR 0 {SO POP TWO WORDS OFF STACK} *MOV *SP+,R1 ; BASE DESTINATION ADDRESS *A *SP+,R1 ; PLUS OFFSET GIVES DESTINATION  MOV R1,R0 (SOC R4,R0 (SRL R0,1 (JOC $1 ; CHECK IF ANYTHING IS ODD? (MOVB R3,@INTPWS+7 ; COPY BYTE INTO BOTH HALVES  $3 MOV R3,*R1+ ; FILL IN WORDS (DECT R4 (JGT $3 (qB *BK  $1 MOVB R3,*R1+ ; MOVE THE CHAR TO THE DESTINATION *DEC R4 ; DECR BYTE COUNT *JGT $1 *B *BK  $2 AI SP,4 (B *BK  ;  ; Status block for call to SYSTEMSTAT  SSTATUS .BLOCK 6 ; memtopb @; clockhi @; clocklo  ;  ;  TIM ; FOR CLOCK KEPT IN 120THS *MOV SYSSTAT,STATOP ; opcode := system status *LI R2,SSTATUS ; r2 := addr (sstatus)  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ;      *SWPB R2 ; LEFT JUSTIFY FOR COMPARISON *MOV *SP+,R3 ; GET THE = (0) OR <> (1) *MOV *SP+,R4 ; GET MAX SCAN LENGTH *JEQ DONESCAN ; NULL SCAN; RETURN ZERO VALUE *JLT $4 ; NEGATIVE MEANS SCAN BACKWARDS FROM START  $1 CB *R1+,R2 ; COMPARE A BYTE TO THE CHAR WE WANT *JEQ $3 *MOV R3,R3 ; NOT EQUAL; DO WE WANT TO STOP? *JNE DONESCAN ; YES, WERE DOING A <> SCAN  $2 INC  .PAGE  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ;  R0 ; BUMP CHAR COUNTER *DEC R4 ; DECR MAX SCAN COUNTER *JGT $1 *JMP DONESCAN ; SCANNED MAX ALLOWABLE # OF CHARS  $3 MOV R3,R3 ; BYTES EQUAL; DO WE WANT TO STOP? *JEQ DONESCAN ; YES, WERE DOING AN = SCAN *JMP $2 ; NO, CONTINUE  ;  $4 CLR R0 ; DOING BACKWARDS SCAN  $7 CB *R1,R2 ; COMPARE A BYTE TO THE CHAR WE WANT *JEQ $6  ;  ;****************************************************************************   ;  ; standard procedure getpoolbytes (var dest : bytearray ;  ; poold : poolptr ;  ; pooloffset : memptr ;  ; nbytes : integer ) ;  ;  ; move nbytes from (poold^.poolbase + pooloffset) to dest.  ;  ;  ; *MOV R3,R3 ; BYTES NOT EQUAL; DO WE WANT TO STOP? *JNE DONESCAN ; YES, WERE DOING A <> SCAN  $5 DEC R0 ; BUMP COUNTER (*COUNTING NEGATIVE*) *DEC R1 ; DECR ADDRESS POINTER *INC R4 ; CHANGE MAX SCAN COUNTER (*COUNTING UP *JLT $7 ; TO 0 *) *JMP DONESCAN ; SCANNED MAX ALLOWABLE # OF CHARS  $6 MOV R3,R3 ; BYTE EQUAL; DO WE WANT TO STOP? *JNE $5  GETPOOLBYTES MOV *SP+,R1 ; r1 contains nbytes to move 0MOV *SP+,R3 ; r3 has pooloffset 0MOV *SP+,R2 ; r2 has pool desc. pointer 0.IF XADRS 0MOV R2,R6 ; r6 has poolptr 0LI R5,TMAP1 ; r5 has temp map address 0BL SETUPMAP ; set up temp map 0.ENDC 0MOV *SP+,R5 ; r5 has bytearray offset 0MOV R1,R1 ; if nothing to move then 0JEQ ; NO, DOING A <> SCAN  DONESCAN MOV R0,*SP ; FINISHED. PUSH # OF CHARS IT TOOK *B *BK  ;  ;  IOR ; RETURN IORESULT *MOV IORESULT,*SP ; PUSH IORESULT *B *BK  ;  ;  ;  ;********** TRANSCENDENTALS **********  SIN ; SINE  COS ; COSINE  LOG ; LOG BASE TEN  ARCTAN ; ARC TANGENT $3 ; exit ( ; repeat ($2 0.IF XADRS 0LDS @TMAP1 0.ENDC 0MOVB *R3+,*R5+ ; move byte and inc address 0DEC R1 ; decrement count 0JGT $2 ; until count = 0  ($3 B *BK ; bounce back to ifetch.....  ;  ;  ; standard procedure putpoolbytes (source : bytearray ;  ; poold : poolptr ;  LN ; NATURAL LOG  EXP ; EXPONENT  SQRT ; SQUARE ROOT *TRAP NOTIMP ; ERROR   ; pooloffset : memptr ;  ; nbytes : integer ) ;  ;  ; move nbytes from source to (poold^.poolbase + pooloffset)  ;  PUTPOOLBYTES MOV *SP+,R1 ; r1 has nbytes 0MOV *SP+,R3 ; r3 has pooloffset 0MOV *SP+,R2 ; r2 has pool desc pointer 0.IF XADRS 0MOV R2,R6 ; r6 has poolptr 0LI R5,TMAP1 ; r5 has temp map address 0BL SETUPM*MOV R2,STATADDR ; set status record address *BIOS STATOP ; call sysstat in BIOS *MOV 4(R2),R4 ; r4 := clocklo *MOV 2(R2),R2 ; r2 := clockhi *MOV R2,R3 ; make copy of clock hi *SRL R4,1 ; DIVIDE BY 2 (120 HZ INTERRUPT) *SLA R2,15 ; SHIFT LSB OF HIGH TO MSB *SOC R2,R4 ; PUT LSB OF HI INTO MSB OF LO *SRL R3,1 ; SHIFT HI WORD *MOV *SP+,R1 ; GET ADDR OF LOW TARGET *MO^£Į„ƒOV R4,*R1 ; MOVE LOW WORD *MOV *SP+,R1 ; GET ADDRESS OF HI TARGET *MOV R3,*R1 ; MOVE HI WORD *B *BK  ;  ;  SCN ; SCAN A BYTE ARRAY *CLR R0 ; CHARACTER COUNTER *INCT SP ; POP JUNK WORD OFF STACK *MOV *SP+,R1 ; GET BYTE ARRAY OFFSET *A *SP+,R1 ; ADD BASE TO GIVE STARTING ADDRESS *MOV *SP+,R2 ; GET THE CHARACTER TO SCAN FOR      AP 0.ENDC 0MOV *SP+,R5 ; r5 has bytearray pointer 0MOV R1,R1 ; if nbytes = 0 then 0JEQ $3 ; exit P; repeat '$2 0.IF XADRS 0LDD TMAP1 0.ENDC 0MOVB *R5+,*R3+ ; copy byte , inc addresses 0DEC R1 ; decrement count 0JGT $2 ; until count = 0 '$3 B *BK ; bounce back to ifetch...  .PAGE  ;  ;  R5,R6 ; point to envmap entry 0MOV *R6,R6 ; r6 has ^erec of ref'd env. 0MOV ENVDATA(R6),R6 ; r6 has env data base 0JMP $8 0 '$7 ; interpreter relative 0LI R6,INTORG ; r6 has interpreter base 0 '$8 ; endcase 0; get list size and element pointer 0DECT R3 ; r3 points to list size 0.IF XADRS 0LDS *R0 0.ENDC 0MOV *R3,R4 ; r4 contains list size  ; standard procedure flipsegbytes ( segerec : erecp ; offset : memptr ;  ; nwords : integer ) ;  ;  ; flips nwords starting at segerec^.envsib^.segbase + (2 * offset)  ;  ;  FLIPSEGBYTES MOV *SP+,R1 ; r1 has num words to flip 0MOV *SP+,R2 ; r2 has offset  MOV *SP+,R3 ; r3 has env_p  ;  ; calculate address to start flipping 0SLA R2,1 ; change r2 to0 0JEQ $10 ; while listsize > 0 do '$9 DECT R3 ; get elem pointer 0.IF XADRS 0LDS *R0 0.ENDC 0MOV *R3,R7 ; calc reloc address 0A R2,R7 ; r7 has reloc address 0.IF XADRS 0LDD *R0 0.ENDC 0A R6,*R7 ; relocate 0DEC R4 ; decrement count 0JGT $9 ; endwhile 0 '$10 ; get next r bytes 0MOV @ENVSIB(R3),R3 ; r3 has sib_p 0.IF XADRS 0MOV @SEGPOOL(R3),R6 ; r6 has pool base 0LI R5,TMAP1 ; r5 has temp map address 0BL SETUPMAP 0.ENDC 0MOV @SEGBASE(R3),R3 ; r3 has segment base 0A R2,R3 ; r3 has start address  ;  ; start the flip '$1 CI R1,0 ; if numwords = 0 then 0JEQ $2 ; exit P; repeat '$3 .IF XADRS elocation sublist pointer 0DECT R3 0 0JMP $1 ; endloop '$11 B *BK ; exit back to ifetch 0   .PAGE  ;  ; standard procedure moveseg ( segsib : sibp ;  ; srcpool : poolptr ;  ; srcoffset : memptr ) ;  ;  ; moves a segment from srcoffset to segsib^.segbase and performs  ; segrelative relocation.  ;  ;  MOVESEG MOV *SP+,R1 ; r1 has source offset 0LDS TMAP1 0.ENDC 0SWPB *R3 ; swap the bytes 0INCT R3 ; increment swap address 0DEC R1 ; decrement nword count 0JGT $3 ; until nword count = 0  '$2 B *BK ; bounce back to ifetch...  .PAGE  ;  ;  ; standard procedure rlocseg ( segerec : erecp ) ;  ;  ; relocates segment relative to interpreter, segment, and data segment  ;  RLOCSEG MOV *SP+,R10MOV *SP+,R2 ; r2 has poolptr 0MOV *SP+,R3 ; r3 has segsib pointer 0.IF XADRS 0LI R5,TMAP1 ; set up source map 0MOV R2,R6 ; get source poolptr 0BL SETUPMAP 0LI R5,TMAP2 0MOV @SEGPOOL(R3),R6 ; get dest poolptr 0BL SETUPMAP ; set up dest map 0.ENDC 0 0MOV @SEGBASE(R3),R4 ; r4 is destination address 0MOV @SEGLEN(R3),R5 ; r5 is segment length 0 0 ; get erecp -> r1  MOV ENVSIB(R1),R2 ; sib_pointer -> r2 0.IF XADRS 0MOV @SEGPOOL(R2),R6 ; get poolptr 0LI R5,TMAP1 ; get temp map address 0BL SETUPMAP ; set temp map 0LI R0,TMAP1 ; for future use 0.ENDC 0MOV SEGBASE(R2),R2 ; segbase -> r2 0.IF XADRS 0LDS *R0 0.ENDC 0MOV 2(R2),R3 ; get rloc list offset JNE $1 ; exit if seglen = 0 0B *BK 0 '$1 C R1,R4 ; if source > dest then 0JL $3 ; move up in mem lo -> hi 0MOV R1,R6 ; copy source address '$2 ; while numwords >0 do 0.IF XADRS 0LDS TMAP1 0.ENDC 0MOV *R6+,R7 ; copy source, inc address 0.IF XADRS 0LDD TMAP2 0.ENDC 0JEQ $11 ; if offset = 0 then exit 0SLA R3,1 ; convert offset to bytes 0A R2,R3 ; r3 points to relocation list  ; '$1 .IF XADRS 0LDS *R0 0.ENDC 0MOV *R3,R4 ; loop 0SRL R4,8 ; r4 contains relocation type 0.IF XADRS 0LDS *R0 0.ENDC 0MOV *R3,R5 ; 0SWPB R5 0SRL R5,8 ; r5 contains data seg number  ; 0MOV R4,R0MOV R7,*R4+ ; to dest, inc address 0DEC R5 ; srce -> dest, dec count 0JGT $2 ; endwhile 0JMP $5 ; else & $3 ; move down in mem hi->lo 0DEC R5 ; turn numwords to offset 0SLA R5,1 ; turn to byte offset 0A R5,R4 ; calc dest high address 0MOV R1,R6 ; copy source addres4 ; exit if rloctype = 0 0JEQ $11 0CI R4,4 ; if rloctype out of bounds 0JLT $2 ; then 0TRAP NOTIMP ; error !!! '$2 SLA R4,1 ; convert to bytes 0MOV @$3(R4),R4 ; r4 has case alternative 0B *R4 ; case rloctype of '$3 .WORD $4 ; done with relocation s 0A R5,R6 ; calc source address 0MOV @SEGLEN(R3),R5 ; get segment length '$4 ; while numwords > 0 do 0.IF XADRS 0LDS TMAP1 0.ENDC 0MOV *R6,R7 ; copy source 0.IF XADRS 0LDD TMAP2 0.ENDC 0MOV R7,*R4 ; to destination 0DECT R6 ; dec dest address 0DECT R4 ; dec srce address 0.WORD $5 ; segment relative 0.WORD $6 ; base relative 0.WORD $7 ; interpreter relative 0 '$4 ; done with relocation 0B *BK ; back to ifetch loop 0 '$5 ; segment relative 0MOV R2,R6 ; r6 contains seg base 0JMP $8 0 '$6 ; base relative 0MOV ENVEVEC(R1),R6 ; 0SLA R5,1 ; convert data segnum to bytes 0A       .ENDC 0  0CI R4,1 ; if rloctype <> segrel then 0JEQ $7 ; (* BUMP UP SUBLIST POINTER*) 0DECT R5 ; get list length pointer 0.IF XADRS 0LDS TMAP2 0.ENDC 0MOV *R5,R4 ; r4 has list length 0SLA R4,1 ; convert to bytes 0S R4,R5 ; r5 points to endof sublist 0JMP $9 ; else (*relocate*) '$7 DECT R5 ; O^£Į„s r5 points to list length 0.IF XADRS 0LDS TMAP2 0.ENDC 0MOV *R5,R4 ; r4 has list length 0JEQ $9 ; while len > 0 do '$8 DECT R5 ; r5 points to element 0MOV @SEGBASE(R3),R7 ; r7 has seg base 0.IF XADRS 0LDS TMAP2 0.ENDC 0A *R5,R7 ; r7 has reloc address 0.IF XADRS 0LDD TMAP2 0.ENDC 0A R6,*R7 ; add in seg movement H0DEC R4 ; dec list length 0JGT $8 ; endwhile '$9 ; endif 0DECT R5 ; r5 points to next sublist 0JMP $11 '$12 ; endloop 0B *BK ; back to ifetch 0  .PAGE  ;  ; standard procedure readseg (segerec : erecp ) : iorsltwd ;  ;  ; reads the segment from disk and puts it at the specified  ; segment base ( pool base ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ;  ignored for this version )  ;  ;  READSEG MOV *SP+,R1 ; r1 has eviron rec pointer 0MOV *SP+,R2 ; pop function value space 0 0; get parameters for i/o 0MOV @ENVSIB(R1),R2 ; r2 has sib pointer 0.IF XADRS 0MOV @SEGPOOL(R2),R6 ; get poolptr 0LI R5,XMAP ; get address of BIOS map 0BL SETUPMAP ; set up map 0.ENDC 0MOV @SEGBASE(R2),R3 ; r3 has seg base address  ;  ;****************************************************************************   ;  ;********** CONSTANTS, VARIABLES, AND RECORDS **********  ;  ; DEFINE THE P-MACHINE PSEUDO-REGISTERS.  ;  SIB .WORD 0 ; POINTER TO CURRENT SIB  EREC .WORD 0 ; >; GENERAL REGISTERS  READYQ .WORD 0 ; POINTER TO READY QUEUE  EVEC .WORD GBLVEC ; POINTER TO CURRENT EVEC 0MOV @SEGADDR(R2),R4 ; r4 has disk block addr 0MOV @SEGLEN(R2),R5 ; r5 has block length 0SLA R5,1 ; convert block len to bytes 0MOV @SEGUNIT(R2),R6 ; r6 has vip pointer 0MOV @VIBUNIT(R6),R6 ; r6 has unit number 0 0; push parameters on stack 0PUSHWORD R6 ; unit # 0LI R7,0 0PUSHWORD R7 ; 0 base address 0PUSHWORD R3 ; segbase (byte offset) 0PUSHWORD R5  CURTASK .WORD ROOTTASK ; POINTER TO CURRENT TASK'S TIB  POINTERS ; LOCATION OF END OF POINTERS  ;  ; SYSTEM ERROR NUMBERS  ;  SYSERR .EQU 0  INVNDX .EQU 1  NOPROC .EQU 2  NOEXIT .EQU 3  STKOVR .EQU 4  INTOVR .EQU 5  DIVZER .EQU 6  BADMEM .EQU 7  UBREAK .EQU 8  SYIOER .EQU 9  UIOERR .EQU 10  NOTIMP .EQU 11  FPIERR .EQU 12  S2LONG .EQU 13  HLTBPT . ; byte length 0PUSHWORD R4 ; block address 0PUSHWORD R7 ; 0 control word 0 0; call sysread 0BL @SYSREAD 0PUSHWORD IORESULT ; push ioresult 0B *BK ; back to ifetch  .IF XADRS  .PAGE  ;  ; procedure setupmap ( poolptr : ^pooldesc ; mapaddr : address ) ;  ;  ; Sets up a temporary map for use by anyone who needs one.  ; R6 contains poolptr. R5 contains map address  ; 0DEC R5 ; dec word count 0JGT $4 ; endwhile '$5 ; endif 0; segment is now moved - perform seg rel relocation 0 0; if no relocation - exit 0MOV @SEGBASE(R3),R4 ; r4 has new segbase 0.IF XADRS 0LDS TMAP2 0.ENDC 0MOV 2(R4),R5 ; r5 has offset to rel. lst 0JNE $6 ; exit if reloc off. = 0 0B *BK 0 '$6 MOV R4,R6 ; SETUPMAP C R6,NIL ; if poolptr <> nil then 0JEQ $1 ; (* setup mem map *) 0MOV @PLBASE1(R6),R6 ; r6 := bias of code pool ($1 ; endif 0STMAP2 R6,R5 ; set up temporary map 0B *R11 ; return  ;  ; Temporary maps used by pool management CSPs  ;  TMAP1 .WORD 0 (.WORD 0 (.WORD 0 (.WORD 0 (.WORD 0 (.WORD 0  TMAP2 .WORD 0 (.WORD 0 (.WORD 0 (.WORD 0 (.WORD 0 (.WORD 0  r6 has dest offset 0S R1,R6 ; dest - srce -> r6 0; get relocation list pointer in r5 0SLA R5,1 ; turn to bytes 0A R4,R5 ; r5 has addr of reloc list 0 '$11 ; loop 0.IF XADRS 0LDS TMAP2 0.ENDC 0MOV *R5,R4 ; r4 has first word of sublist 0SRL R4,8 ; r4 has relocation type 0JEQ $12 ; exit if reloctype = 0      EQU 14  BRKPNT .EQU 16  SEGFLT .EQU 80H  STKFLT .EQU 81H  .IF XADRS  ;  ; MAP VECTOR FOR EXTENDED ADDRESS SPACES...  ; INDEXED BY ADDRESS SPACE TO GIVE MAP FILE ADDRESS  ;  MAPVEC .WORD MAP0 ; map for getting at kernel,heap and stack *.WORD MAP2 ; map for getting at current external pool MAP0 .WORD 0 *.WORD 0 *.WORD 0 *.WORD 0 *.WORD 0 *.WORD 0  MAP2 .WORD 0 *.WORD 0  ; TABLE INDEXER USED BY IDSEARCH ROUTINE  DIRSZ .WORD 2048 ; DIRECTORY SIZE = 2 BLOCKS (2048 BYTES)  FALSE .WORD FALSEV ; FALSE FOR MOVE IMMEDIATE  NIL .WORD NILV ; VALUE OF NIL FOR THIS MACHINE  NUL .WORD 0 ; BIG FLAT ZERO  NEGONE .WORD -1 ; NEGATIVE ONE FOR MOVE IMMEDIATE  ONE .WORD 1 ; ONE FOR MOVE IMMEDIATE  SEGDSZ .WORD 512 ; SEGMENT DICTIONARY SIZE *.WORD 0 *.WORD 0 *.WORD 0 *.WORD 0 *.ENDC  ;  ; USED BY IDSEARCH STANDARD PROCEDURE  ;  ABYTE .ASCII "A" ;  ZBYTE .ASCII "Z" ;  BYTE0 .ASCII "0" ;  BYTE9 .ASCII "9" ;  LOWERA .BYTE "a" ; LOWER CASE 'A'  LOWERZ .BYTE "z" ; LOWER CASE 'Z'  UNDRLINE .BYTE "_" ; UNDERLINE  DOLLAR .BYTE "$" ; DOLLARSIGN  CASEADJ .BYTE 20H ; LOWER TO UPPER CASE CONVERSION FACTOR *.A SIX .WORD 6 ; THE NUMBER SIX  TRUE .WORD TRUEV ; TRUE FOR MOVE IMMEDIATE  TRUEB .WORD 0FFFFH  WORDBITS .WORD 16 ; USED TO DIV BY 16 (# OF BITS IN A WORD)  ZERO .WORD 0 ; USED TO PUSH A VALUE OF 0  NOOP .WORD 1000H ; NOOP FOR IFETCH LOOP (JMP $+2)  JMPB3 .BYTE 10H ; TO JMP TO TASKSWCH BRANCH *.BYTE -3 ; (JMP $-3) -3 PC-BACK-BR TO TASKSWCH  ;  ;;  ; SYSCOM (SYSTEM COMMUNICATION): THESE LOCATIOLIGN 2  ;  ;  ; GENERAL PURPOSE EQUATES  ;  CHARNORM .EQU -65 ; CHARACTER NORMALIZER USED IN IDSEARCH  FALSEV .EQU 0  HSMRGN .EQU 80 ; HEAP-STACK SPACE MARGIN (BYTES)  NILV .EQU 0  SLDLNORM .EQU 62 ; USED AS NORMALIZER FOR SHORT LOAD LOCALS  SLDONORM .EQU 94 ; USED AS NORMALIZER FOR SHORT LOAD GLOBLS  SINDNORM .EQU 240 ; USED AS NORMALIZER FOR INTEGER LOADS NS ARE REFERENCED  ; RELATIVE TO 'SYSCOM' (=SYSCMB) BY THE PASCAL SYSTEM AND MUST STAY IN THESE  ; FIXED RELATIVE LOCATIONS.  ;  SYSCMB  IORESULT .WORD 0  XEQERR .WORD 0  SYSUNT .WORD 4  BUGSTA .WORD 0  GDIRP .WORD 0 ; POINTER TO DIRECTORY ON STACK  .WORD 0,0  FLTSEM .WORD 0,0 ; semaphore for signalling fault handler  FLTTIB .WORD 0 ; ^TIB of faulting process  SIGNWIPE .EQU 7FFFH ; USED AS MASK IN MACRO 'GETBIG'  TRUEV .EQU 1  XEQDSZ .EQU -2 ; -(EXECERR DATASIZE = 2 BYTES OF HIDDEN LOCAL >; VARIABLE (WITH SYSCOM^))  ;  ; GENERAL PURPOSE VARIABLES (MUST RESIDE IN RAM)  ;  ASMPROC .WORD 0 ; ASSEMBLY LANGUAGE PROCEDURE FLAG  CPOOL .WORD 0 ; CONSTANT POOL ADDRESS  CPOFST .WORD 0 ; BYTE OFFSET IN SEGMENT OF CONSTANT POOL  CURPROC .WORD 0 ; CURRENT PROCEDURE FLTEREC .WORD 0 ; ^EREC of segment to leave in memory  FLTNWDS .WORD 0 ; desired stack extension  FLTNUM .WORD 0 ; fault number  SUBSTRT .WORD 30 ; subsidiary volume start unit number  EXPSYS .WORD 0 ; expanded address space system is false?  .BLOCK 12  TIMSTMP .WORD 0 ; time stamp for segment activity  UNITPTR .WORD NILV ; pointer to unit table  SUBMAX .BYTE 15 ; max number o NUMBER  FIRSTWRD .WORD 0 ; USED BY SRS ROUTINE  IBADUNIT .WORD 2 ; IORESULT FOR IBADUNIT  IDEND .WORD 0 ; USED BY IDSEARCH ROUTINE  INOUNIT .WORD 9 ; IORESULT FOR INOUNIT  IBADBLK .WORD 17 ; IORESULT FOR BAD BLOCK SPECIFICATION  IPCFLT .WORD 0 ; FOR PROCEDURE CALL FAULTS  ISCPF .WORD 0 ; FLAG FOR BLDFRM  LASTWORD .WORD 0 ; USED BY SRS ROUTINE f subsidiary units  SERMAX .BYTE 5 ; max number of serial units *.BLOCK 6  VERSION .WORD 1 ; version 4.1  REALSZE .WORD 4 ; real number word size  MSCNFO .WORD 0  CRTTYP .WORD 0  CRTCTL .BYTE 82H ; HOME *.BYTE 00H ; ESCAPE SEQUENCE NEEDED *.BYTE 99H ; ERASE EOL *.BYTE 98H ; ERASE EOS *.BYTE 89H ; REVERSE LINE FEED *.BYTE 8AH ; NONDESTRUCTIVE FS  NEWSP .WORD 0 ; USED BY SET COMPARE ROUTINES  ONEWORDS .WORD 0 ; USED BY SUBRANGE SET (SRS) ROUTINE  SAMEWORD .WORD 0 ; USED BY SRS ROUTINE  SYSRTN .WORD 0 ; RETURN ADDRESS SAVE LOCATION FOR SYSREAD  SAVBK .WORD 0 ; KLUDGE FOR SAVING BK ON SETMAPS  SAVRTN .WORD 0 ; GENERAL PURPOSE RETURN ADDRESS SAVE LOCATION  SAVR0 .WORD 0 ; USED BY SHERIFF  SAVR1 .WORD 0 ; " " "  SAVSYM *.BYTE 00H ; FILLCOUNT *.BYTE 88H ; BACKSPACE *.WORD 0,0 ; EXPANSION  CRTNFO .WORD 0018H ; HEIGHT OF SCREEN *.WORD 0050H ; WIDTH OF SCREEN  ; INPUT FROM CONSOLE *.BYTE 8BH ; CURSOR DOWN *.BYTE 89H ; CURSOR UP *.BYTE 8AH ; CURSOR RIGHT *.BYTE 88H ; CURSOR LEFT  FLUSH .BYTE 94H  EOFF .BYTE 03H ; THE END-OF-FILE KEY  STOP .BYTE 93H  BREAK .BYTE 9BH  BADCHR .BYTE  .WORD 0 ; USED BY IDSEARCH ROUTINE  SAVEREC .WORD 0 ; PARAMETER TO ERROR ROUTINE  SEG .WORD 0 ; PSEUDO REGISTER SEG  SEGHI .WORD 0 ; POINTER TO TOP OF A SEGMENT  SEGNDX .WORD 0 ; INDEX INTO SEGTABLE (*IN SYSCOM*)  SEXOK .WORD 0 ; FLAGS IF SEX OF CURRENT SEGMENT IS OK  SKIPCHK .WORD 0 ; FLAG FOR BLDFRM TO DECIDE TO STACK CHECK  STATLINK .WORD 0 ; USED IN PROCEDURE CALLS  3FH  CHRDEL .BYTE 88H  ALTMOD .BYTE 1BH  LINDEL .BYTE 81H  ETX .BYTE 0A0H ; THE EDITOR 'ACCEPT' KEY  PREFIXER .BYTE 0  ALPHLOCK .BYTE 92H  CHRMASK .BYTE 0FFH ; CHARACTER MASK FOR CONSOLE INPUT *.WORD 0  SYSCME ; END OF SYSCOM *.ALIGN 2  ; END OF SYSCOM  ;  ;  ; TIB FOR THE MAIN TASK  ;  ROOTTASK .WORD NILV *.WORD 128 *.WORD 0 *.WORD 0 *.WORD 0 *.WORD 0 *.WORD 0  STSEARCH .WORD 0 ; USED IN IDSEARCH TO SAVE STARTING ADDRESS  STKEXT .WORD 0 ; TO PASS STACK EXTENSION TO STKCHK  TEMP .WORD 0 ; GENERAL PURPOSE SCRATCH LOCATION  ZEROWRDS .WORD 0 ; USED BY SUBRANGE SET (SRS) ROUTINE  SAV_MAP .WORD 0 ; USED BY NAT TO SAVE CURRENT MAP ADDRESS   ;  ; GENERAL PURPOSE CONSTANTS (CAN RESIDE IN ROM)  ;  BLANK .WORD 2020H ; WORD OF BLANKS (USED IN IDSEARCH)  CHARINDX .WORD 10       *R2 ; OFF TO PCODE ROUTINE  GET_BIG2 (CLR R5 (.IF XADRS (LDS *MAP (.ENDC (MOVB *IPC+,@INTPWS+11 ; PUT NEXT BYTE INTO R5  GET_BIG1 (CLR R4 (.IF XADRS (LDS *MAP (.ENDC (MOVB *IPC+,@INTPWS+9 ; PUT NEXT BYTE INTO R4  GET_BIG (CLR R3 (.IF XADRS (LDS *MAP (.ENDC (MOVB *IPC+,R3 ; PUT NEXT BIG INTO R3 (JLT $1 (SWPB R3 ; SHORT FORM OF BIG (B *R2 ; OFF TO PCODE ROUTINE O^¤į„c $1 ANDI R3,7F00H ; LONG FORM OF BIG (.IF XADRS (LDS *MAP (.ENDC (MOVB *IPC+,@INTPWS+7 (B *R2 ; OFF TO PCODE ROUTINE  ;  ;  TRAPSNAP LI BK,BACK ; BIOS USER BREAK ENTRY POINT, RESTORE BACK *MOV @XEQERR,R1 ; PUT ERROR NUMBER IN R1 *JMP TRAP1  TRAPER MOV *R11,R1 ; STANDARD (NON-BIOS) TRAPPER ENTRY POINT  TRAP1 CI R1,SEGFLT ; CHECK IF SEGMENT FAULT (JNE $1 (MOV R5,@FLTEREC ; SET FAULT EREC (CLRA€ @FLTNWDS ; SET FAULT NWDS (JMP $2  $1 CI R1,STKFLT ; CHECK IF STACK FAULT (JNE $3 (MOV @SAVEREC,@FLTEREC ; SET FAULT EREC (MOV @STKEXT,R2 ; SET FAULT NWDS (SRL R2,1 (MOV R2,@FLTNWDS  $2 MOV @CURTASK,@FLTTIB ; SET FAULT TIB (MOV R1,@FLTNUM ; SET FAULT # (LI R1,FLTSEM ; PUSH FAULT-HANDLER SEMAPHORE (PUSHWORD R1 (LI R1,SIGNAL+2 ; AND SIGNAL ON IT... (B *R1 (  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ;  $3 DECT SP ; SETUP FOR CXP(1,2) = EXECUTION ERROR (CLR *SP ; PARM 1=0 (DECT SP (CLR *SP ; PARM 2=0 (INC @SKIPCHK ; SET FLAG FOR NO STACK CHECKING (PUSHWORD R1 ; PARM 3= ERROR # (MOV @CURPROC,R1 ; PARM 4= PROCEDURE RELATIVE IPC (SLA R1,1 (NEG R1 (A @SEGHI,R1 (BL @SEG_WORD ; PICKUP PROC DICT. ENTRY (SLA R2,1 (A @SEG,R2 (INCT R2 (NEG R2 (A IPC,R2 (NOP (NOP  ;  ;****************************************************************************   ;  ;  ; THIS IS THE MAIN PROGRAM ROUTINE WHICH FETCHES NEW INSTRUCTIONS (OPCODES)  ; FROM THE P-CODE INPUT. USING THE OPCODE AS AN INDEX THRU 'OPTABLE', THE  ; ADDRESS OF THE APPROPRIATE ROUTINE IS FOUND. THE FIRST WORD OF EVERY  ; ROUTINE CONTAINS THE ADDRESS OF THE OPERAND PRE-FETCH SEQUENCE TO BE  ; PUSHWORD R2 (MOV BASE,@STATLINK ; SET STATIC LINK (LI R1,GBLVEC (MOV @2(R1),R5 ; SET R5= EREC FOR EXECUTION ERROR (LI R3,2 ; PROCEDURE #2 (LI R11,CXG3 ; OFF TO MIDDLE OF CXG (B @SEGCHK1 ; THIS SEGCHK CAN NEVER FAULT...  ;  ;  NAT .WORD $0 ; TRANSFER CONTROL TO NATIVE CODE MODULE  $0 INC IPC ; MAKE SURE IPC IS ON WORD BOUNDARY (.IF XADRS  ; EXECUTED BEFORE TRANSFERRING CONTROL TO THE ROUTINE. CONTROL IS RETURNED  ; HERE AFTER EACH P-CODE IS DONE. FOR TASK SWITCHING AND TRAPS, BK IS CHANGED  ; TO FORCE A DIFFERENT ROUTINE TO EXECUTE ON P-CODE BOUNDARIES.  ;  ; *** CAUTION SHOULD BE EXERCISED WHEN MODIFYING ANY OF THIS CODE. ***  ; *** OPERANDS ARE PRE-FETCHED SUCH THAT THE LAST OPERAND FETCHED, ***  ; *** IF ANY, GOES IN R3, THE SECOND TO LAST OPERAND FETCHED, IF ***  ; *** ANY, GOES INTO R4, ETC. R1 CONTAINS THE PCODE (X2), R2 (MOV MAP,@SAV_MAP ; SAVE MAP IF NECESSARY (.ENDC (MOV @SEG,MAP ; PASS SEG IN MAP TO NATIVE CODE (LI BK,$1 ; AND RETURN ADDRESS IN BK (B *IPC ; CAN ONLY OCCUR WITH SEGMENT IN CPU-RAM...  $1 LI BK,BACK ; BACK ALREADLY? RESET I-FETCH BK (.IF XADRS (MOV @SAV_MAP,MAP ; RESTORE MAP IF NECESSARY (.ENDC (MOV R11,IPC ; RESTORE IPC FROM NATIVE CODE BL RETURN (B *BK  ;  ;  NATINFO .WORD GET_BYTE ; ***  ; *** CONTAINS THE ADDRESS OF THE ROUTINE AND R0 CONTAINS THE ***  ; *** PRE-FETCH ADDRESS. ***  ;  ; (B TASKSWCH ; JUMP TO TASKSWCH CODE  BACK NOP ; MODIFIED FOR TASK SWITCH TO JMPB3 (.IF XADRS (LDS *MAP (.ENDC (MOVB *IPC+,R1 ; PICKUP PCODE (SRL R1,7 ; RIGHT JUSTIFY (ALMOST) (.IF DEBUG (BL @DBUG ; OFF TO DEBUGGER (.ELSE *.WORD -1 *.WORD 0 *.WORD 0 *.WORD 0 *.WORD 0 *.WORD 1 ; EXTRA TWO WORDS FOR MAINTASK *.WORD 0  ;  ;  ; GLOBAL ENVIORNMENT VECTOR  GBLVEC .WORD 32 *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD(MOV @OPTABLE(R1),R2 ; INDEX THRU OPTABLE (.ENDC (MOV *R2+,R0 ; PICKUP PRE-FETCH ADDRESS (B *R0 ; OFF TO PRE-FETCH ROUTINE  GET_3BYTE (CLR R5 (.IF XADRS (LDS *MAP (.ENDC (MOVB *IPC+,@INTPWS+11 ; PUT NEXT BYTE INTO R5  GET_2BYTE (CLR R4 (.IF XADRS (LDS *MAP (.ENDC (MOVB *IPC+,@INTPWS+9 ; PUT NEXT BYTE INTO R4  GET_BYTE (CLR R3 (.IF XADRS (LDS *MAP (.ENDC (MOVB *IPC+,@INTPWS+7 ; PUT NEXT BYTE INTO R3 (B  NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV *.WORD NILV  ;  ; ARRAY OF SEMAPHORE ADDRESSES; USED BY 'ATTACH' ROUTINE.  ;  ENVVEC .BLOCK 128 ; 64 EVENT SLOTS FOR HARDWARE ATTACH  ;        SKIP NATIVE CODE GENERATION INFO (A R3,IPC ; INCREMENT IPC BY THAT # OF BYTES (B *BK  ;  ;  UNDF .WORD $0  $0 TRAP NOTIMP   ;  BPT .WORD $0  $0 TRAP BRKPNT   ;  ;  ;********** JUMP INTRUCTIONS **********  ;  ;  ; TRUE JUMP. JUMP IF TOS IS TRUE  ;  TJP .WORD GET_BYTE (MOV *SP+,R1 (SRL R1,1 (JOC TAKE_JMP (B *BK  ;  ; FALSE JUMP. JUMP IF TOS IS FALSE  ;  FJP .WORD GET_BYTE aCc(MOV *SP+,R1 ; GET TOS  SRL R1,1 (JNC TAKE_JMP ; TO JUMP OR NOT TO JUMP? (B *BK ; NOT, ON TO NEXT PCODE...  TAKE_JMP CI R3,80H ; CHECK IF NECESSARY TO SIGN EXTEND (JLT TJ1  TJ0 ORI R3,0FF00H ; SIGN EXTEND OFFSET  TJ1 A R3,IPC ; TAKE THE JUMP (B *BK ; MAKE IT DO SOME GOOD, THEN RETURN  ;  ; UNCONDITIONAL JUMP  ;  UJP .WORD GET_BYTE (JLT TJ0 ; SIGN EXTEN*.TITLE "IV.1B UCSD Pascal Interpreter for TI 990" *.PROC MAININTP *.MACROLIST *.NOASCIILIST *.NOPATCHLIST  ; .ORG 0A0H  ;****************************************************************************  ; ;  ; UCSD PASCAL INTERPRETER FOR THE TEXAS INSTRUMENTS ;  ; 9900 MICROPROCESSOR ;  ; WRITTEN BY D BEFORE JUMP (JMP TJ1 ; JUST JUMP  ;  ; EQUAL FALSE JUMP. JUMP IF INTEGER TOS <> TOS-1  ;  EFJ .WORD GET_BYTE (S *SP+,*SP+ ; SUBTRACT TOS FROM TOS-1 (JNE TAKE_JMP (B *BK   ;  ; NOT EQUAL FALSE JUMP. JUMP IF INTEGER TOS = TOS-1  ;  NFJ .WORD GET_BYTE (S *SP+,*SP+ ; SUBTRACT TOS FROM TOS-1 (JEQ TAKE_JMP (B *BK  ;  ;  ; UNCONDITIONAL LONG JUMP  ;  UJPL .WORD GET_2BYTE  ;  ; JULIE ERWIN AND TOM EDWARDS (VERSION II.0) ;  ; TOM EDWARDS (VERSION III.0) ;  ; BILL FRANKS AND DEAN JACOBS (VERSION IV.0) ;  ; TOM ROBINSON (VERSION IV.1) ;  ;Copyright (c) 1980 by Regents of the University of California at San Diego.;  LNG_JMP MOVB @INTPWS+7,R4 ; PUT 2 BYTES INTO 1 WORD (A R4,IPC ; ADD THAT WORD TO IPC (B *BK ; RETURN THRU PORT RESET  ;  ;  ; FALSE LONG JUMP  ;  FJPL .WORD GET_2BYTE (MOV *SP+,R1 ; POP TOS (SRL R1,1 ; TEST LS-BIT (JNC LNG_JMP ; JUMP IF ITS OFF (B *BK  ;  ;  ; CASE JUMP  ;  XJP .WORD GET_BIG ; GET OFFSET OF JUMP TABLE IN SEGMENT (SLA R3,1 ; DOUBLE FOR BYTE ADDRESSING (A  ; ;  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 b CPOOL,R3 ; SET R3=ADDRESS OF JUMP TABLE (MOV R3,R1 (BL @SEG_CHWD (MOV R2,R0 ; SET R0=MINIMUM LIMIT (BL @SEG_CHWD ; SET R4=MAXIMUM LIMIT (MOV *SP+,R3 ; SET R3=INDEX INTO JUMP TABLE (C R3,R2 ; IS INDEX > MAXIMUM LIMIT? (JGT $1 (S R0,R3 ; VALID INDEX. SET RELATIVE OFFSET (JLT $1 (SLA R3,1 ; DOUBLE FOR BYTE ADDRESSING (A R3,R1 ; ADD IN ADDRESS OF THE TABLE START y Softech Microsystems, Inc. ;  ; ;  ;****************************************************************************   ; ;  ;****************************************************************************  ; *.REF KEYBWS,BIOSWS,DISPWS,SELIWS,CLCKWS,INTPWS,TRAPWS *.REF KEYBEP,BIOSEP,DISPEP,SELIEP,CLCKEP,INIT,DBUG (BL @SEG_CHWD (A R2,IPC ; ADD IT TO THE IPC  $1 B *BK ; FINISHED    *.REF BBBREAK,KEYQUE,XMAP  *.REF CTRL,EXRL,LDCRL,LDRL,STRL *.REF ABR,ADR,DVR,FLT,MPR,NGR *.REF POT,RND,SBR,TNC *.REF EQUREAL,LEQREAL,GEQREAL   *.DEF BACK,TRAPER *.DEF MEMTOPB,SEG_WORD,OPTABLE,EVEC *.DEF CCLR,PCLR,RCLR,DCLR *.DEF CSOUT,CLROP,OUTOP,CHAROUT *.DEF XEQERR *.DEF TEMP,START,DIRSZ,SYSREAD,SYSUNT,SEGDSZ *.DEF SYSBLK,SEG,SYSCMB,SAVRTN *.DEF TRAPSNAP,CPOFST,CPOOL *.DEF SEXOK,NEGONE,SIB,EREC,ONE,ROOTTASK *.DEF  CHKSEX,NIL,SEGHI,TRUE,ZERO,GBLVEC *.DEF CMP3TABL,PUSHRSLT,GET_BIG,RLCONST,IPCFLT *.DEF CHRMASK,SYSSN  ;  NO .EQU 0  YES .EQU ~NO   DEBUG .EQU NO   XADRS .EQU NO  IV_0 .EQU YES   LSTMAIN .EQU YES  LSTDECL .EQU YES  LSTTABS .EQU YES  LSTMACS .EQU YES  LSTIFJP .EQU YES  LSTLDSTR .EQU YES  LSTPROC .EQU YES  LSTPFCMP .EQU YES  LSTSETS .EQU YES O^£±¤„      ;  ; JULIE ERWIN AND TOM EDWARDS (VERSION II.0) ;  ; TOM EDWARDS (VERSION III.0) ;  ; BILL FRANKS AND DEAN JACOBS (VERSION IV.0) ;  ; TOM ROBINSON (VERSION IV.1) ;  ;Copyright (c) 1980 by Regents of the University of California at San Diego.; *B *BK ; BEGIN EXECUTION AT FETCHI LOOP  ;  ; THE INCLUDE FILES ... *.NOLIST *.IF LSTDECL *.LIST *.ENDC *.TITLE "DECLARATION OF CONSTANTS, VARIABLES, AND RECORDS" * *.INCLUDE P4.DECL1.TEXT *.INCLUDE PX.DECL2.TEXT *.NOLIST *.IF LSTTABS *.LIST *.ENDC *.TITLE "DECLARATION OF TABLES" * *.INCLUDE P4.TABL.TEXT *.NOLIST *.IF LSTMACS *.LIST *.ENDC *.TITLE "INTERPRETER MACROS AND WORD GET ROUTINE" *.PAGE *.INCLUDE P4.MACRO.TEXT *.NOLIST *.IF  ; ;  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 b LSTIFJP *.LIST *.ENDC *.TITLE "IFETCH LOOP AND JUMP INSTRUCTIONS" * *.INCLUDE P4.IF&JMP.TEXT  *.NOLIST *.IF LSTLDSTR *.LIST *.ENDC *.TITLE "LOAD AND STORE INSTRUCTIONS" * *.INCLUDE P4.LD&STR.TEXT  *.NOLIST *.IF LSTPROC *.LIST *.ENDC *.TITLE "PROCEDURE CALL AND RETURN INSTRUCTIONS" * *.INCLUDE P4.PROC.TEXT  *.NOLIST *.IF LSTPFCMP *.LIST *.ENDC *.TITLE "PACKED FIELD AND COMPARISON INSTRUCTIONS" * *.INCLUDE P4.PF&CMP.TEXT  *.NOLIST y Softech Microsystems, Inc. ;  ; ;  ;****************************************************************************   ; ;  ;****************************************************************************  ; *.REF KEYBWS,BIOSWS,DISPWS,SELIWS,CLCKWS,INTPWS,TRAPWS *.REF KEYBEP,BIOSEP,DISPEP,SELIEP,CLCKEP,INIT,DBUG *.IF LSTSETS *.LIST *.ENDC *.TITLE "SET INSTRUCTIONS" * *.INCLUDE P4.SET.TEXT  *.NOLIST *.IF LSTTASK *.LIST *.ENDC *.TITLE "TASK INSTRUCTIONS" * *.INCLUDE P4.TASK.TEXT  *.NOLIST *.IF LSTCSP *.LIST *.ENDC *.TITLE "STANDARD PROCEDURES" * *.INCLUDE P4.CSP1.TEXT *.INCLUDE PX.CSP2.TEXT *.INCLUDE P4.CSP3.TEXT *.NOLIST *.IF LSTRSP *.LIST *.ENDC *.TITLE "RUNTIME SUPPORT PACKAGE" * *.INCLUDE P4.RSP1.TEXT *.PAGE *.INCLUDE P4.RSP2.TEXT * **.REF BBBREAK,KEYQUE,XMAP  *.REF CTRL,EXRL,LDCRL,LDRL,STRL *.REF ABR,ADR,DVR,FLT,MPR,NGR *.REF POT,RND,SBR,TNC *.REF EQUREAL,LEQREAL,GEQREAL   *.DEF BACK,TRAPER *.DEF MEMTOPB,SEG_WORD,OPTABLE,EVEC *.DEF CCLR,PCLR,RCLR,DCLR *.DEF CSOUT,CLROP,OUTOP,CHAROUT *.DEF XEQERR *.DEF TEMP,START,DIRSZ,SYSREAD,SYSUNT,SEGDSZ *.DEF SYSBLK,SEG,SYSCMB,SAVRTN *.DEF TRAPSNAP,CPOFST,CPOOL *.DEF SEXOK,NEGONE,SIB,EREC,ONE,ROOTTASK *.DEF .NOLIST *.IF LSTSYMS *.LIST *.ENDC *.TITLE " "  *.END   CHKSEX,NIL,SEGHI,TRUE,ZERO,GBLVEC *.DEF CMP3TABL,PUSHRSLT,GET_BIG,RLCONST,IPCFLT *.DEF CHRMASK,SYSSN  ;  NO .EQU 0  YES .EQU ~NO   DEBUG .EQU NO   XADRS .EQU YES  IV_0 .EQU YES   LSTMAIN .EQU YES  LSTDECL .EQU YES  LSTTABS .EQU YES  LSTMACS .EQU YES  LSTIFJP .EQU YES  LSTLDSTR .EQU YES  LSTPROC .EQU YES  LSTPFCMP .EQU YES  LSTSETS .EQU YES O^£±¤„ LSTTASK .EQU YES  LSTCSP .EQU YES  LSTRSP .EQU YES  LSTSYMS .EQU YES  LSTGBLEQ .EQU YES  * *.NOLIST *.IF LSTGBLEQ *.LIST *.ENDC *.TITLE "GLOBAL INTERPRETER EQUATES" *.INCLUDE G4.EQUS.TEXT *.PAGE * * *.IF LSTMAIN *.LIST *.ELSE *.NOLIST *.ENDC *  ;  ;  ; THE FOLLOWING VECTOR TABLE MUST REMAIN HERE SINCE EXTERNAL ASSEMBLY  ; UNITS DEPEND UPON IT FOR RUNTIME ERROR LINKAGE AND OTHER INFO.  INTORG  MEMTOPB .WORD INTORG  SYSBaSH LSTTASK .EQU YES  LSTCSP .EQU YES  LSTRSP .EQU YES  LSTSYMS .EQU YES  LSTGBLEQ .EQU YES  * *.NOLIST *.IF LSTGBLEQ *.LIST *.ENDC *.TITLE "GLOBAL INTERPRETER EQUATES" *.INCLUDE G4.EQUS.TEXT *.PAGE * * *.IF LSTMAIN *.LIST *.ELSE *.NOLIST *.ENDC *  ;  ;  ; THE FOLLOWING VECTOR TABLE MUST REMAIN HERE SINCE EXTERNAL ASSEMBLY  ; UNITS DEPEND UPON IT FOR RUNTIME ERROR LINKAGE AND OTHER INFO.  INTORG  MEMTOPB .WORD INTORG  SYSB*.TITLE "IV.1B UCSD Pascal Interpreter for TI 990" *.PROC MAININTP *.MACROLIST *.NOASCIILIST *.NOPATCHLIST  ; .ORG 0A0H  ;****************************************************************************  ; ;  ; UCSD PASCAL INTERPRETER FOR THE TEXAS INSTRUMENTS ;  ; 9900 MICROPROCESSOR ;  ; WRITTEN BY LK .WORD START  SYSSN .BLOCK 14 *.WORD TRAPSNAP *.WORD XEQERR  ;  ;THE FIRST THING TO EXECUTE ...  START LIMI 0 *LWPI INTPWS ; LOAD INTERPRETER WORKSPACE POINTER *BL INIT ; SET UP INITIAL STATE OF P-MACHINE *MOV SYSCLR,CLROP ; SYSTEM CLEAR CALL *XOP CLROP,5 ; CALL THE BIOS *LIMI 15 *.IF XADRS *CLR ADRSP *MOV @MAPVEC(ADRSP),MAP *.ENDC *LI BK,BACK      LK .WORD START  SYSSN .BLOCK 14 *.WORD TRAPSNAP *.WORD XEQERR  ;  ;THE FIRST THING TO EXECUTE ...  START LIMI 0 *LWPI INTPWS ; LOAD INTERPRETER WORKSPACE POINTER *BL INIT ; SET UP INITIAL STATE OF P-MACHINE *MOV SYSCLR,CLROP ; SYSTEM CLEAR CALL *XOP CLROP,5 ; CALL THE BIOS *LIMI 15 *.IF XADRS *CLR ADRSP *MOV @MAPVEC(ADRSP),MAP *.ENDC *LI BK,BACK  ;  ;****************************************************************************   ; SHORT LOAD CONSTANT  SLDCI .WORD $0  $0 SRL R1,1 ; GET OPCODE BACK TO ITS TRUE VALUE (PUSHWORD R1 ; PUSH THE OPCODE ONTO THE STACK (B *BK  ;  ; SHORT LOAD LOCALS  ; R1 HAS OPCODE (DOUBLED TO 64...94) NORMALIZE BY SUBTRACTING 62.  SLDLS .WORD $0 *B *BK ; BEGIN EXECUTION AT FETCHI LOOP  ;  ; THE INCLUDE FILES ... *.NOLIST *.IF LSTDECL *.LIST *.ENDC *.TITLE "DECLARATION OF CONSTANTS, VARIABLES, AND RECORDS" * *.INCLUDE P4.DECL1.TEXT *.INCLUDE PX.DECL2.TEXT *.NOLIST *.IF LSTTABS *.LIST *.ENDC *.TITLE "DECLARATION OF TABLES" * *.INCLUDE P4.TABL.TEXT *.NOLIST *.IF LSTMACS *.LIST *.ENDC *.TITLE "INTERPRETER MACROS AND WORD GET ROUTINE" *.PAGE *.INCLUDE P4.MACRO.TEXT *.NOLIST *.IF  $0 A MP,R1 ; ADD MSCW POINTER TO OFFSET IN R1 (PUSHWORD MSDLTA-SLDLNORM(R1) ; PUSH THE WORD POINTED AT (B *BK  ;  ; SHORT LOAD GLOBALS  ; R1 HAS OPCODE (DOUBLED TO 96...126) NORMALIZE BY SUBTRACTING 94.  SLDOS .WORD $0  $0 A BASE,R1 ; ADD LEX LEVEL 0 POINTER TO OFFSET (PUSHWORD MSDLTA-SLDONORM(R1) ; PUSH THE WORD POINTED AT (B *BK  ;  ; SHORT INDEX AND LOAD  ; R1 CONTAINS 240...254  SSINDS .WORD $0  $0 AI R1,-SIND LSTIFJP *.LIST *.ENDC *.TITLE "IFETCH LOOP AND JUMP INSTRUCTIONS" * *.INCLUDE P4.IF&JMP.TEXT  *.NOLIST *.IF LSTLDSTR *.LIST *.ENDC *.TITLE "LOAD AND STORE INSTRUCTIONS" * *.INCLUDE P4.LD&STR.TEXT  *.NOLIST *.IF LSTPROC *.LIST *.ENDC *.TITLE "PROCEDURE CALL AND RETURN INSTRUCTIONS" * *.INCLUDE P4.PROC.TEXT  *.NOLIST *.IF LSTPFCMP *.LIST *.ENDC *.TITLE "PACKED FIELD AND COMPARISON INSTRUCTIONS" * *.INCLUDE P4.PF&CMP.TEXT  *.NOLIST NORM ; NORMALIZE OPCODE TO 0...14 (A *SP,R1 ; ADD TO IT THE WORD POINTER ON TOS (MOV *R1,*SP ; GET THE WORD IT POINTS TO (B *BK  ;  ;  ; NO OPERATION  NONE .WORD BACK ; RIGHT BACK TO I-FETCH   ;  ;  ; LOAD BYTE  LDB .WORD $0  $0 MOV *SP+,R1 ; ADD TOS+ TOS-1 (A *SP,R1 ; THEIR SUM (CLR *SP ; CLEAR TOS BEFORE LOADING THE BYTE (MOVB *R1,1(SP) ; GET BYTE POINTED TO BY SUM *.IF LSTSETS *.LIST *.ENDC *.TITLE "SET INSTRUCTIONS" * *.INCLUDE P4.SET.TEXT  *.NOLIST *.IF LSTTASK *.LIST *.ENDC *.TITLE "TASK INSTRUCTIONS" * *.INCLUDE P4.TASK.TEXT  *.NOLIST *.IF LSTCSP *.LIST *.ENDC *.TITLE "STANDARD PROCEDURES" * *.INCLUDE P4.CSP1.TEXT *.INCLUDE PX.CSP2.TEXT *.INCLUDE P4.CSP3.TEXT *.NOLIST *.IF LSTRSP *.LIST *.ENDC *.TITLE "RUNTIME SUPPORT PACKAGE" * *.INCLUDE P4.RSP1.TEXT *.PAGE *.INCLUDE P4.RSP2.TEXT * *(B *BK  ;  ; STORE BYTE  STB .WORD $0  $0 MOV 2(SP),R1 ; ADD (TOS-1) + (TOS-2) (A 4(SP),R1 ; SUM GIVES THE BYTE ADDRESS (MOVB 1(SP),*R1 ; STORE TOS INTO THAT BYTE (AI SP,6 ; POP 3 WORDS (6 BYTES) OFF STACK (B *BK  ;  ; STATIC INDEX AND LOAD WORD  IND .WORD GET_BIG ; GET THE WORD POINTER INDEX (SLA R3,1 ; DOUBLE FOR WORD ADDRESSING (A *SP,R3 ; ADD IT TO WORD POIN.NOLIST *.IF LSTSYMS *.LIST *.ENDC *.TITLE " "  *.END  TER (MOV *R3,*SP ; PUSH THE WORD POINTED AT (B *BK  ;  ; INCREMENT FIELD POINTER  IINC .WORD GET_BIG ; GET WORD POINTER INDEX (SLA R3,1 ; DOUBLE FOR WORD INDEXING (A R3,*SP ; INDEX THE WORD POINTER (TOS) (B *BK  ;  ; INDEX ARRAY  IXA .WORD GET_BIG ; GET WORD SIZE OF ARRAY ELEMENT (MOV *SP+,R0 ; THE INDEX VALUE (JEQ $1 ; JUMP IF 0 O^¢q„c(MPY R3,R0 ; INDEX VALUE * WORD SIZE (SLA R1,1 ; DOUBLE RESULT FOR WORD ADDRESSING (A R1,*SP ; ADD TO ADDRESS ON TOS  $1 B *BK  ;  ;  ;PUSH NIL VALUE ON STACK  LDCN .WORD $0  $0 DECT SP (CLR *SP (B *BK  ;  ; LOAD CONSTANT WORD (LONG INTEGER CONSTANT)  LDCI .WORD GET_2BYTE (MOVB @INTPWS+7,R4 (PUSHWORD R4 (B *BK   ;  ; LOAD LOCAL WORD  LDL .WORD GET_BIG *SLA R3,1 Q% ; DBL FOR WORD ADDRESSING *A MP,R3 *PUSHWORD MSDLTA(R3) *B *BK  ;  ; LOAD LOCAL ADDRESS  LLA .WORD GET_BIG *SLA R3,1 ; DBL FOR WORD ADDRESSING *MOV R3,R1 *AI R1,MSDLTA *JMP LLA0  SLLA .WORD $0  $0 AI R1,MSDLTA-190  ANDI R1,0FFFEH  LLA0 A MP,R1 ; ADDRESS NOW IN R1 *PUSHWORD R1 ; PUSH ADDRESS *B *BK  ;  ; STORE LOCAL WORD  STL .WORD GET_BIG  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ;       MP,R2 *MOV R3,R3 ; GET NUMBER OF LINKS TO TRAVERSE *JEQ $2 ; NO TRAVERSAL IF ZERO  $1 MOV *R2,R2 ; DO THE TRAVERSALS *DEC R3 *JGT $1  $2 PUSHWORD R2 ; PUSH THE RESULT OF THE TRAVERSAL *B *BK  ;  ;  LDCB .WORD GET_BYTE ; LOAD CONSTANT BYTE *PUSHWORD R3 ; AND PUSH IT ONTO STACK *B *BK  ;  ; MOVE WORDS. TOS POINTS TO SOURCE BLOCK. TOS-1 TO DESTINATION.  ; *DEC R4 ; UNTIL DELTA LL # IS 0 *JGT $1 *SLA R3,1 ; DBL FOR WORD ADDRESSING *A R2,R3 ; R3 NOW HAS ADDRESS *PUSHWORD @MSDLTA(R3) ; PUSH CONTENTS AT THAT ADDRESS *B *BK  ;  ;LOAD INTERMEDIATE ADDRESS  LDA .WORD GET_BIG1 *MOV MP,R2 ; POINT R2 AT STATIC LINK  $1 MOV *R2,R2 ; LINK DOWN DELTA LL'S *DEC R4 ; UNTIL DELTA LL = 0 *JGT $1 *SLA R3,1 *AI R MMOV .WORD GET_BIG1 (MOV R3,R1 ; SETUP # OF WORDS (JEQ BLKRTN ; SKIP IF 0 (MOV *SP+,R3 ; SOURCE ADDRESS (MOV *SP+,R2 ; DEST. ADDRESS (MOV R4,R5 ; MODE (JEQ BLKTRAN  A @SEG,R3  ;  ; USED BY LDC AND MMOV TO TRANSFER A BLOCK, FLIPPING IT IF NEEDED.  ; R2 = DESTINATION ADDRESS R3 = SOURCE ADDRESS  ; R1 = # WORDS TO MOVE R5 = MODE (2=FLIPPED)  ;  BLKTRAN2 .IF XADRS  MOV MAP,R0 *JM3,MSDLTA *A R2,R3 ; R3 HAS THE ADDRESS *PUSHWORD R3 ; PUSH THAT ADDRESS *B *BK  ;  ; STORE INTERMEDIATE WORD  STR .WORD GET_BIG1 *MOV MP,R2 ; POINT R2 AT STATIC LINK  $1 MOV *R2,R2 ; LINK DOWN *DEC R4 ; UNTIL # OF LINKS = 0 *JGT $1 *SLA R3,1 *A R2,R3 ; R3 HAS ADDRESS NOW *MOV *SP+,@MSDLTA(R3) ; POP STACK INTO THAT ADDRESS *B *BK  ;  ; STORE INDIRECT  STO .WORD $0 P BLKTRAN3  BLKTRAN MOV @MAPVEC,R0  BLKTRAN3  .ELSE  BLKTRAN *.ENDC *C SEXOK,TRUE ; DOES THIS SEGMENT HAVE THE RIGHT SEX? *JEQ $3 *CI R5,2 ; DOES THIS BLOCK NEED TO BE FLIPPED? *JNE $3  $1 .IF XADRS *LDS *R0 *.ENDC  MOV *R3+,*R2+ ; MOVE WITH FLIPPING *SWPB -2(R2) ; FLIP IT *DEC R1 ; DECR THE WORD COUNTER *JGT $1 *B *BK  $0 MOV 2(SP),R1 ; CONTENTS OF TOS-1 (MOV *SP+,*R1 ; POP STACK TO WHERE CONTENTS OF TOS-1 POINT (INCT SP ; AND NOW POP THE POINTER (B *BK  ;  ;  ; THIS ROUTINE IS USED BY LDE, LAE, AND STE TO LOAD AN EXTENDED ADDRESS IN R4  GETEA *SLA R4,1 ; DOUBLE FOR BYTE ADDRESS *A @EVEC,R4 ; GET POINTER TO EREC *MOV *R4,R4 ; GET EREC *MOV @ENVDATA(R4),R4 ; GET GLOBAL DATA SEGMENT POINTER *SLA R3,1  $3 .IF XADRS *LDS *R0 *.ENDC *MOV *R3+,*R2+ ; MOVE WITHOUT FLIPPING *DEC R1 ; DECR THE WORD COUNTER *JGT $3  BLKRTN B *BK   ;  LDC .WORD $0  $0 MOV IPC,@IPCFLT ; SET IPCFLT FOR STACK CHECK COMING UP (DEC @IPCFLT (LI R2,$1 (B @GET_BIG1 ; PICKUP FIRST TWO OPERANDS  $1 MOV R4,R5 ; SHUFFLE THEM UP (KLUDGE PRE-FETCH DUE TO (MOV R3,R4 ; SPECIAL OPERAND FORMAT ; DOUBLE FOR BYTES *A R3,R4 ; ADD IN TO GET FINAL ADDRESS  B *R11  ;  ; LOAD EXTENDED WORD  LDE .WORD GET_BIG1 *BL @GETEA ; GET EXTENDED ADDRESS *PUSHWORD @MSDLTA(R4) ; PUSH VALUE ON STACK *B *BK  ;  ; LOAD EXTENDED ADDRESS  LAE .WORD GET_BIG1 *BL @GETEA ; GET EXTENDED ADDRESS *AI R4,MSDLTA *PUSHWORD R4 ; PUSH ADDRESS ON STACK *B *BK  ;  ; STORE EXTENDED WORD  BYTE,BIG,BYTE) (LI R2,$2 (B @GET_BYTE ; GET LAST OPERAND  $2 MOV R3,R1 ; SAVE WORD COUNT IN R1 (JNE RLCONST (B *BK ; NOW WHO'S EVER GONNA DO THIS?  RLCONST SLA R3,1 (MOV R3,@STKEXT ; SETUP FOR STACK CHECK (MOV R4,R3 (MOV @EREC,@SAVEREC (BL @STKCHK ; GO DO STACK CHECK (S R1,SP ; MUST'VE MADE IT...MAKE ROOM ON STACK (S R1,SP (MOV SP,R2 ; STACK IS DESTINATION ADDRESS  STE .WORD GET_BIG1 *BL @GETEA ; GET EXTENDED ADDRESS *MOV *SP+,@MSDLTA(R4) ; POP VALUE AND STORE *B *BK  ;  ; LOAD MULTIPLE WORDS  LDM .WORD GET_BYTE *MOV IPC,IPCFLT ; SAVE IPC IN CASE OF FAULT *DECT @IPCFLT ; WORD COUNT *SLA R3,1 ; MAKE IT A BYTE COUNT *MOV R3,STKEXT ; SET UP STKCHK CALL *MOV EREC,SAVEREC *BL STKCHK ; CHECK FOR STACK OVERFLOW *MOV *SP+,R2 ; TOS IS BLOCK ADDRE(SLA R3,1 ; SOURCE OFFSET IN BYTES (A @CPOOL,R3 (JMP BLKTRAN2 ; OFF TO BLOCK TRANSFER  ;  ;  LCO .WORD GET_BIG ; LOAD CONSTANT OFFSET *SLA R3,1 ; DOUBLE FOR BYTE ADDRESSING *A @CPOFST,R3 *PUSHWORD R3 ; AND PUSH IT *B *BK  ;  ;  SWAP .WORD $0 ; SWAP TOS WITH TOS-1  $0 MOV *SP,R1 ; SAVE TOS *MOV 2(SP),*SP ; REPLACE IT WITH TOS-1 *MOV R1,2(SP) SS *A STKEXT,R2 ; MOVE POINTER TO END OF BLOCK *DECT R2 ; POINTS AT LAST WORD OF BLOCK *CI R3,0 ; ANY WORDS TO MOVE? *JEQ $2 ; JUMP IF ZERO COUNT  $1 PUSHWORD *R2 ; PUSH WORD POINTED TO BY R2 *DECT R2 ; DECREMENT BLOCK POINTER *DECT R3 ; DECREMENT WORD COUNT *JGT $1 ; JUMP BACK IF > 0 WORDS LEFT  $2 B *BK  ;  ; STORE MULTIPLE WORDS *SLA R3,1 ; DBL FOR WORD ADDRESSING *MOV R3,R1 *JMP STL0  SSTL .WORD $0  $0 AI R1,-206  STL0 A MP,R1 ; LOCATION IN R1 *MOV *SP+,MSDLTA(R1); STORE TOP OF STACK *B *BK  ;  ; LOAD GLOBAL WORD  LDO .WORD GET_BIG *SLA R3,1 *A BASE,R3 *PUSHWORD MSDLTA(R3) *B *BK  ;  LAO .WORD GET_BIG *SLA R3,1 *A BASE,R3 *AI R3,MSDLTA ; ADDRESS IN R3 *PUSHWORD R3  STM .WORD GET_BYTE *JEQ $2 ; JUMP IF ZERO COUNT *MOV SP,R1 *A R3,R1 ; MOVE POINTER TO *A R3,R1 ; THE END OF BLOCK *MOV *R1,R1 ; GET DESTINATION ADDRESS  $1 MOV *SP+,*R1+ ; STORE WORD FROM STACK *DEC R3 ; DECREMENT WORD COUNT *JGT $1  $2 INCT SP ; POP ADDRESS WORD *B *BK   ;  ;  LSL .WORD GET_BYTE ; LOAD STATIC LINK *MOV  ; PUSH ADDRESS *B *BK  ;  ; STORE GLOBAL WORD  SROS .WORD GET_BIG *SLA R3,1 *A BASE,R3 *MOV *SP+,MSDLTA(R3) *B *BK  ;  ; LOAD INTERMEDIATE WORD  SLOD1 .WORD GET_BIG *LI R4,1 *JMP LOD0  SLOD2 .WORD GET_BIG *LI R4,2 *JMP LOD0  LOD .WORD GET_BIG1  LOD0 MOV MP,R2 ; ACTIVATION RECORD  $1 MOV *R2,R2 ; LINK DOWN LEX LEVELS       ; REPLACE TOS-1 WITH TOS *B *BK  ;  ;  DUP1 .WORD $0 ; DUPLICATE TOP OF STACK  $0 PUSHWORD 2(SP) *B *BK  ;  ;  DUPREAL .WORD $0 ; DUPLICATE REAL TOP OF STACK  $0 MOV SP,R1 (AI SP,-8 (MOV SP,R2 (MOV *R1+,*R2+ (MOV *R1+,*R2+ (MOV *R1+,*R2+ (MOV *R1,*R2 (B *BK  ;  ;  LPR .WORD $0  $0 MOV *SP+,R1 ; GET THE REGISTER NUMBER  SUPPRESS EVENTS *.MACRO QUIET *BIOS QOP *.ENDM  ;  ; ALLOW EVENTS *.MACRO ENABLE *BIOS EOP *.ENDM  ;  ; TURN ON TASK SWITCH *.MACRO TSON *MOV JMPB3,BACK ; MODIFY IFETCH LOOP FOR TASKSWITCH *.ENDM  ;  ; TURN OFF TASK SWITCH *.MACRO TSOFF *MOV NOOP,BACK ; RESET IFETCH LOOP FOR IFETCH *.ENDM  ;  ;  ;***********************************************************  ; (SLA R1,1 ; POSITIVE, SO IT IS OFFSET INTO TIB (JLT $1 ; IT IS -1, -2, OR -3 (A CURTASK,R1 ; NOW POINTS TO THE PROCESSOR REGISTER (BL @SAVREG (PUSHWORD *R1 ; NOW PUSH THE PROCESSOR REGISTER (B *BK  $1 PUSHWORD POINTERS(R1) ; PUSH THE PROCESSOR REGISTER (B *BK  ;  ;  SPR .WORD $0  $0 MOV *SP+,R0 ; NEW REGISTER VALUE (MOV *SP+,R1 ; REGISTER # (SLA R1,1 ; DOUB ;********** BIOS MACROS **********  ;  ;*********************************************************** * *.MACRO BIOS ; INVOKE THE BIOS *XOP %1,5 *.ENDM  ; *.MACRO DISPLAY ; DISPLAY ON CONSOLE *XOP %1,4 *.ENDM  ; *.MACRO CHKRSLT ; CHECK IORESULT *MOV BIOSRSLT+%1,IORESULT *JNE %2 *.ENDM  ; *.MACRO CHKSPEC ; CHECK SPECIAL-CHAR BIT OF CONTROL WORD *MOV TRUE,CONTWORD ; FOR NOW GUARANTEE TRUE => SPEC BIT ON ( .ENLE NOW (JLT $1 (BL @SAVREG ; UPDATE CURRENT STATE (A @CURTASK,R1 ; OFFSET INTO TIB (MOV R0,*R1 ; UPDATE WHATEVER HE SAID TO UPDATE (MOV BK,R11 (B @RESTOR ; RESTORE NEW STATE, RETURNING TO I-FETCH  $1 MOV R0,@POINTERS(R1) ; THIS IS MUCH EASIER ANYWAY... (B *BK  DM   ;***********************************************************  ;  ; COMMON SUBROUTINES  ;  ;***********************************************************   ;  ; SEG_CHWD ALWAYS CHECKS THE SEGMENT SEX FLAG TO SEE IF A BYTE-FLIP IS  ; IN ORDER. SEG_WORD NEVER CHECKS.  ;  ; PASSED: R1= ADDRESS IN CURRENT SEGMENT  ;  ; RETURNED: R1= ADDRESS AUTO-INCREMENTED  ; R2= VALUE OF WORD IN SEGMENT  ;  .IF XADRS ; with additional address spaces... O^£Į„c SEG_WORD LDS *MAP *MOV *R1+,R2 *B *R11  SEG_CHWD LDS *MAP *MOV *R1+,R2 *MOV @SEXOK,@SEXOK *JNE $1 *SWPB R2  $1 B *R11 *.ELSE ; without additional address spaces...  SEG_WORD MOV *R1+,R2 *B *R11  SEG_CHWD MOV *R1+,R2 *MOV @SEXOK,@SEXOK *JNE $1 *SWPB R2  $1 B *R11 *.ENDC *  1F ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ; O^¢–¤„ ;  ;****************************************************************************   ;***********************************************************  ;  ;********** MACRO DEFINITIONS **********  ;  ;*********************************************************** * *.MACRO PUSHWORD *DECT SP ; DECREMENT THE STACK POINTER *MOV %1,*SP ; PUSH A WORD ONTO THE STACK *.ENDM  ;  ; *.MACRO RT *B *R11 *.ENDM aƒ‚ ;  ; *.MACRO TRAP *BL @TRAPER ; CALL TRAPER *.WORD %1 ; XEQERR *.ENDM  ;  ; *.MACRO BOOLCOMP *MOV *SP+,R1 ; GET TOS *MOV *SP,R2 ; ALSO TOS-1 *ANDI R1,1 ; LEAVE ONLY BIT 0 *ANDI R2,1 ; ONLY BIT 0 *C R2,R1 ; NOW COMPARE THEM *.ENDM   ;  ;  .MACRO STMAP2 *; set base into bias of all zones *MOV %1,2(%2) *MOV %1,6(%2) *MOV %1,10(%2) *.ENDM  ;  ;  ;        ; REMAINDER OF TOS-1/TOS  $0 MOV *SP+,R3 ; DENOMINATOR:=TOS *JEQ DIVZERR ; IF DENOMINATOR=0 THEN DIVZERROR *MOV *SP,R2 ; NUMERATOR:=TOS *PUSHWORD R3 ; SAVE DENOMINATOR *ABS R3 ; DENOMINATOR:=ABS(DENOMINATOR) *ABS R2 ; NUMERATOR:=ABS(NUMERATOR) *CLR R1 ; PREPARE NUMERATOR FOR 32-BIT DIVISION *DIV R3,R1 ; DIVIDE *MOV *SP+,R3 ; ADDRESS OF WORD CONTAINING THE FIELD *MOV *R3,R3 ; GET THAT WORD *X RSHIFTS(R1) ; RIGHT SHIFT THE FIELD IN R3 *MOV ONMASKS(R2),R4 ; LOAD THE MASK *INV R4 ; GET READY FOR THE 'AND' OPERATION *SZC R4,R3 ; CHUCK GARBAGE BITS IN FIELD WORD *PUSHWORD R3 ; AND PUSH THE CLEAN FIELD ON THE STACK *B *BK  ;  ;  ; STORE A PACKED FIELD  STP .WORD $0  $0 MOV *SP+,R1 ; G*MOV *SP+,R3 ; RESTORE DENOMINATOR *JLT $01 ; NO TWIDDLING IF DENOM NEGATIVE *MOV *SP,R1 ; AND NUMERATOR *JGT $01 ; IF NUMERATOR < 0 *CI R2,0 ; AND REMAINDER <> 0 *JEQ $01 *S R2,R3 ; THEN REM:= DENOM - REM " MOV R3,R2  $01 MOV R2,*SP ; PUSH REMAINDER *B *BK  ;  DVI .WORD $0 ; DIVIDE TOS-ET THE DATA VALUE FROM TOS *MOV *SP+,R2 ; FIELD RIGHTMOST BIT *SLA R2,1 ; DBL FOR WORD ADDRESSING LATER *MOV *SP+,R3 ; THE FIELD WIDTH *SLA R3,1 ; FOR WORD ADDRESSING *MOV ONMASKS(R3),R4 ; GET THE BIT MASK *INV R4 ; GET READY FOR THE 'AND' OPERATION *SZC R4,R1 ; ZAP GARBAGE BITS IN DATA VALUE WORD *MOV R1,R0 ; SAVE IT IN A SCRATCH REGISTER FOR LATER 1 BY TOS  $0 CLR R0 ; DENOMSIGN:=POSITIVE (*INITIALLY*) *CLR R4 ; NUMERSIGN:=POSITIVE (*INITIALLY*) *MOV *SP+,R3 ; DENOMINATOR:=TOS *JEQ DIVZERR ; IF DENOMINATOR=0 THEN DIVZERROR *JGT $1 ; ELSE IF NOT POSITIVE *SETO R4 ; THEN DENOMSIGN:=NEGATIVE FLAG *ABS R3 ; DENOMINATOR:=ABS(DENOMINATOR)  $1 MOV *SP,R2 ; NUMERATOR:="TOS-1" *X LSHIFTS(R2) ; LEFT SHIFT THE VALUE IN R1 *MOV R1,TEMP ; AND SAVE IT *MOV ONMASKS(R3),R1 ; BIT MASK *INV R1 ; COMPLEMENT IT TO FORM CORRECT MASK *SOC R1,R0 ; SET REST OF DATA VALUE WORD TO ALL 1'S *INV R1 ; GET READY FOR 'AND' OPERATION *SZC R1,R0 ; NOW ZERO THE FIELD PART OF THE WORD *X CIRCTABL(R2) ; CIRCULAR SHIFT THE FIELD IN R0 *MOV *SP+,R1 ; ADDRESS WHERE FIELD IS TO BE STO*JEQ $4 ; IF NUMERATOR=0 THEN DIVISION EASY *JGT $2 ; ELSE IF NOT POSITIVE *SETO R0 ; THEN NUMERSIGN:=NEGATIVE FLAG *ABS R2 ; NUMER:=ABS(NUMER)  $2 CLR R1 ; (*PREPARE FOR DIVIDE*) *DIV R3,R1 ; DIVIDE *XOR R0,R4 ; IF (BOTH NEG) OR (BOTH POSITIVE) *JEQ $3 ; THEN NOT NEGATIVE *NEG R1 ; ELSE NEGATE RED *INV R0 ; READY FOR 'AND' OPERATION *SZC R0,*R1 ; 'AND' THE ZEROED FIELD INTO THAT WORD *SOC TEMP,*R1 ; FINALLY, 'OR' THE ACTUAL FIELD INTO IT *B *BK ; FINISHED  ;  ;  ; INDEX A PACKED F IELD  IXP .WORD GET_2BYTE *CLR R0 ; FOR DIV COMING UP *MOV *SP+,R1 ; INDEX VALUE ( THE ELEMENT WANTED) *DIV R4,R0 ; DIV INDEX VALUE BY # ELEMENTS PER WORD QUOTIENT  $3 MOV R1,*SP ; TOS:=QUOTIENT  $4 B *BK  DIVZERR TRAP DIVZER  ;  ;  MPI .WORD $0 ; MULTIPLY TOS WITH TOS-1  $0 MOV *SP+,R1 *MPY *SP,R1 *MOV R2,*SP ; PUSH RESULT *B *BK  ;  ;  CCHK .WORD $1 ; CHECK INDEX OR RANGE. RUNTIME ERROR IF NOT: C; (MIN) TOS-1 <= TOS-2 <= TOS (MAX)  $1 MOV *SP+,R1 ; TOS (THE MAX INDEX) *SLA R0,1 ; DOUBLE RESULT FOR WORD INDEXING *A R0,*SP ; GIVES POINTER TO WORD CONTAINING THE FIELD *PUSHWORD R3 ; PUSH IT NOW ALSO *MOV R1,R0 ; GET REMAINDER FROM THE DIVISION *MPY R3,R0 ; MPY BY THE FIELD WIDTH (RESULT IN R1) *PUSHWORD R1 ; PUSH THE RESULT (FIELD RIGHTMOST BIT #) *B *BK   ;********** LOGICAL AND INTEGER COMPARISONS **********  ;  ;  LAND .WORD $0 ; AND T*MOV *SP+,R2 ; TOS-1 (THE MIN INDEX) *C *SP,R1 ; IS THE INDEX GTR THAN MAX? *JGT $0 ; YES *C *SP,R2 ; IS IT LESS THAN MIN? *JLT $0 ; YES *B *BK ; EVERYTHING OK  $0 TRAP INVNDX ; FLAG INVALID INDEX  ;  ;  ;********** COMPARISON OPERATORS **********  ;  ;  ; COMPARE COMPARES TWO BYTE ARRAYS.  ; R0 = TOS ADDRESS R4 = TOS SIZE  ; R2 = TOS-1 ADDRESS OS INTO TOS-1  $0 INV *SP *SZC *SP+,*SP *B *BK  ;  LOR .WORD $0 ; OR TOS INTO TOS-1  $0 SOC *SP+,*SP *B *BK  ;  LNOT .WORD $0 ; ONE'S COMPLEMENT TOS  $0 INV *SP *B *BK  ;  BNOT .WORD $0  $0 MOV *SP,R1 *INV R1 *ANDI R1,1 *MOV R1,*SP *B *BK  ;  ABI .WORD $0 ; ABSOLUTE VALUE OF TOS  $0 ABS *SP  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ; *B *BK  ;  INCI .WORD $0  $0 INC *SP *B *BK  ;  DECI .WORD $0  $0 DEC *SP *B *BK  ;  ADI .WORD $0 ; ADD INTEGERS  $0 A *SP+,*SP *B *BK  ;  NGI .WORD $0 ; TWO'S COMPLEMENT TOS  $0 NEG *SP *B *BK  ;  SBI .WORD $0 ; SUBTRACT TOS FROM TOS-1  $0 S *SP+,*SP *B *BK  ;  MODI .WORD $0  ;  ;****************************************************************************   ;  ;********** PACKED FIELD INSTRUCTIONS **********  ;  ;  ; LOAD A PACKED FIELD  LDP .WORD $0  $0 MOV *SP+,R1 ; RIGHTMOST BIT OF FIELD *SLA R1,1 ; DBL FOR WORD ADDRESSING *MOV *SP+,R2 ; FIELD WIDTH *SLA R2,1 ; FOR WORD ADDRESSING        R6 = TOS-1 SIZE  ; R3 = USED AS COUNTER R5 = FLAG  ;  COMPARE C R6,R4 ; COMPARE LENGTHS (JGT $1 (MOV R6,R3 (JMP $2  $1 MOV R4,R3 ; R3 = MIN(R4,R6)  $2 JEQ $3 ; IF MIN=0 THEN SKIP TO END (MOV @$4(R5),R5 (B *R5 ; INDEX THRU TABLE  $4 .WORD $5 ; 0 (.WORD $6 ; 2 (.WORD $7 ; 4 (.WORD $8 ; 6  CLR R6 (LDS *R7 (.ELSE  $3 CLR R6 (.ENDC (MOVB *R2+,@INTPWS+13 (B @COMPARE  ;  ;  ;********** STRING MANIPULATION **********  ;  ;  ASTR .WORD GET_2BYTE ; ASSIGN STRING (MOV *SP+,R1 ; R1 = SOURCE ADDRESS (MOV *SP+,R2 ; R2 = DEST ADDRESS  CLR R5 ; SETUP FOR BYTE SIZE (MOV R4,R4 (JEQ $1 ; SEGMENT ADDRESS? (A @SEG,R1 ; ADD IN SEG  .IF XADRS  $5 CB *R2+,*R0+ ; COMPARE STRINGS, BOTH IN CPU-RAM (JNE PUSHRSLT (DEC R3 (JGT $5 (JMP $3 (.IF XADRS  $6 LDD *MAP ; COMPARE STRINGS, 2ND VIA PORT (CB *R2+,*R0+ (JNE PUSHRSLT (DEC R3 (JGT $6 (JMP $3  $7 LDS *MAP ; COMPARE STRINGS, 1ST VIA PORT (CB *R2+,*R0+ (JNE PUSHRSLT (DEC R3 (JGT $7 (JMP $3  $8 LDS *MAP ; COMPARE STRINGS, BOTH VIA PORT (MOVB *R2+(MOV MAP,R0 (JMP $2  $1 MOV @MAPVEC,R0  $2 LDS *R0 (MOVB *R1,@INTPWS+11 (.ELSE  $1 MOVB *R1,@INTPWS+11 ; CPU-RAM, PICKUP SOURCE BYTE SIZE (.ENDC (C R5,R3 ; CAN WE MAKE THIS ASSIGNMENT? (JGT $3 (INC R5 ; INCLUDE SIZE BYTE IN STRING SIZE  $4 .IF XADRS (LDS *R0 (.ENDC (MOV *R1+,*R2+ ; WORD ASSIGNMENT HERE (DECT R5 (JGT $4 (B *BK ; RETURN TO I-FETCH  $3 TRAP S,R7 (LDD *MAP (CB R7,*R0+ (JNE PUSHRSLT (DEC R3 (JGT $8 (.ELSE  $6 JMP $5 ; COMPARE STRINGS, 2ND VIA PORT  $7 JMP $5 ; COMPARE STRINGS, 1ST VIA PORT  $8 JMP $5 ; COMPARE STRINGS, BOTH VIA PORT (.ENDC  $3 C R6,R4 ; STRINGS MATCH, LET'S COMPARE LENGTH AGAIN...  ; AND FALL INTO PUSHRSLT  PUSHRSLT 2LONG ; OOPS - STRING SIZE ERROR  ;  ;  CSTR .WORD $0 ; CHECK STRING INDEX  $0 MOV *SP,R2 ; SET R2=VALUE OF INDEX *MOV 2(SP),R1 ; SET R1=ADDRESS OF STRING *CLR R3 ; SET R3=LENGTH OF STRING *MOVB *R1,@INTPWS+7 *CI R2,1 ; IS INDEX < 1? *JLT $1 *C R2,R3 ; IS INDEX > LENGTH OF STRING? *JGT $1 *B *BK ; FAT CITY, RETURN  ; PUSHES THE RESULT OF THE CONDITION CODES GIVEN THE COMPARISON TYPE.  ; R0 SPECIFIES WHICH ENTRY TO USE IN THE COMPTABL TABLE. *X *R1 ; SKIP TO PUTFLS IF NEEDED C; ELSE FALL TO PUTTRU  PUTTRU MOV TRUE,*SP *B *BK  PUTFLS CLR *SP *B *BK  COMPTABL JNE PUTFLS-PUTTRU+$+2 ; 0 EQ *JEQ PUTFLS-PUTTRU+$+2 ; 2 NEQ *JGT PUTFLS-PUTTRU+$+2 ; 4 LE *JLT PUTFLS-PUTTRU+$+2 ; 6 GE *JH  $1 TRAP INVNDX ; ERROR - INVALID INDEX   PUTFLS-PUTTRU+$+2 ; 8 ULE *JL PUTFLS-PUTTRU+$+2 ; 10 UGE  CMP2TABL JNE PUTFLS-PUTTRU+$+2 ; 0 EQ *JH PUTFLS-PUTTRU+$+2 ; 2 ULE *JL PUTFLS-PUTTRU+$+2 ; 4 UGE  CMP3TABL JNE PUTFLS-PUTTRU+$+2 ; 0 EQ REAL NUMBER COMPARES *JGT PUTFLS-PUTTRU+$+2 ; 2 LE *JLT PUTFLS-PUTTRU+$+2 ; 4 GE   ;  ;  EQUI ; INTEGER EQUAL COMPARE  NEQI ; INTEGER NOT EQUAL COMPARE  LEQI ; INTEGER LESS THAN OR EQUAL COMPARE  GEQI ; INTEGER GREATER THAN OR EQUAL COMPARE  LEQU ; UNSIGNED LESS THAN OR EQUAL COMPARE  GEQU .WORD $0 ; UNSIGNED GREATER OR EQUAL COMPARE  $0 AI R1,COMPTABL-352 ; NORMALIZE PCODE USING EQUI=2*176=352 *C 2(SP),*SP+ *B PUSHRSLT  ;  ;  EQBYT  LEBYT  O^£±„ƒ GEBYT .WORD GET_BIG2 (AI R1,CMP2TABL-370 ; NORMALIZE PCODE USING EQBYT=2*185=370 (MOV R3,R6 ; R3 = BYTE SIZE (CLR R3 ; R3 BECOMES INDEX USED IN COMPARE (MOV *SP+,R0 (MOV *SP,R2 (MOV R5,R5 (JEQ $1 (A @SEG,R0 (INCT R3  $1 MOV R4,R4 (JEQ $2 (A @SEG,R2 (AI R3,4  $2 MOV R3,R5 (MOV R6,R4 (B @COMPARE (  EQSTR  LESTR  GESTR .WORD GET_2BYTE ‘‚(AI R1,CMP2TABL-464 ; NORMALIZE PCODE USING GESTR=2*232=464 (CLR R5 (MOV *SP+,R0 (MOV *SP,R2 (MOV R4,R4 (JEQ $1 (A @SEG,R0 (INCT R5  .IF XADRS (MOV MAP,R7 (JMP $4  $1 MOV @MAPVEC,R7  $4 CLR R4 (LDS *R7 (.ELSE  $1 CLR R4 (.ENDC (MOVB *R0+,@INTPWS+9  $2 MOV R3,R3 (JEQ $3 (A @SEG,R2 (AI R5,4  .IF XADRS (MOV MAP,R7 (JMP $5  $3 MOV @MAPVEC,R7  $5       CALLED PROCEDURE  ; R6 = SEG " " " " "  ;  ; AND IT ADDITIONALLY USES: R0-R2  ;  BLDFRM MOV R11,@SAVRTN ; SAVE RETURN ADDRESS (MOV R3,R1 (SLA R1,1 (NEG R1 (A R4,R1 (BL @SEG_WORD ; INDEX INTO PROCEDURE DICTIONARY (SLA R2,1 (A R6,R2 (MOV R2,R1 (BL @SEG_WORD ; POINT AT DATA SIZE (CLR @ASMPROC (SLA R2,1 ; CONVERT TO BYTES (JGT $1 (JEQ $1 (MOV IPC,R2 ; SET IPCFLT IN CASE OF FAULT (AI R2,-3 (MOV R2,@IPCFLT (LI R11,CPG2 (B @SET_LINK ; SET STATIC LINK THEN OFF TO CPG2  CPL .WORD GET_BYTE ; CALL LOCAL PROCEDURE (MOV MP,@STATLINK ; SET LOCAL STATIC LINK  JMP CPG1  CPG .WORD GET_BYTE ; CALL GLOBAL PROCEDURE (MOV BASE,@STATLINK ; SET GLOBAL STATIC LINK  CPG1 MOV IPC,@IPCFLT ; SET IPCFLT IN CASE OF FAULT (DECT @IPCFLT  CPG2 MOV (NEG R2 ; IF NEGATIVE THEN NEGATE (INC @ASMPROC ; AND SET ASSEMBLY PROC FLAG  .IF XADRS (; dissallow calls to assembly language procedures which (; reside in the external code pool (only have 64k virtual addrs) (MOV @ENVSIB(R5),R4 ; get sib pointer in r4 (MOV @SEGPOOL(R4),R4 ; get poolptr in r4 (JEQ $0 ; if poolptr <> nil then (TRAP NOTIMP ; error - not implemented !$0 ; endif (.ENDC  $1 @SEGHI,R4 ; SET R4,R5,R6 FOR BLDFRM (MOV @EREC,R5 (MOV @SEG,R6 (BL @BLDFRM ; BUILD STACK FRAME (B *BK ; ALLES FINISHED... (  CXI .WORD GET_3BYTE ; CALL EXTERNAL INTERMEDIATE PROCEDURE (MOV IPC,@IPCFLT ; SET IPCFLT IN CASE OF FAULT (DECT @IPCFLT (DECT @IPCFLT (LI R11,CXG2 (B @SET_LINK ; SET STATIC LINK THEN OFF TO CXG2  CXL .WORD GET_2BYTE ; CALL EXTERNAL LOCAL PROCEDURE  AI R2,MSCWSZ ; ADD IN MSCW SIZE (MOV @SKIPCHK,R0 ; SKIP STACK CHECK? (JNE $2 (MOV R2,@STKEXT ; SETUP FOR STACK CHECK (MOV R5,@SAVEREC (BL @STKCHK ; STACK CHECK  $2 CLR @SKIPCHK ; WE CAN'T MAKE THIS A REGULAR THING... (MOV @ISCPF,R0 ; IS THIS A CPF CALL? (JEQ $3 (AI SP,6 ; IT IS, WE'D BETTER POP OFF HIS PARMS NOW (CLR @ISCPF ; AND CLEAR THE FLAG (MOV MP,@STATLINK ; SET LOCAL STATIC LINK (JMP CXG1  SCXG1 .WORD GET_BYTE (BL @CSPCHK (MOV @ONE,R5 (JMP SCXGZ  SCXG .WORD GET_BYTE (SRL R1,1 (AI R1,-111 (MOV R1,R5  SCXGZ MOV IPC,@IPCFLT (DECT @IPCFLT (MOV BASE,@STATLINK (JMP CXG2  CXG .WORD GET_2BYTE ; CALL EXTERNAL GLOBAL PROCEDURE (CI R4,1 ; CHECK IF INTERP CSP (JNE $1 ; MUST BE IN SEGMENT 1 (BL CSPCHK  $1 MOV BASE, $3 MOV @ASMPROC,R0 ; IS THIS AN ASSEMBLY PROC? (JEQ $4 (CLR @ASMPROC ; YES, CLEAR FLAG (BL *R1 ; AND JUMP IN... (MOV @EREC,R5 (BL @SEGCHK1 ; RESET PORT, MODE, I-FETCH (BL @CHKSEX ; & SEGHI, SEXOK (B *BK ; DONE WITH THIS PROC CALL (  $4 S R2,SP ; IT'S BEEN SANCTIONED, MAKE ROOM ON STACK (S @SEG,IPC ; SEG-RELATIVIZE IPC (MOV @CURPROC,@MSPROC(SP) ; SET FIELDS IN MSCW @STATLINK ; SET GLOBAL STATIC LINK  CXG1 MOV IPC,R2 ; SET IPCFLT IN CASE OF FAULT (AI R2,-3 (MOV R2,@IPCFLT (MOV R4,R5 ; SETUP FOR SEGCHK  CXG2 BL @SEGCHK ; CHECK FOR SEGMENT PRESENCE  CXG3 MOV R4,R6 ; NEED A COPY OF NEWSEG FOR CHGSIB (BL @CHKSEX ; HAD A SEX CHECKUP LATELY? (BL @BLDFRM ; BUILD UP THE OLD STACK FRAME (BL @CHGSIB ; CHANGE OVER THE SIB, ETC. (MOV @EREC,@MSENV(SP) (MOV IPC,@MSIPC(SP) (MOV MP,@MSDYN(SP) (MOV @STATLINK,@MSSTAT(SP) (MOV R1,IPC ; NEW IPC (MOV R3,@CURPROC ; " CURPROC (MOV SP,MP ; " MP (MOV @SAVRTN,R11 ; RESTORE R11 (B *R11 ; AND RETURN (  ;  ; CHGSIB IS CALLED TO FINISH OFF MOST OF THE CHANGES NECESSARY WHEN SEGMENT  ; BOUNDARIES ARE CROSSED DURING PROCEDURE CALLS OR RETURNS.  ;  ; IT IS PASSED: (B *BK ; MAKE IT OFFICIAL... (  CPF .WORD $0 ; CALL FORMAL PROCEDURE  $0 MOV IPC,@IPCFLT ; SET IPCFLT IN CASE OF FIRE (DEC @IPCFLT (INC @ISCPF ; SET ISCPF FLAG (MOV @2(SP),R5 ; OPERANDS ON STACK, SETUP FOR BLDFRM (BL @SEGCHK1 ; WITHOUT POPPING STACK, IN CASE OF FAULT (MOV *SP,R3 (MOV @4(SP),@STATLINK (JMP CXG3 ; LOOKS LIKE CXG FROM HERE (  SET_LINK MOV MP,R2 ; THE OL' ST ; R5 = EREC FOR SEGMENT CONTROL IS PASSING TO  ; R6 = SEG " " " " " "  ;  ; IT RETURNS:  ; R2 = SIB FOR SEGMENT CONTROL WAS PASSED FROM  ; R5 = SIB " " " IS PASSING TO  ; R6 = SEG " " " " " "  ;  CHGSIB MOV R5,@EREC ; NEW EREC (MOV @ENVEVEC(R5),@EVEC ; " EVEC (MOV @ENVDATA(R5),BASE ; " BASE (MOV @ENVSIB(R5),R5 ; GET NEW SIB (MOV @SIB,R2 ATIC LINK TRAVERSAL (MOV R4,R4 ; STARTING WITH MP (JEQ $2  $1 MOV *R2,R2 ; WALK UP THE STATIC CHAIN (DEC R4 (JGT $1  $2 MOV R2,@STATLINK ; FOUND IT, NOW SET STATIC LINK AND RETURN (B *R11 (  CSPCHK CI R3,MAXCSP (JGT $1 ; WITHIN CSP TABLE (SLA R3,1 (MOV @CSPTABLE-2(R3),R2 (JEQ $2 ; AND HAVE A NON-NIL ENTRY IN TABLE (B *R2 ; ALRIGHT, OFF TO CSP  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ;  $2 SRA R3,1 ; RESET PROCEDURE #  $1 B *R11   ;  ; BLDFRM IS CALLED BY ALL PROCEDURE CALLS TO BUILD THE MSCW AND ACTIVATION  ; RECORD FOR THE CALL. IT IS PASSED:  ;  ; R3 = PROC # CALLED  ; R4 = SEGHI FOR CALLED PROCEDURE  ; R5 = EREC FOR SEGMENT CONTAINING CALLED PROCEDURE  ; R6 = SEG " " " " "  ; STATLINK = STATIC LINK TO SAVE IN MSCW  ;  ; AND IT RETURNS:  ;  ; R5 = EREC FOR SEGMENT CONTAINING  ;  ;****************************************************************************   ;  ;  ;********** PROCEDURE CALL AND RETURN INSTRUCTIONS **********  ;  ;  SCIP1 .WORD GET_BYTE *LI R4,1 *JMP SCIPZ  SCIP2 .WORD GET_BYTE *LI R4,2  SCIPZ MOV IPC,@IPCFLT *DECT @IPCFLT *LI R11,CPG2 *B @SET_LINK  CPI .WORD GET_2BYTE ; CALL INTERMEDIATE PROCEDURE        ; GET OLD SIB (INC @TIMSTMP ; INC TIMESTAMP (MOV @TIMSTMP,@SEGACT(R5) ; PUT BACK IN SIB WE ARE ENTERING (MOV R5,@SIB ; SET SIB (MOV R6,@SEG ; " SEG  $1 B *R11 (   ;  ; STACK CHECK IS CALLED BY ALMOST ANYONE WHO NEEDS TO KNOW IF THERE ARE  ; AT LEAST STKEXT BYTES OF ROOM ON THE CURRENT STACK. IF THERE IS, THE  ; ROUTINE SIMPLY RETURNS. IF NOT, THEN THE IPC IS RESET FROM IPCFLT (TO OF SEGMENTS? (JEQ $1 (MOV @MSENV(MP),R5 ; SETUP FOR A SEGMENT CHECK (BL @SEGCHK1 ; WELL NOW THAT WE'RE ALL SETUP... (MOV R4,R6 ; NEED TO SAVE NEWSEG FOR CHGSIB (BL @CHKSEX ; CHECK SEGMENT SEX (BL @CHGSIB ; CHANGE SIBS  $1 MOV MP,SP ; MAKE SURE SP POINTS AT MP (MOV @MSPROC(SP),@CURPROC ; RESTORE CURPROC (JLT $3 (MOV @MSIPC(SP),IPC ; EVERYTHING COOL JUST SET IPC TO OLD VALUE  ; ALLOW THE CALLER A CHANCE TO RESTART AFTER ROOM IS MADE ON THE STACK)  ; AND A TRAP IS EXECUTED. THIS CALL OF TRAP WILL EXPECT SAVEREC TO HOLD  ; THE CALLER'S EREC.  ;  STKCHK MOV @CURTASK,R4 ; CHECK FOR STACK OVERFLOW (MOV @TIBSPLW(R4),R4 ; GET CURRENT TIB (AI R4,HSMRGN ; GET STACK LOW (JOC $2 (A @STKEXT,R4 ; SET R4=MARGIN+EXTENSION+SPLOW (JOC $2 ; CHECK FOR OVERFLOW!!! (C R4,SP ; THE ALL IMPORTANT CHECK (JL $1  $(JMP $4 ; AND SKIP THE GOOD STUFF  $3 MOV @CURPROC,R1 ; OH-OH, WE GOTTA RETURN TO EXITIC (NEG @CURPROC (SLA R1,1 ; BUT FIRST WE'VE GOTTA FIND EXITIC! (A @SEGHI,R1 (BL @SEG_WORD ; RESTORE CURPROC AND LOOK IN PROC DICT (SLA R2,1 (A @SEG,R2 (MOV R2,R1 (DECT R1 ; EXITIC COMES JUST BEFORE DATA SIZE (BL @SEG_WORD (MOV R2,IPC ; AT LAST, IPC BECOMES EXITIC  $4 MOV @MSDYN(SP),MP ;2 LI R4,HSMRGN ; BUMMER, GOTTA STACK FAULT... (A R4,@STKEXT (MOV @IPCFLT,IPC (TRAP STKFLT  $1 B *R11 ; LUCKY THIS TIME, JUST RETURN ( (  ;  ; SEGMENT CHECK DETERMINES A SEGMENT'S PRESENCE, CAUSING A SEGMENT FAULT  ; IF NOT. IF IT IS PRESENT THEN IT RESETS ADRSP AND MAP AS NECESSARY  ; FOR THE NEW SEGMENT. SEGMENT PRESENCE IS SATISIFIED IF THE SEGMENT  ; RESIDES IN THE CODE POOL OR IT IS ONE OF THE AVAILABLE EXECUTABLE  RESTORE MP (A @SEG,IPC ; SEG-RELATIVIZE IPC (AI SP,MSCWSZ ; POP STACK (SLA R3,1 (A R3,SP (B *BK ; OKAY, LETS GET ON WITH IT...  ;  ;  ;************ PARAMETER COPYING INSTRUCTIONS *****************  ;  ;  SETUPCPY MOV *SP,R7 ; PARM ADDRESS (MOV @2(R7),R1 ; 2ND WORD OF DESCRIPTION (C *R7,@NIL ; IS 1ST WORD NIL? (JNE $1 (INCT SP ; YES  ; DISKS AND DOES NOT CONTAIN ANY ASSEMBLY LANGUAGE PROCEDURES.  ;  ; IT IS PASSED:  ; R5 = SEGMENT NUMBER (OR EREC IF SEGCHK1 ENTRY IS USED)  ;  ; IT RETURNS:  ; R5 = EREC FOR SEGMENT  ; R4 = SEG  ;  ; IT RESTORES: ADRSP AND MAP  ;  ; IT USES: R0-R2  ;  SEGCHK SLA R5,1 ; CONVERT SEGMENT # TO EREC (A @EVEC,R5 (MOV *R5,R5  SEGCHK1 MOV @ENVSIB(R5),R1 (MOV @SEGBASE(R1),R4 ; GET SEGMENT BASE (JNE $4 ; if segbase = 0 then (M(MOV *SP+,R2 ; POP DESTINATION ADDRESS (.IF XADRS (MOV @MAPVEC,R0 ; USE BANK 0 (.ENDC (B *R11  $1 MOV *R7,R5 ; SAVE EREC IN R5 (MOV R1,R7 ; " OFFSET IN R7 (MOV R11,$3 ; " RETURN IN $3 (MOV @ENVSIB(R5),R1 ; get sib pointer (MOV @SEGBASE(R1),R4 ; get segment base (JNE $2 ; if base = 0 then (TRAP SEGFLT ; trap - segment fault  $2 ; endif (.IF XAOV @IPCFLT,IPC ; SEG FAULTING IS INEVITABLE (TRAP SEGFLT   $4 .IF XADRS (; set up memory map , map and address space register (C SEGPOOL(R1),NIL ; if sibptr^.poolptr = nil then (JNE $5 ; (* use standard map *) (CLR ADRSP ; address space index := 0 (JMP $6 ; else (* set up external pool map *)  $5 MOV @SEGPOOL(R1),R1 ; get segpool pointer (MOV @PLBASE1(R1),R1 ; get pool base bias DRS (MOV @SEGPOOL(R1),R6 ; get seg poolptr (LI R5,TMAP1 ; get address of temporary memory map (BL SETUPMAP ; set up temporary memory map (LI R0,TMAP1 ; r0 := address of map (.ENDC (A R7,R4 ; SEG-RELATIVIZE (INCT SP (MOV *SP+,R2 ; POP DEST ADDRESS (MOV R4,R1 ; CPU-RAM (MOV $3,R11 ; restore return address (B *R11  $3 .WORD 0 ( (   CAP .WORD $0 (MOV R1,MAP2+2 ; set bias 1 (MOV R1,MAP2+6 ; set bias 2 (MOV R1,MAP2+10 ; set bias 3 (LI ADRSP,2 ; address space index := 2  $6 ; endif (MOV MAPVEC(ADRSP),MAP ; set up memory map register (.ENDC (B *R11 (  ;  ; CHECK SEGMENT SEX. UPDATES SEXOK BASED ON THE 6TH WORD OF THE SEGMENT  ; WHOSE SEG IS PASSED IN R4. ALSO SETS SEGHI FOR THE NEW SEGMENT.  ;  ; PASSED: R4 = SEG  ; RETURNS: R4 = SEGHI  ; RESTORES: $0 MOV IPC,@IPCFLT ; SET IPCFLT BACK TO P-CODE (DEC @IPCFLT (LI R2,$1 (B @GET_BIG  $1 MOV R3,R3 ; CHECK # OF WORDS TO COPY (JNE $4 (AI SP,4 (B *BK ; NONE, JUST RETURN  $4 BL @SETUPCPY ; SETUP FOR COPY  $2 .IF XADRS (LDS *R0 (.ENDC  MOV *R1+,*R2+ ; CPU-RAM WORD COPY (DEC R3 (JGT $2 (B *BK (   CSP .WORD GET_BYTE ; GET DECLARED MAX LENGTH (MOV SEGHI & SEXOK  ; USES: R0-R2  ;   CHKSEX MOV R4,R1 ; SETUP TO PICK UP FIRST WORD OF SEGMENT (AI R1,12 ; SETUP TO PICK UP 6TH WORD OF SEGMENT (INC @SEXOK ; INSURE SEX-WORD ISN'T FLIPPED DURING FETCH (MOV R11,R0 ; SAVE RETURN ADDRESS (BL @SEG_WORD ; PICKUP SEGMENT SEX (CLR @SEXOK ; ASSUME IT'S BAD...PESSIMIST (CI R2,1 (JNE $1 (INC @SEXOK ; NOW FIX FLAG  $1 BL @SEG_WORD  IPC,@IPCFLT ; SET IPCFLT BACK TO P-CODE (DECT @IPCFLT (BL @SETUPCPY ; SETUP FOR COPY  $1 .IF XADRS (LDS *R0 (.ENDC (MOVB *R1,R4 (CB R4,@INTPWS+7 ; CHECKOUT SOURCE LENGTH (JH $2 (SRL R4,9 ; TURN INTO WORD COUNT (INC R4  $5 .IF XADRS (LDS *R0 (.ENDC (MOV *R1+,*R2+ ; AND COPY STRING (DEC R4 (JGT $5 (B *BK ; RETURN  $2 TRAP S2LONG ; TRAP...STRING TOO LONG (SLA R2,1 (MOV R2,@CPOFST (A R4,R2 (MOV R2,@CPOOL (MOV R4,R1 (BL @SEG_WORD ; PICKUP PROCEDURE DICT POINTER (SLA R2,1 (A R2,R4 ; SAVE IN R4 (MOV R4,@SEGHI ; UPDATE SEGHI (B *R0 ; RETURN  ( (  RPU .WORD $0 ; RETURN FROM PROCEDURE CALL  $0 MOV IPC,@IPCFLT ; YES - SET IPC IN CASE OF FAULT (DEC @IPCFLT (LI R2,$2 (B @GET_BIG  $2 C @MSENV(MP),@EREC ; CHANGE       INE  IOEXIT C SYREADB,TRUE ; IF SYREADB *JEQ $3 ; THEN (*RETURN TO CALLER*) *B *BK ; ELSE RECYCLE BACK  $3 CLR SYREADB ; SYREADB:=FALSE *MOV SYSRTN,R11 ; RETURN ADDRESS:=SYSRTN *RT ; RETURN TO CALLER  ;  ; -- ERROR EXITS --  ;  BADBLOCK MOV IBADBLK,IORESULT ; BAD BLOCK SPECIFICATION *JMP IOEXIT  ;  ;  ; BADMODE IS SAME AS "NO UNIT"  ; O^£Õ„r BADMODE ; ROUTINE TO CATCH REQUESTS ON C; UNITS NOT IMPLEMENTED *MOV INOUNIT,IORESULT ; IORESULT:=INOUNIT (*=9*) *JMP IOEXIT  ;  ;  BADDUNIT *MOV IBADUNIT,IORESULT *JMP IOEXIT  .PAGE  ;  ; procedure calcdrvr ;  ;  ; returns - r4 index into unittab based on unit #. Updates input parameters  ; for subsidiary volumes if needed.  ;  CALCDRVR CI R3,SYSDEF ; if unit# <= 8 then *JGT $1 ; (*€Qestandard unit*) *MOV R3,R4 ; r4 := unit# *B *R11 ; exit #$1 ; endif *CI R3,128 ; if unit# >= 128 then *JLT $2 ; (*user unit*) *LI R4,9 ; r4 := position of user stuff *B *R11 ; exit #$2 ; endif #; At this point unit is A) physical disk B) subsid vol C) serial  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ; *C R3,SUBSTRT ; if unit < substrt *JEQ $3 *JGT $3 ; (*disk unit*) *LI R4,10 ; r4 := position of blked dev stuff *B *R11 ; exit #$3 ; endif #; Check for Subsidiary Volume *MOV SUBSTRT,R5 ; r5 := start of subsid volumes *MOVB SUBMAX,R6 ; r6 := # of subsid volumes *SRL R6,8 *DEC R6 *A R6,R5 ; r5 := last subsid volume  ;  ;****************************************************************************   SAVERG .WORD 0 ; FOR SAVING RETURN REGISTER R11  ;  ; ****** UNIT I/O **********************************************************  ;  ; SYSTEM READ  SYSREAD ; ENTRY PT FOR SYSTEM USE (FROM CXP OR LOADER) *MOV TRUE,SYREADB ; SYREADB (*BOOLEAN*) := TRUE *MOV R11,SYSRTN ; SYSRTN:=RETURN ADDRESS *C R3,R5 ; if unit <= last subsid then *JGT $7 ; (*subsidiary volume*) *LI R5,USIZE ; r5 := size of unit record entry *MPY R3,R5 ; r6 := index into unittable *A UNITPTR,R6 ; r6 := ptr to desired unit entry *MOV @UPHYVOL(R6),R3 ; r3 := physical volume *C R3,SUBSTRT ; if r3 >= substrt then *JLT $4 ; (* error - bad unit *) C; (*FALL THROUGH TO UNIT READ*)  ;  ; UNIT READ  UREAD MOV RDDRVR,IODRVR ; DIRECTION:=READING *JMP UNITIO ; UNITIO  ;  ;  ; UNIT WRITE  UWRT MOV WRTDRVR,IODRVR ; DIRECTION:=WRITING  ; ; FALL INTO UNITIO CODE  UNITIO *CLR IORESULT ; ASSUME IORESULT := INOERROR *MOV *SP+,CONTWORD ; CONTROL WORD *MOV *SP+,LOGBLKNO ; LOGICAL BLOCK NUMBER *MOV *SP+,R1 ; BYTE COUNT *MOV *SP+,R2 *B BADUNIT ; error exit #$4 ; endif *C ZERO,@UBLKOFF(R6) ; if blockoffset = 0 then *JNE $5 ; (* not on line *) *B BADMODE ; error exit #$5 ; endif *C LOGBLKNO,@UEOVBLK(R6) ; if block # > eov then *JLT $6 ; (* error - bad block *) *JEQ $6 ; *B BADBLOCK ; error exit #$6  ; BYTE OFFSET *A *SP+,R2 ; + BASE = STARTING ADDRESS *MOV *SP+,R3 ; UNIT NUMBER *; DETERMINE RSP DRIVER AND INTERPRET PARAMETERS *MOV R11,SAVERG ; SAVE RETURN REGISTER *BL CALCDRVR ; DETERMINE DRIVER *MOV SAVERG,R11 ; RESTORE RETURN REGISTER *MOV R1,R1 ; IF BYTE COUNT > 0 *JGT $1 ; THEN (*OKAY SO CONTINUE*) *MOV CONTWORD,R5 ; ELSE GET CONTROL WORD   *ANDI R5,2 ; ARE WE IN 'PHYSICAL SECTOR MODE?' *JEQ IOEXIT ; NO, SO EXIT IO REQUEST  $1 MOV CONTWORD,INOP+10 *MOV CONTWORD,OUTOP+10 *MOV CONTWORD,DSKOP+10 *SLA R4,2 ; GET UNIT TABLE OFFSET (WORD ADDR) *A IODRVR,R4 ; ADJUST FOR READ OR WRITE *MOV UNITTAB(R4),R4 ; GET ADDRESS OF IOROUTINE FROM UNITTAB *JEQ BADMODE ; IF INVALID ADDRESS (IE. 0) THEN ERROR *BL *R4 ; ELSE GOTO IOROUT       ; endif *A @UBLKOFF(R6),LOGBLKNO ; calculate block number *B CALCDRVR ; determine real driver #$7 ; endif *MOVB SERMAX,R6 ; r5 := # of serial units *SRL R6,8 *A R6,R5 ; r5 := last serial *C R5,R3 ; if last serial < unit # then *JEQ $8 ; (*error - illegal unit*) *JGT $8 ; N,LOWERA ; IS CHAR >= 'a' ? *JL $9 ; NO *CB CHARIN,LOWERZ ; IS CHAR <= 'z' ? *JH $9 ; NO *SB CASEADJ,CHARIN ; YES- CONVERT TO UPPER CASE  ;  $9 MOVB CHARIN,*R2+ ; STUFF THE CHARACTER *DEC R1 ; DEC CHAR COUNTER *JGT $1 ; MORE CHARACTERS TO READ  READDONE RT ; FINISHED WITH READ  ;  ;  RNOTSPEC ; NO SPECIAL CHARACTER HANDLING ON READS *B BADMODE ; error exit #$8 ; endif *LI R4,11 ; r4 := (position of serial driver) *B *R11 ; return  .PAGE  ;  USERRD ; USER READ ENTRY POINT *MOV R1,UBYTES ; NUMBER OF BYTES TO READ *MOV R2,UBUFA ; BUFFER ADDRESS *MOV CONTWORD,UCONTW; CONTROL WORD *CLR USEROP+BIOSRSLT; ASSUME GOOD RETURN *MOV USERREAD,USEROP; SVC NUMBER FOR READ *BIOS INOP ; GET A CHARACTER *CHKRSLT INOP,$1 ; CHECK IORESULT *MOVB CHARIN,*R2+ ; STUFF THE CHARACTER *DEC R1 ; DEC CHAR COUNTER *JGT RNOTSPEC ; MORE CHARACTERS TO READ  $1 RT ; FINISHED WITH READ  ;  ;  NULLFILL MOVB NUL,*R2+ ; STUFF NULL CHARACTER *DEC R1 ; COUNT:=COUNT-1 *JGT NULLFILL ; IF COUNT <> 0 THEN CONTINUE NULLFILLING *RT ; *BIOS USEROP ; CALL BIOS SVC *MOV USEROP+BIOSRSLT,IORESULT ; SET SYSTEM IORESULT *B *R11 ; DONE  ;  USERWT ; USER WRITE ENTRY POINT *MOV R1,UBYTES ; NUMBER OF BYTES TO WRITE *MOV R2,UBUFA ; BUFFER ADDRESS *MOV CONTWORD,UCONTW; CONTROL WORD *CLR USEROP+BIOSRSLT; ASSUME GOOD RETURN *MOV USERWRIT,USEROP; SVC NUMBER FOR WRITE *BIOS USEROP ; CALL BIOS SVC  ELSE RETURN  .PAGE  ;  ;  ; ****** TRANSLATE D/CONTROLLED OUTPUT ****************************************  ;  CONWRT MOV CSOUT,OUTOP ; CONSOLE/SYSTERM WRITE OPERATION (OFFSET 1) *LI R3,CONBOOL ; GET "LAST CHAR DLE?" FLAG FOR CONSOLE *JMP CONTRWRT ; CONTROLLED WRITE  LPWRT MOV POUT,OUTOP ; PRINTER WRITE (OFFSET 6) *LI R3,LPBOOL ; GET "LAST CHAR DLE?" FLAG FOR LINE PRINTER *JMP CONTRWRT ; CONTROLLED WRITE *MOV USEROP+BIOSRSLT,IORESULT ; SET SYSTEM IORESULT *B *R11 ; DONE  .PAGE  ; ****** TRANSLATED/CONTROLLED INPUT ******************************************  ;  REMIN ; REMOTE READ *MOV RIN,INOP ; IN-DATA-BLOCK:=REMOTE READ OFFSET (16) *LI R3,REMBOOL ; OFFSET INTO ALPHALOCK BOOLEAN TABLE *JMP CSRREAD ; GO DO READ  ;  STRMRD ; SYSTERM READ *CLR INOP ; SET FOR CONSOLE  REMOUT MOV ROUT,OUTOP ; REMOTE WRITE OPERATION (OFFSET 18) *LI R3,REMBOOL ; GET "LAST CHAR DLE?" FLAG FOR REMOTE  ;  CONTRWRT ; CONTROLLED WRITE FOR CONSOLE, PRINTER C; AND REMOTE UNITS. *MOV CONTWORD,R5 ; GET CONTROL WORD *ANDI R5,4 ; WILL THERE BE DLE PROCESSING? *JNE WNOTSPEC ; NO SPECIAL HANDLING FOR DLE'S *MOVB DLEBOOL(R3),R4 ; BEGIN IF LAST CHAR FOR THIS DEVICE<>DLE *JEQ NODLECNT ; READ OFFSET *LI R3,REMBOOL ; SET FOR NO CHAR ECHOING! *JMP CSRREAD  ;  CONREAD ; CONSOLE READ *CLR INOP ; IN-DATA-BLOCK:=CONSOLE READ OFFSET (0) *LI R3,CONBOOL ; OFFSET INTO ALPHALOCK BOOLEAN TABLE *MOV CSOUT,OUTOP ; FOR CHARACTER ECHOING IN CSRREAD C; FALL INTO CSRREAD  ;  CSRREAD ; READ ROUTINE SHARED BY CONSOLE, SYSTERM C; AND REMOTE UNITS. *MOV CONTWORD,R5 ; GET CONTROL WORD THEN NEXT CHAR IS NOT DLE COUNT  EXPANDD MOVB FALSE,DLEBOOL(R3) ; ELSE DLEBOOL:=FALSE *CLR R4 ; (*NEXT CHAR => COUNT*) *MOVB *R2+,R4 ; GET THE CHAR *SWPB R4 ; COUNT = *AI R4,DLEADJ ; ORD(CHAR-32) *JLT $2 ; IF NEG COUNT (=>0) THEN EXIT EXPAND *JEQ $2 ; ELSE IF ZERO COUNT THEN EXIT EXPAND *ANDI R5,4 ; WILL THERE BE SPECIAL CHARACTER HANDLING? *JNE RNOTSPEC ; NO  $1 BIOS INOP ; YES. GET A CHARACTER FROM DEVICE *CHKRSLT INOP,READDONE ; CHECK IORESULT *CB CHARIN,LINDEL ; LINE DELETE CHAR? *JEQ $9 ; YES- DO NOT ECHO *CI R3,CONBOOL ; CONSOLE READ? *JNE $11 ; NO- SO ALSO DO NOT ECHO *MOVB CHARIN,CHAROUT *BIOS OUTOP ; ECHO THE CHAR *CHKRSLT OUTOP,READDONE  $11 *MOV BLANK,CHAROUT ; ELSE REPEAT  $1 BIOS OUTOP ; EMIT BLANK *CHKRSLT OUTOP,EXITWRT ; IF IORESULT <> 0 THEN EXITWRT *DEC R4 *JGT $1 ; UNTIL COUNT=0 (OR IORESULT<>0)  $2 DEC R1 ; CHARCNT:=CHARCNT-1 {FOR DLE CNT CHAR} *JEQ EXITWRT ; IF CHARCNT=0 THEN EXIT WRITE  NODLECNT MOVB *R2+,R4 ; ELSE GET THE CHAR AND PROCESS IT: *CB R4,DL CB CHARIN,CR ; CARRIAGE RETURN? *JNE $3 ; NO *CI R3,CONBOOL ; YES- IS THIS CONSOLE READ? *JNE $9 ; NO *MOV CONTWORD,R5 ; GET CONTROL WORD *ANDI R5,8 ; LOOK AT NO LF AFTER CR BIT *JNE $9 ; DO NOT SEND LF IF ON *MOVB LF,CHAROUT ; YES- OUTPUT LINE FEED *BIOS OUTOP *CHKRSLT OUTOP,READDONE *JMP $5 ; SKIP EOF CHECK  ; E ; IF CHAR <> DLE *JNE NOTDLE ; THEN NOT DLE *MOVB TRUE+1,DLEBOOL(R3); ELSE DLEBOOL:=TRUE *DEC R1 ; IF CHARCNT EXHAUSTED *JEQ EXITWRT ; THEN EXIT WRITE OPERATION *JMP EXPANDD ; ELSE NEXT CHAR=CNT,SO EXPAND  NOTDLE ; {NOT DLE;CHECK FOR OTHER SPECIAL CHARS} *MOVB ALPHBOOL(R3),R5; GET ALPHALOCK BOOLEAN FOR THIS DEVICE  $3 CB CHARIN,EOFF ; EOF CHAR? *JEQ NULLFILL ; YES- NULL FILL REST OF BUFFER  ;  $4 *CB CHARIN,ALPHLOCK; IS CHAR AN ALPHALOCK? *JNE $5 ; NO *MOVB ALPHBOOL(R3),R4; YES. TOGGLE THE BOOLEAN *INV R4 *MOVB R4,ALPHBOOL(R3) *JMP $1 ; GET NEXT CHARACTER  ;  $5 MOVB ALPHBOOL(R3),R4; GET ALPHALOCK BOOLEAN FOR THIS DEVICE *JEQ $9 ; NOT SET, SO NO LOWER-TO-UPPER CONVERSION *CB CHARI       €AB*JMP NODLECNT ; ELSE GET NEXT CHAR C; END (*SPEC CONTROL ON => TRANSLATION*)  ;  WNOTSPEC ; (*SPEC CONTROL OFF HERE => NO TRANSLATION*) *MOVB *R2+,CHAROUT ; OUTPUT CHAR *BIOS OUTOP ; *CHKRSLT OUTOP,EXITWRT ; IF IORESULT<>0 THEN EXITWRT *CB CHAROUT,CR ; IS CHARACTER A CR? *JNE $1 ; NO *MOV CONTWORD,R5 ; GET CONTROL WORD *ANDI R5,8 ; APPEND LINE FEED? *JNE  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ;  $1 ; NO *MOVB LF,CHAROUT ; YES- OUTPUT A LINE FEED *BIOS OUTOP *CHKRSLT OUTOP,EXITWRT ; CHECK IORESULT  $1 DEC R1 ; DEC CHAR COUNTER *JGT WNOTSPEC ; UNTIL CHARCNT=0 (OR IORESULT<>0)  EXITWRT RT  .PAGE  ; **** DISK I/O ****  ;  DSKRD MOV DIN,DSKOP ; opcode = diskread (JMP SDEVD ; set disk device number  ;  DSKWRT MOV DOUT,DSKOP ; opcode = diskwrite  ;  ;  ;****************************************************************************   ;  ;  ;  ;FUNCTION UNITBUSY(UNITNUMBER:INTEGER):BOOLEAN;  ; (*RETURNS TRUE IF DEVICE IS BUSY*)  ;PROCEDURE UNITWAIT(UNITNUMBER:INTEGER);  ;  ;THESE ROUTINES ARE CURRENTLY "YES-MEN (PERSONS)" AND DO NOTHING  ;OF CONSEQUENCE EXCEPT UNIT NUMBER CHECK.  ;  ;  UBUSY  BUSY *MOV *SP+,R1 ; UNIT NUMBER *JEQ BADUNIT ; IF UNIT # = 0 THEN ERROR  SDEVD SLA R3,1 ; turn unit # to offset (MOV @PHYSTABL(R3),DSKDRV @; set drive number (JMP DSKIO  ;  BLKRD MOV DIN,DSKOP ; opcode = diskread (JMP SDEVB ; set blocked device number  ;  BLKWRT MOV DOUT,DSKOP ; opcode = diskwrite  ;  SDEVB LI R4,7 ; r4 := adjust constant (S R4,R3 ; r3 := unit - adjust constant (MOV R3,DSKDRV ; set drive number  ;  DSKIO MOV R1,DCNT ; set byte co*CI R1,SYSDEF ; IF UNIT # > SYSDEF # *JGT BADUNIT ; THEN ERROR; *MOV @FALSE,*SP ; SP^:=FALSE (*IE. ASSUME NOT BUSY*) *B *BK  ;  ;  UWAIT *MOV *SP+,R1 ; UNIT NUMBER *JEQ BADUNIT ; IF UNIT # = 0 THEN ERROR *CI R1,SYSDEF ; IF UNIT # > SYSDEF # *JGT BADUNIT ; THEN ERROR *B *BK  .PAGE  ;  ; procedure unitclear ( unit : integer ) ;  ;  ; Passed the unit number on the top of the stack. Calls thunt in parameter block (MOV R2,DBUFF ; set buffer address in parameter block (BIOS DSKOP ; do disk i/o (MOV BIOSRSLT+DSKOP,IORESULT @; set ioresult word (B *R11 ; return  .PAGE  ; **** SYSTEM I/O ****  ;  SYSRD MOV SYSIN,DSKOP (BIOS DSKOP (B *R11  ;  SYSWRT MOV SYSOUT,DSKOP (BIOS DSKOP  B *R11  ;  ;  ; **** SERIAL I/O ****  ;  SERRD MOV SERIN,INOP ; opcode := serialread e appropriate  ; BIOS entry point based on unit number.  ;  UCLR MOV *SP+,R1 ; r1 has the unit number (CI R1,SYSDEF ; if unit <= 8 then (JGT $2 ; (*standard unit*) (SLA R1,1 ; turn unit into index (MOV @CLRTAB(R1),CLROP @; opcode = clrtab (unit) (JNE $9 ; if opcode = 0 then (B BADMODE ; error exit - unit offline #$9 ; endif (MOV @PHYSTABL(R1),R1 (MOV R11,SAVERG ; save return register (BL DOSER ; calc unit # and set up flags (MOV R5,INOP+8 ; set device number (BL CSRREAD ; do i/o (MOV SAVERG,R11 ; restore return register (B *R11  ;  SERWRT MOV SEROUT,OUTOP ; opcode := serialwrite (MOV R11,SAVERG ; save return register (BL DOSER ; calc device number and set up flags (MOV R5,OUTOP+8 ; set device number (BL CONTRWRT ; do i/o (@; set drive # (if any) (MOV @CLRBOOL(R1),R3 ; get alphalock and dle boolean address (JLT $1 ; if address > 0 then (MOVB FALSE,DLEBOOL(R3); clear dle flag (MOVB FALSE,ALPHBOOL(R3); clear alphalock flag #$1 ; endif (JMP $7 #$2 ; else if user unit then (CI R1,128 (JLT $3 (MOV USERCLR,CLROP ; opcode = userctrl (JMP $7 #$3 ; else if other blocked device (C R1,MOV SAVERG,R11 ; restore return register (B *R11 ; return  ;  DOSER MOV SUBSTRT,R4 ; r4 := start of subsidiary volumes (MOVB SUBMAX,R5 ; r5 := # of subsids (SRL R5,8 (A R4,R5 ; r5 := start of serial units (S R5,R3 ; r3 := device number (MOV R3,R5 (AI R3,3 ; to get at dle and alf area for serials (B *R11  *JEQ $0 ; ZERO; SO NO LOWER TO UPPER CONVERSION *CB R4,LOWERA ; BOOLEAN SET. IS CHAR >= 'a'? *JL $0 ; NO *CB R4,LOWERZ ; IS CHAR <='z' ? *JH $0 ; NO *SB CASEADJ,R4 ; CONVERT TO UPPER CASE BEFORE OUTPUT  $0 MOVB R4,CHAROUT ; OUTPUT THE CHAR *BIOS OUTOP ; *CHKRSLT OUTOP,EXITWRT ; IF IORESULT<>0 THEN EXITWRT *CB R4,CR ; ELSE IF CHAR <> CR *JNEO^£Õ¤ó $1 ; THEN SKIP OUTPUTTING LF *MOV CONTWORD,R5 ; GET CONTROL WORD *ANDI R5,8 ; APPEND LINE FEED TO CR? *JNE $1 ; NO *MOVB LF,CHAROUT ; YES. OUTPUT LF *BIOS OUTOP ; *CHKRSLT OUTOP,EXITWRT ; IF IORESULT<>0 THEN EXITWRT  $1 DEC R1 ; CHARCNT:=CHARCNT-1 *JEQ EXITWRT ; IF CHARCNT=0 THEN EXIT WRITE OPERATION       SUBSTRT (JGT $4 (JEQ $4 (LI R4,7 ; r4 := 7 (*adjust constant*) (S R4,R1 ; r1 := unit - adjust constant (MOV DCLR,CLROP ; opcode := diskctrl (JMP $7 #$4 ; else (*subsidiary or serial*) (BL SUBSER ; determine which one (CI R3,1 ; if subsidiary then (JNE $5 (MOV DCLR,CLROP ; opcode := diskctrl (JMP $7  <= 8 then (JGT $1 ; (*standard unit*) (SLA R7,1 ; turn unit into offset (MOV @PHYSTABL(R7),R1; device # := phystabl (unit #) (JMP $2 ; else (*must be non-standard disk*) #$1 LI R6,7 ; r6 := adjust constant (S R6,R7 ; r7 := unit - adjust constant #$2 ; endif (LI R3,1 ; type := subsidiary volume (B *R11 ; exit #$5 CI R3,2 ; else if serial then (JNE $6 (MOV SERCLR,CLROP ; opcode := serialctrl (MOV R1,R3 ; r3 := device number (AI R3,3 ; to get at serial device flags (MOVB FALSE,DLEBOOL(R3) ; clear dleflag for this device (MOVB FALSE,ALPHBOOL(R3); clear alphalock for this device (JMP $7 #$6 B BADUNIT ; else error exit endif #$7 ; endif (MOV R1,CLROP+8 ; set device number (B#$3 ; endif (MOVB SERMAX,R6 ; r6 := # of serial units (SRL R6,8 ; (A R5,R6 ; r6 := top of serial units (C R1,R6 ; if unit <= top of serials then (JGT $4 ; (*serial unit conversion*) (INC R5 ; r5 := first serial unit (S R5,R1 ; r1 := unit - first serial unit (LI R3,2 ; type := serial (B *R11 ; exit #$4 ; IOS CLROP ; do the clear (MOV BIOSRSLT+CLROP,IORESULT (B *BK  ;  ;  BADUNIT B BADDUNIT  ;  .PAGE  ; procedure unitstatus ( unit : integer ; statrec : pointer ;  ; control : integer ) ;  ;  ; Parameters are located on the stack. Uses the unit number to call  ; the appropriate BIOS entry point.  ;  USTATUS MOV *SP+,STATCONT ; store direction (MOV *SP+,STATADDR ; address where BIOS puts status endif (LI R3,3 ; type := niether (B *R11 ; return to caller  (MOV *SP+,R1 ; r1 := unit number (CI R1,SYSDEF ; if unit <= 8 then (JGT $1 ; (*standard unit*) (SLA R1,1 ; turn unit into offset (MOV @STATTABL(R1),STATOP @; opcode := stattable (unit) (MOV @PHYSTABL(R1),R1 @; set drive number (JMP $6 #$1 ; else if user unit (CI R1,128 (JLT $2 (MOV USERSTAT,STATOP ; opcode := userstat (JMP $6 #$2 ; else if blocked O^£C£Įdevice (C R1,SUBSTRT (JGT $3 (JEQ $3 (LI R4,7 ; r4 := 7 (*adjust constant*) (S R4,R1 ; r1 := unit - adjust constant (MOV DSTAT,STATOP ; opcode := diskstat (JMP $6 #$3 ; else (*subsidiary or serial*) (BL SUBSER ; determine which it is (CI R3,1 ; if subsidiary volume then (JNE $4 ; (MOV DSTAT,STATOP ; opcode := diskstat (JMP $6 €0I#$4 CI R3,2 ; else if serial unit then (JNE $5 ; (MOV SERSTAT,STATOP ; opcode := serialstat #$5 B BADUNIT ; else error exit endif #$6 ; endif (MOV R1,STATDRV ; set device number (BIOS STATOP ; obtain unit status (MOV BIOSRSLT+STATOP,IORESULT (B *BK ; return back to ifetch (  .PAGE  ;  ; procedure subser ( var unit : integer ; var type : integer ) ;  ;  ; Determines  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ; whether unit is subsidiary or serial and maps the unit  ; number to a device number. R1 has unit number. R3 returns a type  ; code of 1-subsidiary , 2-serial , 3-niether.  ;  SUBSER MOV SUBSTRT,R4 ; r4 := start of subsidiary volumes (MOVB SUBMAX,R5 ; r5 := number of subsidiary volumes (SRL R5,8 (DEC R5 (A R4,R5 ; r5 := last subsidiary unit number (C R1,R5 ; if unit <= last subsidiary unit then  ;  ;****************************************************************************   ;  ;*********** SET INSTRUCTIONS **********  ;  ;  ; ADJUST SET  ADJ .WORD GET_BYTE *MOV *SP,R1 ; GET CURRENT SIZE FROM TOS *C R1,R3 ; COMPARE CURRENT SIZE TO REQUESTED SIZE *JLT $0 ; TOO SMALL; EXPAND IT *JGT $5 ; TOO BIG; CUT IT DOWN *INCT SP (JGT $3 ; (*subsidiary volume convert*) (LI R6,USIZE ; r6 := size of unittable record (MPY R1,R6 ; r7 := index to record (A UNITPTR,R7 ; r7 := pointer to unit record (C ZERO,@UBLKOFF(R7); if block offset = 0 then (JNE $5 ; (* return unit offline *) (B BADMODE ; error exit "$5 ; endif (MOV @UPHYVOL(R7),R7 ; r7 := physical unit number (CI R7,SYSDEF ; if unit      $4 ; JUMP IF NONE  $3 PUSHWORD R2 ; PUSH A ZERO WORD *DEC R1 ; DECR COUNTER *JGT $3  $4 PUSHWORD R5 ; PUSH THE LENGTH WORD *B *BK ; COMPLETE SET NOW ON STACK  $15 INCT SP ; PUSH A NULL SET (WHICH IS A ZERO WORD) *CLR *SP ; AFTER POPPING PARAMETERS *B *BK  ;  ;  ; SET MEMBERSHIP  INN .WORD $1  $1 MOV *SP+,R0 ; SET SIZE FROM TOS *A SP,R3 ; POINT R3 AT TOIP OF VALID PART OF SET *DECT R3 ; ADJUST FOR COPY *SLA R1,1 ; DOUBLE CURRENT SIZE FOR WORD ADDRESSING *A SP,R1 ; R1 ABOVE ENTIRE SET; DEST FOR COPY *DECT R1 ; ADJUST FOR THE COPY  $6 MOV *R3,*R1 ; COPY THE SET *DECT R3 ; BUMP DOWN THE SOURCE ADDRESS POINTER *DECT R1 ; AND THE DESTINATION POINTER *DEC R2 ; DECR THE COUNT*MOV SP,R1 ; POINT R1 AT THE INTEGER VALUE *A R0,R1 ; BY SKIPPING IT *A R0,R1 ; ABOVE THE SET *MOV *R1,R3 ; NOW HAVE THE ACTUAL VALUE *JLT $0 ; NO NEGATIVE INDEXES! *CLR R2 ; FOR DIV *DIV WORDBITS,R2 ; DIV BY 16 FOR # OF WORDS *C R0,R2 ; ENOUGH WORDS IN SET TO HANDLE THE VALUE? *JLE $0 ; NO *SLA R2,1 ; POINT R2 AT THE *A SP,R2 ER *JGT $6 *MOV R1,SP ; R1 HAS NEW TOS (-1)..SO CUT BACK STUFF *INCT SP ; CORRECT POINTER *B *BK ; DONE  ;  ;  ; BUILD A SUBRANGE SET  SRS .WORD $0  $0 MOV *SP,R1 ; GET HI BIT NUMBER *MOV 2(SP),R3 ; GET LOW BIT NUMBER *JLT $15 ; IF LOWNUM<0 THEN BUILD NULLSET *C R3,R1 *JGT $15 ; IF LOWNUM>HINUM THEN BUILD NULLSET  ; WORD WHICH HAS THE BIT IN IT *MOV *R2,TEMP ; SAVE THE CONTENTS OF THAT WORD *MOV *R1,R3 ; GET TEST VALUE AGAIN *CLR R2 ; FOR DIV *DIV WORDBITS,R2 ; DIV BY 16 *SLA R3,1 ; DOUBLE REMAINDER FOR INDEXING BIT TABLE *MOV BITWORDS(R3),R4; GET THE PROPER BIT MASK *INV R4 ; PREPARE FOR THE 'AND' OPERATION *MOV TEMP,R2 ; GET THE TEST WORD AGAIN *SZC R4,R2 ; IS THE BIT ON?  ; DIVIDE LOWNUM BY WORDBITS (# BITS/WORD) IN ORDER TO GENERATE BOTH  ; THE NUMBER OF ZERO WORDS AT THE START OF THE SET AND THE FIRST WORD. *CLR R2 *DIV WORDBITS,R2 ; R2=RESULT R3=REMAINDER *MOV R2,ZEROWRDS *SLA R3,1 ; PREPARE TO INDEX INTO ONMASKS *LI R4,0FFFFH ; WORD WITH ALL BITS ON *XOR ONMASKS(R3),R4 ; TURN ON CORRECT BITS IN FIRST SET WORD *MOV R4,FIRSTWRD ; SAVE IT FOR PUSH LATER  ; IS THE LOW BIT IN THE SAME WORD AS THE HIGH *JEQ $0 ; JUMP IF RESULT 0 (BIT NOT ON) *MOV R1,SP ; THE BIT IS ON; CUT BACK STACK NOW *INCT SP ; *PUSHWORD TRUE *B *BK  ;  $0 MOV R1,SP ; CUT BACK STACK *INCT SP ; THE CORRECT VALUE *PUSHWORD FALSE ; THE BIT IS NOT ON IN THE SET *B *BK  ;  ;  ; THIS SETADJ ROUTINE IS CALLED BY SEVERAL SET ROUTINES TO ADJUST  ; THE SIZE OF SETS IF NECESSARY.  SETADJ *MOV *SP+,R1 ;BIT? SPECIAL CASE IF SO. *MOV FALSE,SAMEWORD *INC R2 ; GET FIRST BIT OF THE WORD ... *SLA R2,4 ; ... FOLLOWING THE FIRST (NON ZERO) WORD *C R1,R2 ; IS HI BIT LESS? *JGT $7 *JEQ $7 *MOV TRUE,SAMEWORD ; SET FLAG *AI R2,-16 ; PUSH LOW END BACK ONE WORD  ; DIVIDE REMAINING NUMBER OF ON BITS BY WORDBITS IN ORDER TO GENERATE  ; BOTH THE NUMBER OF ONE WORDS IN THE SET AND THE LAST WORD.  GET TOS SET SIZE *MOV SP,R2 ; POINT R2 *A R1,R2 ; AT THE *A R1,R2 ; NEXT SET SIZE *C *R2+,R1 ; COMPARE TOS-1 SET SIZE TO TOS SET SIZE *JEQ $3 ; THEY ARE EQUAL, SO WE ARE DONE *JGT $3 ; ALSO IF TOS-1 SIZE IS GREATER *DECT SP ; POINT SP BACK AT TOS SET SIZE WORD *MOV *SP,R1 ; GET THE ACTUAL SIZE *DECT R2 ; POINT AT TOS-1 SET SIZE AGAIN  $7 S R2,R1 ; GET REMAINING # OF ON BITS *CLR R0 *DIV WORDBITS,R0 ; R0=RESULT R1=REMAINDER *MOV R0,ONEWORDS *INC R1 ; INCREMENT REMAINDER TO GET LAST BIT *SLA R1,1 ; PREPARE TO INDEX INTO ONMASKS *CLR R3 *XOR ONMASKS(R1),R3 ; TURN ON CORRECT BITS IN LAST SET WORD *MOV R3,LASTWORD ; SAVE IT FOR PUSH LATER *MOV ONEWORDS,R2 ; DO STACK CHECK *A ZEROWRDS,R2 *C SAMEWORD,TRUE *J*MOV *R2,TEMP ; SIZE OF SMALLER SET *MOV R1,*R2 ; CHANGE IT TO THE SIZE AFTER EXPANSION *MOV R1,R2 ; NOW READY TO COMPUTE THE *S TEMP,R2 ; # OF WORDS OF ZEROES NEEDED TO PAD SET *MOV R2,ZEROWRDS ; SAVE THAT NUMBER *A TEMP,R1 ; GIVES TOTAL # WORDS TO COPY *INCT R1 ; INCLUDE THE 2 LENGTH WORDS *MOV SP,TEMP ; POINT TEMP AT OLD TOS *SLA R2,1 ; DOUBLE SIZE DIFFERENCE FOR BYTES *EQ $8 ; IF SAMEWORD THEN NO LASTWORD *INC R2 ; INCLUDE LASTWORD  $8 INC R2 ; INCLUDE FIRSTWRD *MOV R2,R5 *SLA R2,1 *MOV R2,STKEXT *MOV IPC,IPCFLT *DEC @IPCFLT *MOV EREC,SAVEREC *BL STKCHK *AI SP,4 ; NO FAULT - POP PARAMETERS  ; PUSH THE SET ON THE STACK *C SAMEWORD,FALSE *JEQ $9 *MOV FIRSTWRD,R2 *XOR LASTWORD,R2 *INV R2 *PUSHWORD R2 *B *BK ; SAME SIZE, SO EVERYTHING OK  $0 S R1,R3 ; THE SET SIZE DIFFERENCE *MOV R3,R0 ; SAVE THE DIFFERENCE FOR LATER *SLA R3,1 ; DOUBLE FORE WORD ADDRESSING *MOV IPC,@IPCFLT *DECT @IPCFLT *MOV @EREC,@SAVEREC *MOV R3,@STKEXT *BL @STKCHK *INCT SP *MOV SP,R2 ; SAVE CURRENT TOP OF SET *S R3,SP ; BUMP SP FOR ZERO FILLING *MOV SP,R3 ; R3 NOW HAS DESTINATION ADDR FOR *JMP $5  $9 PUSHWORD LASTWORD ; PUSH THE LAST SET WORD *MOV ONEWORDS,R1 ; # WORDS OF ONES TO PUSH *JEQ $2 ; JUMP IF NONE *LI R3,0FFFFH ; WORD OF ALL ONES  $1 PUSHWORD R3 ; PUSH IT *DEC R1 ; DECR COUNTER *JGT $1  $2 PUSHWORD FIRSTWRD ; NOW PUSH THE FIRST WORD OF THE SET  $5 CLR R2 ; A ZERO WORD *MOV ZEROWRDS,R1 ; # OF ZERO WORDS TO PUSH *JEQ COPYING *MOV R1,R1 ; WAS CURRENT SET SIZE 0? *JEQ $3 ; IF SO, DONT DO LOOP  $1 MOV *R2+,*R3+ ; COPY THE SET DOWN FURTHER ON THE STACK *DEC R1 ; DECR THE COUNTER *JGT $1  $3 CLR *R3+ ; PUSH A ZERO WORD *DEC R0 ; DECR COUNTER *JGT $3 *B *BK  $5 INCT SP *MOV R3,R2 ; SAVE REQUESTED LENGTH *SLA R3,1 ; DOUBLE FOR WORD ADDRESSING       S R2,SP ; ADJUST STACK TO MAKE ROOM *MOV SP,R2 ; R2 NOW HAS DESTINATION FOR COPY *MOV TEMP,R3 ; SOURCE POINTER FOR COPY  $1 MOV *R3+,*R2+ ; MOVE THE 2 SETS DOWN THE STACK *DEC R1 ; DECR COUNTER *JGT $1 *MOV ZEROWRDS,R1 ; # OF ZERO WORDS TO ADD  $2 CLR *R2+ ; PUSH A ZERO WORD *DEC R1 ; DECR COUNTER *JGT $2 *B SETADJ ; TEST AGAIN AND EXIT  ; NO *DEC R3 ; *DEC R1 ; DECR COUNTER *JGT $1 ;  $2 B ZERSET ; SEE IF BOTH SETS ARE ZERO  ;  ; GREATER THAN OR EQUAL SET COMPARE  GEQSET *MOV R1,R1 ; IS TOS SET SIZE 0? *JEQ TRUSET ; YES, TOS IS SUPERSET OF TOS-1  $1 SZC *R2+,*SP+ ; TOS-1 AND NOT TOS *JNE FALSET ; TOS NOT SUPERSET OF TOS-1 *DEC R1 ; DECR COUNTER *JGT $1  $3 MOV R1,R1 ; SEE IF SETS SIZE IS ZERO (CALLER USES) *B *R11 ; RETURN TO CALLER  ;  ;  ; SET UNION  UNI .WORD $0  $0 BL SETADJ ; ADJUST SET SIZES IF NEEDED *JEQ $2 ; DONT LOOP IF SIZES ARE 0  $1 SOC *SP+,*R2+ ; DO THE UNION (TOS OR TOS-1) *DEC R1 ; DECR COUNTER *JGT $1  $2 B *BK  ;  ; SET INTERSECTION --- TOS AND TOS-1  INT .WORD $0  $0 *JMP TRUSET ; TOS IS SUPERSET OF TOS-1   BL SETADJ ; ADJUST SET SIZES IF NEEDED *MOV R1,TEMP ; SAVE TOS SET SIZE *JEQ $2 ; NO LOOP IF SIZE 0  $1 INV *SP ; GET ERADY FOR AND OPERATION *SZC *SP+,*R2+ ; DO THE INTERSECTION (AND) *DEC R1 ; DECR COUNTER *JGT $1  $2 MOV *SP,R1 ; GET FINAL SET SIZE *S TEMP,R1 ; MINUS OLD TOS SET SIZE *JEQ $4 ; DONE IF NO LEFTOVER WORDS  $3 CLR *R2+ ; ELSE ZERO EXTRA WORDS IN FINAL SET *DEC R1 ; DECR COUNTER *JGT $3  $4 B *BK ; FINISHED  ;  ; SET DIFFERENCE-- - TOS-1 AND NOT TOS  DIF .WORD $0  $0 BL SETADJ ; ADJUST SET SIZES IF NEEDED *JEQ $2 ; NO LOOP IF 0 SIZE  $1 SZC *SP+,*R2+ ; DO THE SET DIFFERENCE *DEC R1 ; DECR COUNTER *JGT $1  $2 B *BK ;O^£C„¢ FINISHED  ;  ;  ; SET COMPARISON ROUTINES.  ; SETCOMP DOES THE NECESSARY SET UPS NEEDED PRIOR TO PERFORMING  ; THE SPECIFIC SET COMPARISONS, THEN JUMPS TO THE PROPER ROUTINE  ; BASED ON THE TABLE SETJMPS  ;  ;  ; SET COMPARES  SETCOMP .WORD $0  $0 MOV R1,R5 *BL SETADJ ; ADJUST SET SIZES IF NEEDED *DECT R2 ; POINT AT TOS-1 SET SIZE *MOV *R2+,R4 ; GET THE SIZE *SLA R4,1 ; DOUBLE SIZE FOR WORD ADDRESSING €i*A R2,R4 ; R4 NOW POINTS AT NEW SP FOR LATER *MOV R4,NEWSP ; SAVE IT *AI R5,-364 ; SUBTRACT 364 TO GET NORMALIZED INDEX *MOV SETJMPS(R5),R4 ; THE CORRECT JUMP ADDRESS *DECT R2 ; POINT AT LOWER SET SIZE AGAIN *MOV *R2+,R3 ; GET THE SIZE FOR LATER USE *B *R4 ; JUMP TO CORRECT COMPARE ROUTINE  ;  ; SETS EQUAL  EQUSET *MOV R1,R1 ; IS TOS SET SIZE 0? *JEQ ZERSET ; YES, JUMP  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ;  $1 C *SP+,*R2+ ; COMPARE WORDS OF THE TWO SETS *JNE FALSET ; THEYRE NOT EQUAL *DEC R3 *DEC R1 ; DECR COUNTER *JGT $1  ZERSET MOV R3,R3 ; IS TOS-1 SET SIZE 0? *JEQ TRUSET ; BOTH SETS SIZE 0, SO THEY ARE EQUAL  $2 MOV *R2+,R1 ; WORD FROM THE TOS-1 SET *JNE FALSET ; JUMP IF NOT ZERO *DEC R3 ; DECR COUNTER *JGT $2  ;  ;****************************************************************************   ;********** TABLES ***********  ;  ;  ; MAIN OPCODE JUMP TABLE FOR THE INTERPRETER. THE INSTRUCTION FETCH LOOP  ; INDEXES THIS TABLE BY THE OPCODE AND JUMPS TO THE APPROPRIATE ROUTINE. *.ALIGN 2  OPTABLE *.WORD SLDCI ; 0 *.WORD SLDCI ; 1 *.WORD SLDCI ; 2 *.WORD SLDCI ; 3 *.WORD SLDCI ; 4 *.WORD SLDCI ; 5 *JMP TRUSET ; SET ALL ZEROES, SO THEY ARE EQUAL  ;  ;  FALSET MOV NEWSP,SP ; ADJUST SP TO NEW CORRECT VALUE *PUSHWORD FALSE *B *BK  ;  TRUSET MOV NEWSP,SP ; ADJUST SP TO NEW CORRECT VALUE *PUSHWORD TRUE *B *BK  ;  ;  ; LESS THAN OR EQUAL SET COMPARE  LEQSET *MOV R1,R1 ; IS TOS SET SIZE ZERO? *JEQ $2 ; YES, JUMP  $1 SZC *SP+,*R2+ ; IS TOS SET <= TOS-1 SET? *JNE FALSET       MPR ; 194 *.WORD DVR ; 195 *.WORD STO ; 196 *.WORD MMOV ; 197 *.WORD DUPREAL ; 198 *.WORD ADJ ; 199 *.WORD STB ; 200 *.WORD LDP ; 201 *.WORD STP ; 202 *.WORD CCHK ; 203 *.WORD FLT ; 204 *.WORD EQUREAL ; 205 *.WORD LEQREAL ; 206 *.WORD GEQREAL ; 207 *.WORD LDM ; 208 *.WORD SPR ; 209 *.WORD EFJ ; 210 *.WORD NFJ ; 211 *.WORD SLDLS ; 44 *.WORD SLDLS ; 45 *.WORD SLDLS ; 46 *.WORD SLDLS ; 47 *.WORD SLDOS ; 48 *.WORD SLDOS ; 49 *.WORD SLDOS ; 50 *.WORD SLDOS ; 51 *.WORD SLDOS ; 52 *.WORD SLDOS ; 53 *.WORD SLDOS ; 54 *.WORD SLDOS ; 55 *.WORD SLDOS ; 56 *.WORD SLDOS ; 57 *.WORD SLDOS ; 58 *.WORD SLDOS ; 59 *.WORD SLDOS ; 60 *.WORD SLDOS ; 61 *.WORD SLDOS ; 62*.WORD FJP ; 212 *.WORD FJPL ; 213 *.WORD XJP ; 214 *.WORD IXA ; 215 *.WORD IXP ; 216 *.WORD STE ; 217 *.WORD INN ; 218 *.WORD UNI ; 219 *.WORD INT ; 220 *.WORD DIF ; 221 *.WORD SIGNAL ; 222 *.WORD WAIT ; 223 *.WORD ABI ; 224 *.WORD NGI ; 225 *.WORD DUP1 ; 226 *.WORD ABR ; 227 *.WORD NGR ; 228 *.WORD LNOT ; 229 *.WORD  *.WORD SLDOS ; 63 *.WORD UNDF,UNDF,UNDF,UNDF,UNDF ; 64 TO 95 *.WORD UNDF,UNDF,UNDF,UNDF,UNDF *.WORD UNDF,UNDF,UNDF,UNDF,UNDF *.WORD UNDF,UNDF,UNDF,UNDF,UNDF *.WORD UNDF,UNDF,UNDF,UNDF,UNDF *.WORD UNDF,UNDF,UNDF,UNDF,UNDF *.WORD UNDF,UNDF *.WORD SLLA ; 96 *.WORD SLLA ; 97 *.WORD SLLA ; 98 *.WORD SLLA ; 99 *.WORD SLLA ; 100 *.WORD SLLA ; 101 *.WORD SLLA ; 102 *.WORD SLLA ; 103  IND ; 230 *.WORD IINC ; 231 *.WORD EQSTR ; 232 *.WORD LESTR ; 233 *.WORD GESTR ; 234 *.WORD ASTR ; 235 *.WORD CSTR ; 236 *.WORD INCI ; 237 *.WORD DECI ; 238 *.WORD SCIP1 ; 239 *.WORD SCIP2 ; 240 *.WORD TJP ; 241 *.WORD LDCRL ; 242 *.WORD LDRL ; 243 *.WORD STRL ; 244 *.WORD CTRL ; 245 *.WORD EXRL ; 246 *.WORD SSTL ; 104 *.WORD SSTL ; 105 *.WORD SSTL ; 106 *.WORD SSTL ; 107 *.WORD SSTL ; 108 *.WORD SSTL ; 109 *.WORD SSTL ; 110 *.WORD SSTL ; 111 *.WORD SCXG1 ; 112 *.WORD SCXG ; 113 *.WORD SCXG ; 114 *.WORD SCXG ; 115 *.WORD SCXG ; 116 *.WORD SCXG ; 117 *.WORD SCXG ; 118 *.WORD SCXG ; 119 *.WORD SSINDS ; 120 *.WORD SSINDS ; 121 *.WORD *.WORD UNDF,UNDF,UNDF,UNDF,UNDF ; 247 TO 254 *.WORD UNDF,UNDF,UNDF *.WORD NONE ; 255  ;  ;  ; STANDARD PROCEDURES JUMP TABLE. THE CXG OPCODE INDEXES THIS TABLE BY  ; THE PROCEDURE NUMBER AND JUMPS TO THE APPROPRIATE ROUTINE. NIL MEANS  ; THE PROCEDURE IS IN THE OPERATING SYSTEM. THERE IS NO PROCEDURE ZERO,  ; SO THE PROCEDURE NUMBER MUST BE DECREMENTED BEFORE IT IS USED. MAXCSP  ; IS THE NUMBER OF THE HIGHEST PROCEDURE, ANYTHING HIGHER IS IN THE  ; OPERATING SYSTEM.  CSPTABLE * SSINDS ; 122 *.WORD SSINDS ; 123 *.WORD SSINDS ; 124 *.WORD SSINDS ; 125 *.WORD SSINDS ; 126 *.WORD SSINDS ; 127 *.WORD LDCB ; 128 *.WORD LDCI ; 129 *.WORD LCO ; 130 *.WORD LDC ; 131 *.WORD LLA ; 132 *.WORD LDO ; 133 *.WORD LAO ; 134 *.WORD LDL ; 135 *.WORD LDA ; 136 *.WORD LOD ; 137 *.WORD UJP ; 138 *.WORD UJPL ; 139 .WORD NILV ; 1 THE KERNEL (SALUTE!) *.WORD NILV ; 2 EXECERROR *.WORD NILV ; 3 SEGREAD *.WORD RLOCSEG ; 4 RELOCATE SEGMENT *.WORD NILV ; 5 DUMMY *.WORD NILV ; 6 DUMMY *.WORD NILV ; 7 DUMMY *.WORD NILV ; 8 DUMMY *.WORD NILV ; 9 DUMMY *.WORD NILV ; 10 DUMMY *.WORD NILV ; 11 DUMMY *.WORD NILV ; 12 DUMMY *.WORD NILV ; 13 DUMMY *.WORD MOVESEG ; 14 MOVE A SEGMENT *.WORD MPI ; 140 *.WORD DVI ; 141 *.WORD STM ; 142 *.WORD MODI ; 143 *.WORD CPL ; 144 *.WORD CPG ; 145 *.WORD CPI ; 146 *.WORD CXL ; 147 *.WORD CXG ; 148 *.WORD CXI ; 149 *.WORD RPU ; 150 *.WORD CPF ; 151 *.WORD LDCN ; 152 *.WORD LSL ; 153 *.WORD LDE ; 154 *.WORD LAE ; 155 *.WORD NONE ; 156 *.WORD LPR ; 157 *.WORD *.WORD MVL ; 15 MOVE LEFT *.WORD MVR ; 16 MOVE RIGHT *.WORD NILV ; 17 EXIT *.WORD UREAD ; 18 UNITREAD *.WORD UWRT ; 19 UNITWRITE *.WORD TIM ; 20 TIME *.WORD FLC ; 21 FILLCHAR *.WORD SCN ; 22 SCAN BYTE ARRAY *.WORD IOC ; 23 IOCHECK *.WORD GETPOOLBYTES ; 24 GET POOL BYTES *.WORD PUTPOOLBYTES ; 25 PUT POOL BYTES *.WORD FLIPSEGBYTES ; 26 FLIP THE BYTES OF A SEGMENT *.WORD QUIETC ; 27 SUPPRESS EV BPT ; 158 *.WORD BNOT ; 159 *.WORD LOR ; 160 *.WORD LAND ; 161 *.WORD ADI ; 162 *.WORD SBI ; 163 *.WORD STL ; 164 *.WORD SROS ; 165 *.WORD STR ; 166 *.WORD LDB ; 167 *.WORD NAT ; 168 *.WORD NATINFO ; 169 *.WORD UNDF ; 170 *.WORD CAP ; 171 *.WORD CSP ; 172 *.WORD SLOD1 ; 173 *.WORD SLOD2 ; 174 *.WORD UNDF ; 175 *.WORD SLDCI ; 6 *.WORD SLDCI ; 7 *.WORD SLDCI ; 8 *.WORD SLDCI ; 9 *.WORD SLDCI ; 10 *.WORD SLDCI ; 11 *.WORD SLDCI ; 12 *.WORD SLDCI ; 13 *.WORD SLDCI ; 14 *.WORD SLDCI ; 15 *.WORD SLDCI ; 16 *.WORD SLDCI ; 17 *.WORD SLDCI ; 18 *.WORD SLDCI ; 19 *.WORD SLDCI ; 20 *.WORD SLDCI ; 21 *.WORD SLDCI ; 22 *.WORD SLDCI ; 23 *.WORD SLDCI ; 24 *.*.WORD EQUI ; 176 *.WORD NEQI ; 177 *.WORD LEQI ; 178 *.WORD GEQI ; 179 *.WORD LEQU ; 180 *.WORD GEQU ; 181 *.WORD SETCOMP ; 182 *.WORD SETCOMP ; 183 *.WORD SETCOMP ; 184 *.WORD EQBYT ; 185 *.WORD LEBYT ; 186 *.WORD GEBYT ; 187 *.WORD SRS ; 188 *.WORD SWAP ; 189 *.WORD TNC ; 190 *.WORD RND ; 191 *.WORD ADR ; 192 *.WORD SBR ; 193 *.WORD WORD SLDCI ; 25 *.WORD SLDCI ; 26 *.WORD SLDCI ; 27 *.WORD SLDCI ; 28 *.WORD SLDCI ; 29 *.WORD SLDCI ; 30 *.WORD SLDCI ; 31 *.WORD SLDLS ; 32 *.WORD SLDLS ; 33 *.WORD SLDLS ; 34 *.WORD SLDLS ; 35 *.WORD SLDLS ; 36 *.WORD SLDLS ; 37 *.WORD SLDLS ; 38 *.WORD SLDLS ; 39 *.WORD SLDLS ; 40 *.WORD SLDLS ; 41 *.WORD SLDLS ; 42 *.WORD SLDLS ; 43      ENTS *.WORD ENABLEC ; 28 ENABLE EVENTS *.WORD ATTACH ; 29 ATTACH *.WORD IOR ; 30 IORESULT *.WORD UBUSY ; 31 UNITBUSY *.WORD POT ; 32 POWER OF TEN *.WORD UWAIT ; 33 UNITWAIT *.WORD UCLR ; 34 UNITCLEAR *.WORD NILV ; 35 DUMMY *.WORD USTATUS ; 36 USTATUS *.WORD IDS ; 37 IDSEARCH *.WORD TRS ; 38 TREESEARCH *.WORD READSEG ; 39 READ A SEGMENT FROM DISK  MAXCSP .EQU 39  ;  ; BYTE 13,15 *.ASCII "END " *.BYTE 9,15 *.ASCII "EXTERNAL" *.BYTE 53,15  ;  FTABLE .ASCII "FOR " *.BYTE 24,15 *.ASCII "FILE " *.BYTE 46,15 *.ASCII "FORWARD " *.BYTE 34,15 *.ASCII "FUNCTION" *.BYTE 32,15  ;  GTABLE .ASCII "GOTO " *.BYTE 26,15  ;  ITABLE .ASCII "IF " *.BYTE 20,15 *.ASCII "IMPLEMEN" *.BYTE 52,15 *.ASCII "IN " *.BYTE 41,14 *.ASCII "INTERFAC" *.BYTE 51,15  ;  ; THE FOLLOWING ARE JUMP TABLES AND BIT MASK TABLES USED BY THE  ; VARIOUS SET BUILDING, SET ADJUSTING, AND SET COMPARISON ROUTINES.  ;  ; TABLE WITH INDIVIDUAL BITS SET IN EACH WORD (0-15).  BITWORDS .WORD 1 *.WORD 2 *.WORD 4 *.WORD 8 *.WORD 16 *.WORD 32 *.WORD 64 *.WORD 128 *.WORD 256 *.WORD 512 *.WORD 1024 *.WORD 2048 *.WORD 4096 *.WORD 8192 *.WORD 16384 *.WORD 8000H  ;  ; MASK TABLE.  ONMASKS .WORD 0 *.WO LTABLE .ASCII "LABEL " *.BYTE 27,15  ;  MTABLE .ASCII "MOD " *.BYTE 39,4  ;  NTABLE .ASCII "NOT " *.BYTE 38,15  ;  OTABLE .ASCII "OF " *.BYTE 11,15 *.ASCII "OR " *.BYTE 40,7  ;  PTABLE .ASCII "PACKED " *.BYTE 43,15 *.ASCII "PROCEDUR" *.BYTE 31,15 *.ASCII "PROCESS " *.BYTE 56,15 *.ASCII "PROGRAM " *.BYTE 33,15  ;  RTABLE .ASCII "RECORD " *.BYTE 45,15 *.ASCII "REPEAT " RD 1 *.WORD 3 *.WORD 7 *.WORD 0FH *.WORD 1FH *.WORD 3FH *.WORD 7FH *.WORD 0FFH *.WORD 1FFH *.WORD 3FFH *.WORD 7FFH *.WORD 0FFFH *.WORD 1FFFH *.WORD 3FFFH *.WORD 7FFFH *.WORD 0FFFFH  ;  ;  SETJMPS .WORD EQUSET *.WORD LEQSET *.WORD GEQSET  ;  ;  ; THE FOLLOWING SHIFT INSTRUCTION TABLES ARE USED BY THE  ; PACKED FIELD INSTRUCTIONS (LDP,STP,IXP) TO MANIPULATE  ; PACKED FIELDS WITHIN WORDS.  ; *.BYTE 22,15  ;  STABLE .ASCII "SEPARATE" *.BYTE 54,15 *.ASCII "SET " *.BYTE 42,15 *.ASCII "SEGMENT " *.BYTE 33,15  ;  TTABLE .ASCII "THEN " *.BYTE 12,15 *.ASCII "TO " *.BYTE 7,15 *.ASCII "TYPE " *.BYTE 29,15  ;  UTABLE .ASCII "UNIT " *.BYTE 50,15 *.ASCII "UNTIL " *.BYTE 10,15 *.ASCII "USES " *.BYTE 49,15  ;  VTABLE .ASCII "VAR " *.BYTE 30,15  ; *.ALIGN 2  LSHIFTS .WORD 1000H ; 1000 IS 'NOP' INSTRUCTION ON THE 9900 *SLA R1,1 *SLA R1,2 *SLA R1,3 *SLA R1,4 *SLA R1,5 *SLA R1,6 *SLA R1,7 *SLA R1,8 *SLA R1,9 *SLA R1,10 *SLA R1,11 *SLA R1,12 *SLA R1,13 *SLA R1,14 *SLA R1,15  ;  ;  RSHIFTS .WORD 1000H ; NOP *SRL R3,1 *SRL R3,2 *SRL R3,3 *SRL R3,4 *SRL R3,5 *SRL R3,6 *SRL  WTABLE .ASCII "WHILE " *.BYTE 23,15 *.ASCII "WITH " *.BYTE 25,15    R3,7 *SRL R3,8 *SRL R3,9 *SRL R3,10 *SRL R3,11 *SRL R3,12 *SRL R3,13 *SRL R3,14 *SRL R3,15  ;  ;  CIRCTABL .WORD 1000H ; NOP *SRC R0,15 *SRC R0,14 *SRC R0,13 *SRC R0,12 *SRC R0,11 *SRC R0,10 *SRC R0,9 *SRC R0,8 *SRC R0,7 *SRC R0,6 *SRC R0,5 *SRC R0,4 *SRC R0,3 *SRC R0,2 *SRC R0,1 *.WORD 1000H  ;  ;  ; THE FOLLOWING TABLE IS USED BY THE IDSEARCH ROUTINE TO SET THE  ; PARAMETERS ( # OF WORDS IN TABLE, ADDRESS OF CORRECT TABLE),  ; NEEDED TO DETERMINE IF A GIVEN TOKEN IS A PASCAL RESERVED WORD.  CHARTABL .WORD ATABLE,2 *.WORD BTABLE,1 *.WORD CTABLE,2 *.WORD DTABLE,4 *.WORD ETABLE,3 *.WORD FTABLE,4 *.WORD GTABLE,1 *.WORD NOKEYWRD,1 *.WORD ITABLE,4 *.WORD NOKEYWRD,1 *.WORD NOKEYWRD,1 *.WORD LTABLE,1 *.WORD MTABLE,1 *.WORD NTABLE,1O^£C„Ó *.WORD OTABLE,2 *.WORD PTABLE,4 *.WORD NOKEYWRD,1 *.WORD RTABLE,2 *.WORD STABLE,3 *.WORD TTABLE,3 *.WORD UTABLE,3 *.WORD VTABLE,1 *.WORD WTABLE,2 *.WORD NOKEYWRD,1 *.WORD NOKEYWRD,1 *.WORD NOKEYWRD,1  ;  ;  ; THE FOLLOWING ARE THE PASCAL RESERVED WORD TABLES, WITH APPROPRIATE  ; SY AND OP INFORMATION, USED BY THE IDSEARCH ROUTINE.  NOKEYWRD .ASCII "@@@@@@@@" ; FOR ENTRIES IN CHARTABL THAT 2*.BYTE 0,15 ; HAVE NO KEY WORDS.  ;  ;  ATABLE .ASCII "AND " *.BYTE 39,2 *.ASCII "ARRAY " *.BYTE 44,15  ;  BTABLE .ASCII "BEGIN " *.BYTE 19,15  ;  CTABLE .ASCII "CASE " *.BYTE 21,15 *.ASCII "CONST " *.BYTE 28,15  ;  DTABLE .ASCII "DEFINITI" *.BYTE 0,15 *.ASCII "DIV " *.BYTE 39,3 *.ASCII "DO " *.BYTE 6,15 *.ASCII "DOWNTO " *.BYTE 8,15  ;  ETABLE .ASCII "ELSE " *.      ; return to BIOS ($2 .WORD 0 ; for saving return addr  ;  ;  .PAGE  ;  ; Support procedures Sig and Delink.  ;  ; procedure Sig ( s : ^semaphore ) ;  ;  ; Does a signal on a semaphore. Assumes all events are disabled.  ; The semaphore address is passed in register R1.  ;  SIG C SEMWTQ(R1),NIL ; if waitq <> nil 0JEQ $2 ; 0C SEMCNT(R1),ZERO ; and count => 0 then Ą0MOV *SP+,R2 ; r2 has ^semaphore 0SLA R1,1 ; make event # an offset 0QUIET ; suppress events 0MOV R2,@ENVVEC(R1) ; stuff semaphore address 0ENABLE ; allow events 0B *BK ; back to ifetch...  ;  ;  ; procedure quietc ;  ;  ; suppresses events.  ;  QUIETC QUIET 0B *BK  ;  ;  ; procedure enablec ;  ;  ; allows events  ;  ENABLEC ENAB0JLT $2 ; 0MOV SEMWTQ(R1),R4 ; r4 := s^.waitq 0MOV R11,$4 ; save return reg 0BL DEQUE ; remove waiting task 0MOV R4,SEMWTQ(R1) ; update head of s^.waitq 0MOV NIL,TIBHANG(R5) ; r5^.hangp := nil 0MOV READYQ,R4 ; put tib on rdyq 0BL ENQUE 0MOV $4,R11 ; restore return reg 0MOV R4,READYQ ; update head of rdyq 0MOV CURTASLE 0B *BK  .PAGE  ;  ; The following procedures implement the p-codes signal and wait  ;  ; procedure signal (s : ^semaphore) ;  ;  ; disables events and does a signal on the semaphore residing on the stack.  ;  SIGNAL .WORD $0 ($0 MOV *SP+,R1 ; r1 has semaphore address 0QUIET ; disable events 0BL SIG ; signal using the semaphore 0ENABLE ; allow events to occur K,R4 ; r4 := ptr to cur tib 0CB TIBPRI+1(R4),TIBPRI+1(R5); if cur^.pr < temp^.pr then 0JH $1 ; 0TSON ; setup for taskswitch ($1 ; endif 0JMP $3 ; else ($2 INC SEMCNT(R1) ; bump up semaphore ($3 ; endif 0B *R11 ; return to caller 0B *BK ; back to ifetch  ;  ;  ; procedure wait ( s : ^semaphore ) ;  ;  ; disables events and waits on the semaphore residing on the stack.  ;  WAIT .WORD $0 ($0 MOV *SP+,R1 ; r1 has semaphore address 0QUIET ; disable events 0C SEMCNT(R1),ZERO ; if s^.count <= 0 then 0JGT $1 0BL DELINK ; remove curtask from rdyq 0MOV SEMWTQ(R1),R4 ; r4 := s^.waitq($4 .WORD 0 ; return save area  ;  ;  ; procedure delink ;  ;  ; Removes the current task from the ready Queue.  ;  DELINK C CURTASK,READYQ ; if curtask at head then 0JNE $1 ; 0MOV CURTASK,R2 ; r2 := ^curtask tib 0MOV TIBLNK(R2),READYQ ; rdyq := r2^.next 0MOV NIL,TIBLNK(R2) ; curtask^.next := nil 0B *R11 ; return to caller ($1  0MOV CURTASK,R5 ; r5 := current task tib ptr 0BL ENQUE ; place curtask on waitq 0MOV R4,SEMWTQ(R1) ; reset waitq head 0MOV CURTASK,R2 ; r2 := current task tib ptr 0MOV R1,TIBHANG(R2) ; r2^.hangptr := s 0TSON ; setup for task switch 0JMP $2 ; else ($1 DEC SEMCNT(R1) ; decrement s^.count ($2 ; endif  ; endif 0MOV READYQ,R2 ; r2 := head of rdyq 0MOV ZERO,R3 ; r3 := nil ($2 MOV R2,R2 ; while r2 <> nil do 0JEQ $3 ; 0C R2,CURTASK ; exit if r2 = curtask 0JEQ $3 ; 0MOV R2,R3 ; r3 := r2 0MOV TIBLNK(R2),R2 ; r2 := r2^.next 0JMP $2 ; endloop ($3 0ENABLE ; allow events 0B *BK ; back to ifetch  ;  .PAGE  ;  ; procedure taskswch ;  ;  ; Called only via a modification of the BK register (by TSON). Saves  ; the state of the current task and makes the head of the ready queue  ; the current executing task.  ;  TASKSWCH BL SAVREG ; save state of the curtask 0QUIET ; disable interrupts 0MOV READYQ,CURTASK ; curtask := hea0CI R2,NILV ; if r2 <> nil then 0JEQ $4 ; 0MOV TIBLNK(R2),TIBLNK(R3) ; r3^.next := r2^.next ( MOV NIL,TIBLNK(R2) ; r2^.next := nil ($4 ; endif 0B *R11 ; return  .PAGE  ENQUE  ; THIS ROUTINE PLACES TIB POINTED TO BY R5 INTO QUEUE WHOSE  ; HEAD IS R4. R4 LEFT WITH UPDATED QUEUE HEAD POINTER.  ; ALGORITHM IS LINKED LIST PRIORITY SCHEME. *MOV R4,R6 d of rdyq 0TSOFF ; turn off task switch 0ENABLE ; allow events 0BL RESTOR ; setup up curtask 0B *BK  ;  ; procedure event ( n : integer ) ;  ;  ; Called by BIOS to signal an event. Assumes events are disabled  ; when call is made. Register R9 contains the parameter. Event  ; picks up the semaphore associated with the event and gives it to  ; Sig.  ;  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ;  EVENT MOV R9,R1 ; copy event # 0SLA R1,1 ; turn into byte offset 0C @ENVVEC(R1),NIL ; if semaphore <> nil then 0JEQ $1 ; 0MOV @ENVVEC(R1),R1 ; r1 := envvec(r1) 0MOV R11,$2 ; save return address 0BL SIG ; signal using r1 0MOV $2,R11 ; restore return addr ($1 ; endif 0B *R11  ;  ;****************************************************************************   ;  ;********** CONCURRENCY ROUTINES **********  ;  ; The following routines are concurrency routines which are accessed  ; via the csp table.  ;  ;  ; procedure attach ( s : ^sem ; n : event_number ) ;  ;  ; associates a semaphore with an event in the event vector.  ;  ATTACH MOV *SP+,R1 ; r1 has event number       ; R6 IS CURRENT ELEMENT POINTER *MOV NIL,R7 ; R7 IS PREVIOUS NODE  $1 C R6,NIL ; OFF END OF LIST? *JEQ $2 ; IF SO THEN GO INSERT IT *CB TIBPRI+1(R6),TIBPRI+1(R5) ; ELSE...IS CURRENT PRIORITY *JL $2 ; LESS THAN REQUESTED PRIORITY? *MOV R6,R7 ; NO, LINK DOWN QUEUE *MOV TIBLNK(R6),R6 *JMP $1  $2 MOV R6,TIBLNK(R5) ; LINK R6 (TIB TO FOLLOW R5) AFTER R5  ;  ;****************************************************************************  ;  ;  ;  ; STANDARD PROCEDURE IDSEARCH. TOS CONTAINS THE SYMBOL BUFFER ADDRESS,  ; TOS-1 CONTAINS THE ADDRESS OF SYMCURSOR, WHICH IS THE INDEX TO ADD ON  ; TO THE BUFFER ADDRESS TO GIVE THE SEARCH START ADDRESS. FOLLOWING  ; SYMCURSOR IN MEMORY ARE SY AND OP, WHICH WILL BE USED TO DESCRIBE  ; THE TOKEN IF IT IS A RESERVED WORD, AND IDCODE, AN 8 CHARACTER *C R7,NIL ; CHECK IF IT'S AT LIST HEAD *JEQ $3 *MOV R5,TIBLNK(R7) ; LINK R7 (TIB BEFORE R5) TO R5 *B *R11  $3 MOV R5,R4 ; ELSE QUEUE HEAD AT TASK *B *R11 ; RETURN  ;  ;  DEQUE  ; REMOVES FIRST ELEMENT IN QUEUE WHOSE HEAD IS IN R4. R5 HAS  ; CURRENT TIBP AND R4 LEFT WITH UPDATED QUEUE HEAD POINTER.  ; *MOV R4,R5 ; RETURN HEAD OF LIST *MOV TIBLNK(R5),R4 ; BUMP LIST HEAD TO NEXT ELEMENT *MOV  ; PACKED ARRAY TO BE FILLED WITH THE FIRST 8 CHARACTERS OF THE  ; TOKEN IF IT IS AN IDENTIFIER. AT THE END OF IDSEARCH SYMCURSOR  ; WILL POINT TO THE LAST CHARACTER OF THE TOKEN, AND SY AND OP WILL  ; BE FILLED WITH THE APPROPRIATE INFORMATION ABOUT THE TOKEN.  ;  ;  IDS *MOV *SP+,R1 ; GET BUFFER BASE ADDRESS *MOV R1,STSEARCH ; SAVE IT FOR LATER *MOV *SP+,R2 ; ADDRESS OF SYMCURSOR *A *R2,R1 ; COMPUTES SEARCH START ADDRESS *MOV R2,SAVNIL,TIBLNK(R5) ; CLEANUP *RT ; RETURN  ;  ;  SAVREG  ; MOVES INTERP INTERNAL VERSIONS OF TIB REGISTERS INTO  ; CURTASK TIB. R5 LEFT WITH CURTASK POINTER IN IT.  ; *MOV CURTASK,R5 *MOV MP,TIBMP(R5) *MOV IPC,TIBIPC(R5) *S SEG,TIBIPC(R5) ; IPC IS SEG RELATIVE *MOV EREC,TIBEREC(R5) *MOV SP,TIBSP(R5) *MOVB @CURPROC+1,@TIBPROC(R5) *MOVB @IORESULT+1,TIBIOR(R5) ; STUFF CURRENT IORESULT *RT  ;  ;  RESTOR SYM ; SAVE ADDRESS OF SYMCURSOR FOR LATER *MOV R2,R4 ; SYMCURSOR ADDR IN R4 *INCT R2 ; POINT R2 AT SY ADDRESS NOW *AI R4,6 ; POINT AT ADDRESS OF 'IDCODE' *LI R3,4 ; IDCODE WORD COUNT  MOV R4,R5 ; save idcode starting address  $11 MOV BLANK,*R4+ ; BLANK OUT IDCODE *DEC R3 *JGT $11 *MOV R5,R4 ; restore idcode start address  ; COPIES TIB REGISTER VALUES INTO INTERNAL INTERP REGISTERS.  ; *MOV R11,SAVRTN *MOV CURTASK,R5 *MOV TIBMP(R5),MP *MOV TIBIPC(R5),IPC *MOV TIBSP(R5),SP (CLR @CURPROC (MOVB @TIBPROC(R5),@CURPROC+1 (MOVB TIBIOR(R5),@IORESULT+1 ; RESTORE IORESULT (MOV @TIBEREC(R5),R5 (MOV R5,@EREC (MOV @ENVEVEC(R5),@EVEC (MOV @ENVSIB(R5),@SIB (MOV @ENVDATA(R5),BASE (CLR @SEG (MOV IPC,@IPCFLT (BL @SEGCHK1 (MOV R4,@SEG (A *LI R3,8 ; IDCODE CHAR COUNT  $22 MOVB *R1+,R6 ; pickup next byte *CB R6,UNDRLINE *JEQ $22 ; underlines are not significant, skip *CB R6,BYTE9 ; check if less than 9 *JLE $1 *ANDI R6,0DF00H ; insure only upper case letters *CB R6,ABYTE ; check if in 'A'..'Z' *JL $5 ; end of token if not *CB R6,ZBYTE *JH $5  $33 DEC R3 ; check for significance, 8 di R4,IPC (INC @TIMSTMP ; INCREMENT TIMSTAMP (MOV @SIB,R1 ; GET SIB^ (MOV @TIMSTMP,@SEGACT(R1) ; UPDATE SIB TIMSTAMP (MOV @SAVRTN,R11 (B @CHKSEX   gits max *JLT $22 *MOVB R6,*R4+ ; stuff into idcode *JMP $22 ; on to next char  $1 CB R6,BYTE0 ; check if in '0'..'9','$' *JHE $33 ; end of token if not *CB R6,DOLLAR *JEQ $33  $5 DECT R1 ; POINT R1 AT LAST CHAR OF TOKEN *S STSEARCH,R1 ; GIVES OFFSET TO LAST CHAR OF TOKEN *MOV R1,IDEND ; SAVE THE OFFSET *MOV R5,R4 ; POINT BACK TO FIRST CHAR OF IDCODE O^£C„Ó*CLR R1 ; CLEAR FOR THE MOVB COMING UP *MOVB *R4,R1 ; GET THE FIRST CHAR *SWPB R1 ; RIGHT JUSTIFY IT *AI R1,CHARNORM ; NORMALIZE IT TO 0...25 FOR TABLE INDEX *SLA R1,2 ; MPY BY 4 TO CORRECTLY INDEX TABLE *MOV CHARTABL(R1),R3; GET CORRECT RESERVED WORD TABLE ADDR *MOV CHARTABL+2(R1),R1 ; AND # OF WORDS IN THAT TABLE *B FINDKEY ; GO DO SEARCH ON THAT TABLE  ;  ;  ;  ; FINDKEY SEARCHES THE APPROPRI"ATE RESERVED WORD TABLE TO SEE  ; IF THE TOKEN IN IDCODE IS ONE OF THEM. IF IT IS, SY AND  ; OP WILL BE FILLED AND IDCODE BLANKED OUT. IF THE TOKEN IS AN  ; IDENTIFIER HOWEVER, THE FIRST 8 CHARS WILL BE LEFT IN IDCODE,  ; AND SY AND OP SET TO 0. FINDKEY EXPECTS THE # OF WORDS IN THE  ; TABLE IT IS SEARCHING TO BE IN R1, AND THE TABLE ADDRESS IN R3.  FINDKEY *LI R0,4 ; WORD COUNTER (EACH ENTRY 4 WRDS LONG) *MOV R3,TEMP ; SAVE SEARCH START ADDRESS FOR LATER  ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ;       $66 DEC R1 ; DECR THE RESERVED WORD TABLE COUNTER *JEQ $77 ; NONE LEFT IN TABLE TO CHECK *MOV TEMP,R3 ; GET PREVIOUS SEARCH START ADDRESS *A CHARINDX,R3 ; BUMP TO NEXT ENTRY IN TABLE *MOV R5,R4 ; POINT R4 BACK AT START OF IDCODE *JMP FINDKEY ; AND PROCEED WITH THE SEARCH  ;  ; REACH HERE IF TOKEN IN IDCODE IS NOT A RESERVED WORD.  ;  $77 MOV SAVSYM,R2 ; GET ADDRESS OF SYMCURSOR *MOV O^£Į„r IDEND,*R2 ; OFFSET TO END OF TOKEN WE FOUND *INCT R2 ; R2 NOW HAS ADDRESS OF SY *CLR *R2+ ; ZERO SY *LI R1,15 ; AND SET OP TO 'NOP' VALUE *MOV R1,*R2 ; *B *BK ; FINISHED   ;  ;  ;  ; TREESEARCH(TREEROOTPOINTER, VAR FOUNDP, VAR TARGETNAME)  ; ;  ; EACH NODE OF THE TREE CONTAINS (IN ORDER) : AN 8-CHAR CODE NAME, A  ; POINTER TO THE RIGHT SUBTREE, AND A POINTER TO THE LEFT SUBTREE. ON €aˆ ; THE STACK ARE: TARGET NAME ADDRESS POINTER, POINTER TO A VARIABLE  ; "FOUNDP" IN WHICH THE FIND ADDRESS WILL BE STORED, AND A POINTER TO  ; THE ROOT OF TREE.  ;  ; RETURNS POINTER TO TARGET NODE THROUGH CALL-BY-NAME PARAMETER AND  ; DESCRIPTION OF SEARCH RESULTS AS INTEGER FUNCTION WITH THREE POSSIBLE  ; VALUES:  ; 0: TARGET NAME WAS FOUND; FOUNDP POINTS TO IT  ; 1: NO MATCH; TARGET > LEAF NODE; FOUNDP POINTS TO LOC FOR LEAF  ; -1: NO MATCH; TARGET < LEAF NODE; FOUNDP POINT ;****************************************************************************  ; ;  ;This is an unpublished work ;  ; Copyright (c) 1980 by Regents of the University of California ;  ; Copyright (c) 1981 by Texas Instruments Inc. ;  ; Copyright (c) 1980, 1981 by Softech Microsystems, Inc. ;  ; S TO LOC FOR LEAF  ;  ;  TRS *MOV *SP+,R1 ; GET ADDRESS OF TARGETNAME *MOV 2(SP),R2 ; GET ROOT OF TREE  TLOOP C *R1,*R2 ; FIRST WORD COMPARE *JNE SUBTREE *C 2(R1),2(R2) ; SECOND WORD *JNE SUBTREE *C 4(R1),4(R2) ; THIRD WORD *JNE SUBTREE *C 6(R1),6(R2) ; FOURTH WORD *JNE SUBTREE ; *CLR R1 ; HERE ALL EQUAL (FOUND!) SO FUNCTION VALUE=0  ;  ;****************************************************************************  ;  ;**********************************************************************  ;  ; I/O DATA SEGMENT  ;  ;**********************************************************************  ;  .ALIGN 2  ;  ; BIOS ENTRY POINT OFFSETS  ;  CSIN .WORD 0 ; BIOS ENTRY PT OFFSET FOR READS : CONSL/SYSTRM *JMP EXITTRS ; AND EXIT TREESEARCH  SUBTREE JH RTREE ; IF TARGET > ROOT, THEN GO TO RIGHT SUBTREE *MOV 10(R2),R4 ; ELSE GET ROOT OF LEFT SUBTREE C; IF ROOT OF LEFT SUBTREE <> NIL (0) *JNE NEWROOT ; THEN CONTINUE SEARCH WITH NEWROOT=LLINK *LI R1,-1 ; ELSE SEARCH OVER, FUNCTION VALUE=-1, *JMP EXITTRS ; AND EXIT TREESEARCH  RTREE MOV 8(R2),R4 ; GET ROOT OF RIGHT SUBTREE C; IF ROOT OF RIGH RIN .WORD 12 ; : REMOTE  CSOUT .WORD 1 ; BIOS ENTRY PT OFFSET FOR WRITES : CONSL/SYSTRM  POUT .WORD 5 ; : PRINTER  ROUT .WORD 13 ; : REMOTE  DIN .WORD 8 ; BIOS ENTRY PT OFFSET FOR DISK IO: DISK READ  DOUT .WORD 9 ; (*PRESERVE ORDER*) : DISK WRITE  DSTAT .WORD 11 ; T SUBTREE <> NIL (0) *JNE NEWROOT ; THEN CONTINUE SEARCH WITH NEWROOT=RLINK *LI R1,1 ; ELSE SEARCH OVER, FUNCTION VALUE=1, AND C; EXIT TREESEARCH (*FALL THROUGH*)  EXITTRS MOV *SP+,R4 ; SEARCH OVER. GET "FOUNDP" ADDRESS POINTER *MOV R2,*R4 ; STORE THE CURRENT ROOT THERE *INCT SP ; POP OFF ROOT POINTER *MOV R1,*SP ; RETURN FUNCTION VALUE AT TOP OF STACK *B *BK  $0 C *R4+,*R3+ ; COMPARE IDCODE TO TABLE ENTRY *JNE $66 ; GO MATCH AGAINST NEXT WORD IN TABLE *DEC R0 ; DECR WORD COUNT *JGT $0 ; CONT. ON THIS ENTRY TIL ALL 4 WRDS CHEKD  ;  ; THE TOKEN IN IDCODE IS FOUND TO BE A RESERVED WORD.  ; *MOV SAVSYM,R1 ; ADDRESS OF SYMCURSOR *MOV IDEND,*R1 ; POINT SYMCURSOR AT LAST CHAR OF TOKEN *CLR *R2 ; CLEAR SY LOCATION FOR MOVB *MOVB *R3+,1(R2)  NEWROOT MOV R4,R2 ; NEWROOT:= ROOT OF APPROPRIATE SUBTREE *JMP TLOOP ; CONTINUE THE SEARCH WITH NEWROOT  ;  ;   ; FILL SY WITH PROPER VALUE *INCT R2 ; POINT R2 AT OP NOW *CLR *R2 ; CLEAR OP LOCATION FOR MOVB *MOVB *R3+,1(R2) ; NOW FILL OP WITH PROPER VALUE ALSO *INCT R2 ; R2 NOW POINTS AT IDCODE *LI R4,4 ; IDCODE WORD COUNT  $1 MOV BLANK,*R2+ ; BLANK OUT IDCODE *DEC R4 ; DECR COUNTER *JGT $1 *B *BK ; FINISHED  ;       : DISK STATUS  USERREAD .WORD 16 ; BIOS ENTRY POINT OFFSET FOR USER UNITS READ  USERWRIT .WORD 17 ; WRITE  USERCLR .WORD 18 ; CONTROL  USERSTAT .WORD 19 ; STATUS  SYSIN .WORD 20 ; BIOS ENTRY POINT OFFSET FOR SYSTEM: READ  SYSOUT .WORD 21 ; : WRITE *.WORD CONBOOL ; UNIT 1 : CONSOLE *.WORD REMBOOL ; UNIT 2 : SYSTERM *.WORD -1 ; *.WORD -1 *.WORD -1 *.WORD LPBOOL ; UNIT 6 : PRINTER *.WORD REMBOOL ; UNIT 7 : REMIN *.WORD REMBOOL ; UNIT 8 : REMOUT *.WORD -1 *.WORD -1 *.WORD -1 *.WORD -1  ;  ;  DLE .BYTE 16  CR .BYTE 13  LF .BYTE 10 *.ALIGN 2  CONTWORD .WORD 0 ; CONTROL WORD PARAMETER TO UNIT I/O ROUTINES  SERIN .WORD 26 ; BIOS ENTRY POINT OFFSETS FOR SERIAL: READ  SEROUT .WORD 27 ; : WRITE  SERCLR .WORD 28 ; : CLEAR  SERSTAT .WORD 29 ; : STATUS  ;  ; DATA BLOCKS USED TO INVOKE BIOS (EACH 7 WORDS ACCORDING TO BIOS SPEC):  ; (IORESULT RETURNED IN 7TH WORD)  ;  CLROP .WORD 0 ; UNIT CLEAR DATA BLOCK *.WORD BBBREAK ; FOR C SYREADB .WORD 0 ; SYSREAD BOOLEAN (INDICATES NON-CSP I/O ENTRY)  BIOSRSLT .EQU 12 ; OFFSET FOR IORESULTS=LAST WORD OF DATA BLOCKS  DLEADJ .EQU -32 ; DLE ADJUST (EXPANSION CHAR = # BLANKS + 32)  SYSDEF .EQU 8 ; # SYSTEM DEFINED UNITS  ;  ;  ; UNITIO TABLE: EACH UNITTAB ENTRY CONTAINS THE ADDRESSES OF THE  ; APPROPRIATE ROUTINES FOR READING OR WRITING TO  ; THAT UNIT. A DRIVER ADDRESS OF 0 MEANS THAT I/O  ; ONSOLE ONLY: BIOS BREAKPOINT ROUTINE *.WORD SYSCMB ; FOR CONSOLE ONLY: ADDRESS OF SYSCOM DATA BLK *.WORD EVENT ; FOR SYSTEM ONLY : ADDRESS OF EVENT ROUTINE *.WORD 0 *.WORD 0 *.WORD 0  ;  INOP .WORD 0 ; DATA BLOCK FOR SPEC-CHAR/CONTROLLED READS:  CHARIN .WORD 0 ; CONSOLE/SYSTERM(0) & REMOTE(24) *.WORD 0 *.WORD 0 *.WORD 0 *.WORD 0 *.WORD 0  ;  DIRECTION IS NOT ALLOWED FOR THAT UNIT.  ;  IODRVR .WORD 0 ; DIRECTION: READING OR WRITING FOR THAT UNIT  RDDRVR .WORD 0 ; RDDRVR =0 (OFFSET IS 0 FOR READ ROUTINE ADDR)  WRTDRVR .WORD 2 ; WRTDRVR=2 (OFFSET IS 2 FOR WRITE ROUTINE ADDR)  ;  UNITTAB *.WORD SYSRD,SYSWRT ; UNIT 0 : SYSTEM *.WORD CONREAD,CONWRT ; UNIT 1 : CONSOLE *.WORD STRMRD,CONWRT ; UNIT 2 : SYSTERM *.WORD 0,0 ; UNIT 3 : GRAPHICS (NOT USED)  OUTOP .WORD 0 ; DATA BLOCK FOR SPEC-CHAR/CONTROLLED WRITES:  CHAROUT .WORD 0 ; CONSOLE/SYSTERM(2), PRINTER(10), OR REMOTE(26) *.WORD 0 *.WORD 0 *.WORD 0 *.WORD 0 *.WORD 0  ;  DSKOP .WORD 0 ; SHARED BY DISK READ(16) AND DISK WRITE(18)  LOGBLKNO .WORD 0 ; LOGICAL BLOCK NUMBER  DCNT .WORD 0 ; NUMBER OF BYTES TO TRANSFER  DBUFF .WORD 0 ; BUFFER ADDRESS  DSKDRV .WORD 0 ; DI*.WORD DSKRD,DSKWRT ; UNIT 4 : DISK DRIVE 0 *.WORD DSKRD,DSKWRT ; UNIT 5 : DISK DRIVE 1 *.WORD 0,LPWRT ; UNIT 6 : LINE PRINTER *.WORD REMIN,0 ; UNIT 7 : REMIN *.WORD 0,REMOUT ; UNIT 8 : REMOUT  USERTAB .WORD USERRD,USERWT ; FOR USER UNIT I/O  BLKTAB .WORD BLKRD,BLKWRT ; EXTRA DISK DRIVES  SERTAB .WORD SERRD,SERWRT ; SERIAL DEVICES  ;  ; UNIT-CLEAR TABLE. DATA IS THE NUMBER TO PASS BIOS IN FIRST WORD  ; ZEROSK DRIVE NUMBER (* 0 -> 4 *) *.WORD 0 *.WORD 0 ; DISKIO IORESULT  ;  STATOP .WORD 0 ; IO PACKET FOR UNIT STATUS REQUEST  STATADDR .WORD 0 ; ADDRESS WHERE TO STORE STATUS *.WORD 0 *.WORD 0  STATDRV .WORD 0 ; DISK DRIVE(IF ANY)  STATCONT .WORD 0 ; IO DIRECTION *.WORD 0 ; IORESULT WORD  ;  ;  USEROP .WORD 0 ; IO PACKET FOR USER UNITS I/O *.WORD 0 ; UNUSED  VALUES INDICATE INVALID UNITS.  ;  CLRTAB  SYSCLR .WORD 22 ; UNIT 0 : SYSTEM  CCLR .WORD 2 ; UNIT 1 : CONSOLE *.WORD 2 ; UNIT 2 : SYSTERM *.WORD 0 ; UNIT 3 : GRAPHICS (NOT USED)  DCLR .WORD 10 ; UNIT 4 : DISK DRIVE 0 *.WORD 10 ; UNIT 5 : DISK DRIVE 1  PCLR .WORD 6 ; UNIT 6 : LINE PRINTER  RCLR .WORD 14 ; UNIT 7 : REMIN *.WORD 14 ; UNIT 8 : REMOUT  ;  UBYTES .WORD 0 ; NUMBER OF BYTES TO TRANSFER  UBUFA .WORD 0 ; BUFFER ADDRESS TO START  USERUNIT .WORD 0 ; USER UNIT NUMBER  UCONTW .WORD 0 ; CONTROL WORD *.WORD 0 ; IORESULT WORD  ;  ;  QOP .WORD 24 ; QUIET SVC CODE  EOP .WORD 25 ; ENABLE SVC CODE  ;  ;  PHYSTABL *.WORD -1 *.WORD -1 *.WORD -1 *.WORD -1 ; PLACEHOLDERS FOR TABLE INDEXING BY UNIT #  DSK0DRV .WORD  ; UNIT STATUS TABLE. (ENTRIES ARE BIOS NUMBERS FOR EACH DEVICE).  STATTABL  SYSSTAT .WORD 23 ; UNIT 0 : SYSTEM *.WORD 3 ; UNIT 1 : CONSOLE *.WORD 3 ; UNIT 2 : SYSTERM *.WORD 0 ; UNIT 3 : GRAPHICS (NOT USED) *.WORD 11 ; UNIT 4 : DISK DRIVE 0 *.WORD 11 ; UNIT 5 : DISK DRIVE 1 *.WORD 7 ; UNIT 6 : PRINTER *.WORD 15 ; UNIT 7 : REMIN *.WORD 15 ; UNIT 8 : REMOUT  0 ; UNIT NUMBER 4 => DISK DRIVE 0  DSK1DRV .WORD 1 ; 5 => DISK DRIVE 1 *.WORD -1 *.WORD -1 *.WORD -1 ; PLACEHOLDERS FOR TABLE INDEXING BY UNIT #  ;  ;  ;  CONBOOL .EQU 0 ; OFFSET FOR CONSOLE READ/WRITE BOOLEAN  LPBOOL .EQU 1 ; PRINTER WRITE BOOLEAN  REMBOOL .EQU 2 ; REMOTE READ/WRITE BOOLEAN  DLEBOOL .BYTE 0 ; DLE BOOLEAN FOR CONSOLE WRITE *.BYTE 0 ; PRINTER WRITE *.BYTE 0 ; REMOTE WRITE *.BLOCK 26 ; 26 SERIAL DEVICES  ;  ALPHBOOL .BYTE 0 ; ALPHALOCK BOOLEAN FOR CONSOLE *.BYTE 0 ; UNUSED *.BYTE 0 ; ALPHALOCK BOOLEAN FOR REMOTE *.BLOCK 26 ; 26 SERIAL DEVICES  ;  ;  ; TABLE USED TO CLEAR DEVICE BOOLEANS IN UNITCLEAR.  ; ONLY CONSOLE, SYSTERM, PRINTER, REMOTE HAVE THESE BOOLEANS.  CLRBOOL *.WORD -1 ; UNIT 0       POP_ARG *CLR FLT_ERR *BLWP FLT_MUL  BL PUSH_FAC *B CHK_ERR   ABR .WORD $0  $0 ABS *SP ; ABSOLUTE REALS *B *BK   NGR .WORD $0  $0 NEG *SP ; NEGATE REALS *B *BK   EQUREAL  LEQREAL  GEQREAL .WORD $0  $0 AI R1,CMP3TABL-410 *CLR FLT_ERR ; CLEAR ERROR INDICATOR *BL POP_FAC ; SETUP OPERANDS *BL POP_ARG  .PROC NOREALS  ; DUMMY FLOATING POINT ROUTINES  ; FORCE EXECERR WITH 'UNIMPLEMENTED INSTRUCTION' MESSAGE  ; *.REF BACK,TRAPER  *.DEF CTRL,EXRL,LDCRL,LDRL,STRL *.DEF ABR,ADR,DVR,FLT,MPR,NGR *.DEF POT,RND,SBR,TNC *.DEF EQUREAL,LEQREAL,GEQREAL *   NOTIMP .EQU 11  *.MACRO TRAP *BL @TRAPER ; CALL TRAPER *.WORD %1 ; XEQERR *.ENDM  ;  CTRL  EXRL .WORD BACK   LDCRL  LDRL  STRL  ABR  ADR  DVR  FLT*DECT SP ; MAKE ROOM ON STACK FOR RESULT *BL FCOMP ; DO COMPARISON  $1 MOV *SP,R0 ; SET STATUS BITS *B PUSHRSLT ; PUSH RESULT   RND .WORD $0  $0 CLR FLT_ERR ; ROUND - CLEAR ERROR INDICATOR *BL POP_FAC ; SETUP OPERAND *BLWP FLT_RND ; PERFORM ROUND *DECT SP ; COPY RESULT ONTO STACK *MOV FAC,*SP *B CHK_ERR ; CHECK FOR ERRORS   FLT   MPR  NGR  POT  RND  SBR  TNC  EQUREAL  LEQREAL  GEQREAL .WORD $0  $0 TRAP NOTIMP *.END   .WORD $0  $0 MOV *SP,R0 ; COPY INTEGER *AI SP,-6 ; MAKE ROOM ON STACK *MOV SP,R4 ; AND COPY OF SP *MOV R4,R2 ; CLEAROUT FOR USE AS DESTINATION *CLR *R2+ *CLR *R2+ *CLR *R2+ *CLR *R2 *MOV R0,R5 ; SAVE ORIGINAL IN R5 *JEQ $3 ; ZERO RESULT *ABS R0 ; DEAL WITH A POSITIVE # *LI R3,40H ; EXPONENT BIAS *CI R0,100 $EQUAL $CURSOR q6O.¤¤*JL $2 ; 0 FAC *JEQ $2 ; ARG = FAC, LEAVE 0 ON TOS *DEC *SP ; A*INC EXPNT ; YES, INCREMENT EXPONENT *LI R1,FAC+8 *LI R2,9  LB1 .EQU $+3  FADD30 MOVB *R1,1(R1) ; SHIFT FAC RIGHT ONE BYTE *DEC R1 *DEC R2 *JNE FADD30  FADD10 JMP ROUN1   FADD11 SB *R6,*R5 ; SUBT A BYTE OF SMALL FROM BIG *JGT FADD12 *JEQ FADD12 *AB R9,*R5 *SB R8,-1(R5)  FADD12 DEC R5 *DEC R6 *INC R4 *JLT FADD11 *JMP FADD14  FADD13 RG < FAC, SHOW -1 ON TOS *JMP $2 ; AND RETURN  $1 INC *SP ; ARG > FAC, SHOW +1 ON TOS  $2 B *R11  ;  FPWS .BLOCK 32 ; WORKSPACE FOR FLOATING OPERATIONS  FLT_ADD .WORD FPWS,FLT_ADD+4 *MOV ARG,R7 ; IS ARGUMENT ZERO? *JEQ FADD02 ; YES, NO CHANGE TO FAC *MOV FAC,R8 ; IS FAC ZERO? *JNE FADD03 ; NO, GO ADD FAC, ARG *LI R1,-8 ; YES, MOVE ARG TO FAC  AB R9,*R5 *DEC R5 *SB R8,*R5  FADD14 MOVB *R5,R4 *JLT FADD13 *JMP NORMAL  FADD15 B PACKUP  NORMAL LI R1,-9 ; NUMBER OF BYTES IN FAC INCLUDING C; GUARD BYTES.  NORM01 MOVB FAC+10(R1),R2 ; IS NEXT BYTE OF FAC NON-ZERO? *JNE NORM02 ; YES, SHIFT REST LEFT. *INC R1 ; NO. ALL BYTES ZERO? *JLT NORM01 ; YES, LOOK AT NEXT BYTE.  FMULZR  FADD01 MOV ARG+8(R1),FAC+8(R1) *INCT R1 *JLT FADD01  FADD02 RTWP ; EXIT  FADD03 XOR R8,R7 ; SIGN DIFFERENCE *ABS FAC ; TAKE ABSOLUTE VALUES OF FAC *ABS ARG ; AND ARG *LI R3,-8 ; ENSURE THAT LARGEST NUMBER C; IS IN FAC  FADD20 C FAC+8(R3),ARG+8(R3) *JGT FADD05 ; TRUE INITIALLY *JLT FADD21 ; NEED TO SWAP THIS WORD AND FOLLOW *INCT R3 *JNE FZERO CLR FAC ; INSTALL FLOATING ZERO *CLR FAC+2 ; CLEAR POSSIBLE BASIC TYPE CODE *RTWP ; AND EXIT  NORM02 MOV R1,R0 ; NUMBER OF NON-ZERO BYTES *AI R0,9 ; FIRST BYTE NON-ZERO? *JEQ ROUN1 ; YES, FINISH *S R0,EXPNT ; NO, ADJUST EXPONENT FOR SHIFT *LI R2,FAC+1 ; POINT TO FIRST BYTE OF FAC  NORM03 MOVB FAC+10(R1),*R2+; MOVE NON-ZERO BYTE C; TO FAC FIRST DIGIT. FADD20 ; COMPARE ALL 4 WORDS *JMP FADD05 ; FAC = ARG  FADD21 MOV ARG+8(R3),R0 *MOV FAC+8(R3),ARG+8(R3) *MOV R0,FAC+8(R3) *INCT R3 *JNE FADD21 ; CONTINUE THE SWAP *XOR R7,R8   FADD05 CLR R5 ; HANDY ZERO *CLR FAC+8 ; CLEAR GUARD DIGITS FOR FAC *CLR ARG+8 ; AND ARG *MOVB R8,SIGN ; SAVE RESULT SIGN *CLR R6 ; CLEAR HIGH BYTE OF EXP DIFF  *INC R1 ; IF NON-ZERO BYTES REMAIN *JLT NORM03 ; THEN MOVE ANOTHER BYTE C; ZERO LOW-ORDER BYTES REMAINING  NORM04 MOVB R1,*R2+ ; MOVE A ZERO *DEC R0 ; LAST BYTE DONE? *JGT NORM04 ; NO, CONTINUE. C; YES, ROUND THE NUMBER IN FAC C; AND FINISH UP  ROUN1 LI R0,50*256 ; *C FAC+8,R0 ; IS ROUNDING NECESSARY? *JLT PACKUP ; NO, PUT EXPONENT BACK *MOVB FAC,FPWS+13 ; FAC EXP TO RB(R6) *MOV R6,EXPNT ; USE FAC EXP AS RESULT EXP *MOVB R5,FAC ; CLEAR HIGH BYTE OF FAC TO CHECK C; FOR OVERFLOW *SB ARG,FPWS+13 ; SUBTRACT SMALLER EXPONENT *CI R6,7 ; SMALLER NUMBER TOO SMALL TO C; AFFECT THE SUM? *JGT FADD15 ; YES, RETURN WITH LARGER NUMBER C; IN FAC.  *MOV R6,R0 ; EXPONENT DIFFERENCE *LI R8,1*256 ; 1 FOR BYTE OPERATIONS *LI R9,100*256      NORMAL  FDIV01 LI R1,6 ; DIVIDE BY ZERO ERROR *MOV R1,FLT_ERR *RTWP  FDIZERO B FMULZR ; TO ZERO FAC  FLT_DIV .WORD FPWS,FLT_DIV+4  ; FLOATING DIVISION  ;  ; FAC := ARG / FAC  ;  ; *LI R3,FAC ; POINTER TO FAC *MOV *R3,R8 ; GET DIVISOR FIRST WORD *LI R0,ARG ; POINTER TO ARG *XOR *R0,R8 ; NO, COMPUTE SIGN OF QUOTIENT *MOVB R8,SIGN ; SAVE SAME  PACK01 RTWP ; AND EXIT  OVEXP1 LI R1,12 *MOV R1,FLT_ERR *RTWP  FLT_MUL .WORD FPWS,FLT_MUL+4  LI R3,FAC ; IF FAC IS ZERO *LI R5,ARG ; *MOV *R3,R8 ; IF FAC IS ZERO *JEQ FMULZR ; THEN RESULT IS ZERO *XOR *R5,R8 ; COMPUTE RESULT SIGN *ABS *R5 ; IF ARG IS ZERO *JEQ FMULZR ; THEN ZERO FAC AND RETURN *ABS *R3 ; TAKE ABS VALUE OF*ABS *R3 ; ABS OF DIVISOR *JEQ FDIV01 ; CAN'T BE ZERO *ABS *R0 ; IS DIVIDEND ZERO? *JEQ FDIZERO ; YES, RESULT IS ZERO. *MOVB *R0,R9 ; GET DIVIDEND EXPONENT *SB *R3,R9 ; SUBTRACT EXPONENTS TO GET C; QUOTIENT EXPONENT *SRA R9,8 ; GET DIFFERENCE IN LOW BYTE *AI R9,64 ; ADD BIAS TO EXPONENT *MOV R9,EXPNT ; AND SAVE FOR RESULT C; MOVE FAC TO DIVISOR STORAGE *LI R FAC *CLR R9 ; TO ZERO LOW BYTE OF RESULT EXP *MOVB *R3,R9 ; RESULT EXP = FAC EXP *AB *R5,R9 ; + ARG EXP *SWPB R9 ; *AI R9,-63 ; - BIAS *MOV R9,EXPNT ; *MOVB R8,SIGN ; SAVE TIL NORMAL, ROUND *LI R5,FAC+8 ; LOW ORDER DIGITS  FMCLR CLR *R5+ ; WILL BE *CI R5,FAC+16 ; FORMED *JNE FMCLR ; HERE. 4,4 ; *LI R7,FDVSR ; *LI R5,ARG+8 ;  FDV01 MOV *R3+,*R7+ ; MOVE A WORD OF FAC *CLR *R5+ ; ALSO CLEAR LAST 4 WORDS OF ARG *DEC R4 ; *JGT FDV01 ; LOOP TIL FOUR WORDS MOVED  ; ; *MOVB R4,ARG ; CLEAR EXTRA HIGH BYTE OF C; DIVIDEND (DESTROYS SIGN&EXP IN ARG) C;  ; ;  ; REFERENCE FOR DIVISION ALGORITHM:  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;  ; R0-R1 WORK REGISTERS FOR MPY,DIV  ; R2 CURRENT RESULT DIGIT  ; R3 CURRENT FAC DIGIT  ; R4 REGISTER NUMBER LOOP COUNT  ; R5 FAC LOOP COUNT  ; R6 POINTER TO RESULT IN FAC  ; R7 NUMBER OF SIGNIFICANT BYTES IN  ; ARG FRACTION  ; R8 RB(R0) POINTER  ; R9 RADIX 100 VALU ; DONALD E. KNUTH, THE ART OF COMPUTER PROGRAMMING,  ; VOLUME 2, SEMINUMERICAL ALGORITHMS, ADDISON-WESLEY,  ; 1969, P. 235 FF.  ;  ; THE DIVIDEND IS THE SERIES OF RADIX DIGITS:  ; U0,U1,U2, ... ,U7 (IN ARG)  ; THE DIVISOR IS THE SERIES OF RADIX DIGITS:  ; V1,V2, ... ,V7 (IN FAC+8, OR FDVSR)  ; (U0 IS THE EXTRA HIGH BYTE OF THE DIVIDEND)  ;  ; NORMALIZE DIVISOR AND DIVIDEND SO V1 GT 50.  ; IF V1 E  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; *LI R5,FAC+8 ; BYTES IN FAC+1  FMUL02 DEC R5 ; CHANGE SIGNIFICANT BYTE COUNT  ; ; FOR LAST ZERO BYTE *MOVB *R5,R0 ; IF NEXT FAC BYTE IS ZERO *JEQ FMUL02 ; THEN DECREMENT COUNT FOR IT *LI R7,8 ; COUNT SIGNIFICANT BYTES IN ARG  FMUL03 DEC R7 ; DECREMENT FOR ZERO BYTE LT 50, MULTIPLY DIVISOR AND DIVIDEND BY  ; INT(100/(V1+1))  ;  ; R0-R1 MPY,DIV WORK REGISTERS  ; R2 CARRY  ; R3 MULTIPLIER  ; R4 LOOP COUNT  ; R5 PTR TO RB(R0)  ; R6 PTR TO RB(R1)  ; R7 100  ; *LI R5,FPWS+1 ; GET POINTERS INTO MULTIPLY C; WORK AREA *LI R6,FPWS+3 ;  LW100 .EQU $+2  LB100 .EQU $+3 *LI R7,100 ; RADIX *MOVB ARG(R7),R0 ; IF THIS BYTE OF ARG IS ZERO *JEQ FMUL03 ; THEN DECREMENT COUNT. *CLR R0 ; MPY, DIV WORK REG *MPY R0,R2 ; CURRENT RESULT HIGH BYTE *MOV R5,R6 ; *LI R8,FPWS+1 ; RB(R0) *LI R9,100 ; RADIX  ; ;  FMUL04 MOV R7,R4 ; INNER LOOP CTR = BYTES IN ARG *A R7,R6 ; RESULT PTR TO END OF NEXT PARTIAL C; PRODUCT *MOVB *R5,F*CLR R2 ; CLEAR HIGH BYTE OF WHERE V1 WILL BE *MOVB FDVSR+1,FPWS+5 ; GET V1 IN RB(R2) *CI R2,49 ; IS V1 ALREADY NORMALIZED? *JGT FDIV06 ; YES, PROCEED WITH DIVISION *INC R2 ; NO, COMPUTE V1+1 *CLR R3 ; GET RADIX IN 2 REGS FOR DIV *MOV R7,R4 ; GET RADIX *DIV R2,R3 ; COMPUTE MULTIPLIER = C; INT(100/(V1+1)) C; *LI R9,FDVSR+8 ;  FDVLP LI R4,8 ; GET NUPWS+7 ; RB(R3) IS NEXT DIGIT OF FAC *MOVB R3,*R5 ; CLEAR FAC DIGIT FOR NEXT PARTIAL  FMUL05 MOVB ARG(R4),*R8 ; GET NEXT DIGIT OF ARG *MPY R3,R0 ; AND MPY IT *MOVB *R6,FPWS+5 ; TO CORRESPONDING PARTIAL PRODUCT C; DIGIT IN RB(R2) *A R2,R1 ; ADD IN NEXT PARTIAL PROD DIGIT *DIV R9,R0 ; CONVERT PRODUCT TO RADIX DIGIT C; AND CARRY. *MOVB FPWS+3,*R6 ; STORE NEW RESULT DIGIT IN FAC *LI R1,7 ; ROUND UP, GET NUMBER OF FAC BYTES  ROUNUP LI R2,1*256 ; 1 (FOR BYTE INSTR) *LI R0,100*256 ; 100 (SAME)  ROUN02 AB R2,FAC(R1) ; ADD ONE TO A BYTE OF FAC *CB FAC(R1),R0 ; IF BYTE NOT GREATER THAN RADIX *JL PACKUP ; THEN PUT EXPONENT IN FAC *SB R0,FAC(R1) ; BRING DIGIT BACK IN RANGE *DEC R1 ; IF CARRY PAST HIGH BYTE OF FAC *JGT ROUN02 ; THEN CARRY TO NEXT HIGHER BYT*DEC R6 ; POINT TO NEXT HIGHER BYTE OF RESULT *AB *R8,*R6 ; ADD IN CARRY TO NEXT HIGHER BYTE C; OF RESULT *DEC R4 ; IF ALL ARG DIGITS NOT DONE *JGT FMUL05 ; THEN CONTINUE *DEC R6 ; POINT TO START OF NEXT PARTIAL PROD *DEC R5 ; IF FAC DIGITS REMAIN, *CI R5,FAC ; *JGT FMUL04 ; THEN CONTINUE  FMEND CLR FAC+10 ; CLEAR ERROR INDICATOR  B E *INC EXPNT ; FRACTION HAS OVERFLOWED C; (MEANS NUMBER WAS ALL 9"S) C; SHIFT NUMBER BY ADDING 1 TO EXP *MOVB R2,FAC+1 ; MAKE THE HIGH BYTE A 1  PACKUP MOV EXPNT,R3 ; *CI R3,128 ; *JHE OVEXP1 ; *MOVB FPWS+7,FAC ; PUT EXPONENT IN FAC *MOVB SIGN,R2 ; *INV R2 ; IF SIGN IS NEGATIVE, *JLT PACK01 ; *NEG FAC ; THEN INVERT 1ST WORD      MBER OF BYTES IN DIVIDEND+1  FDIV04 DEC R4 ; IGNORE ZERO BYTES AT END *DEC R9 ; *MOVB *R9,R0 ; IS NEXT HIGHER ORDER BYTE ZERO? *JEQ FDIV04 ; YES, KEEP LOOKING FOR NON-ZERO *CLR R0 ; NO, CLEAR CARRY INTO LOW ORDER BYTE  FDIV05 MOV R0,R2 ; SAVE CARRY FROM LAST BYTE *MOVB *R9,*R5 ; GET NEXT BYTE OF DIVIDEND *MPY R3,R0 ; MULTIPLY THIS BYTE BY MULTIPLIER JEQ FDIV16 ; YES, DO NO SUBTRACTING. C; NO, SUBTRACT Q*V FROM U C;  ; R0-R1 MPY,DIV WORK REGISTERS  ; R2 QUOTIENT DIGIT  ; R3 CARRY  ; R4 LOOP COUNT  ; R5 QUOTIENT BYTE LOOP COUNT  ; R6 NUMBER SIGNIF BYTES IN DIVISOR  ; R7 V1  ; R8 V2  ; R9 100 * V1 + V2  ; R11 POINTER INTO DIVIDEND  ; *CLR R3 ; CLEAR CARRY INTO FIRST BYTE *A R2,R1 ; ADD IN CARRY FROM PREVIOUS BYTE *DIV R7,R0 ; CNVRT TO A RADIX DIGIT AND A CARRY *MOVB *R6,*R9 ; PUT RESULT BYTE IN DIVIDEND *DEC R9 ; *DEC R4 ; LOOP UNTIL ALL DIVIDEND BYTES *JGT FDIV05 ; NO, CONTINUE MULTIPLYING *CI R9,FDVSR ; *JNE FDVLPA ; *LI R9,ARG+8 ; *JMP FDVLP ;  FDVLPA MOVB *R5,ARG ; YES, PUT CARRY OUT OF HIGH ORDER *MOV R6,R4 ; GET DIVISOR LOOP COUNT *A R6,R11 ; TO LOW ORDER BYTE OF DIVIDEND C; OF INTEREST  FDIV12 MOV R0,R3 ; SAVE CARRY FROM PREV BYTE *MOVB FDVSR(R4),FPWS+1 ; GET NEXT BYTE OF DIVISOR *MPY R2,R0 ; MPY BYTE OF DIVISOR BY QUOTIENT *A R3,R1 ; ADD IN CARRY FROM LAST DIVISOR BYTE *DIV LW100,R0 ; CONVERT RESULT TO A RADIX 100 DIGIT C; AND CARRY. *SB FPWS+3,*R11 ; SUBTRACT PRODUCT BYTE FROM DIC; IN HIGHEST BYTE. C;  ; DIVIDE LOOP ;  ; ;  ; U(J) IS THE HIGHEST ORDER BYTE OF WHAT IS LEFT OF  ; THE DIVIDEND. EACH QUOTIENT DIGIT IS ESTIMATED AS  ; FOLLOWS:  ; IF U(J) = V1 THEN Q := 99  ; ELSE Q := INT((100*U(J)+U(J+1))/V1)  ; IF V2*Q GT (100*U(J)+U(J+1)-Q*V1)*100+U(J+2)  ; THEN Q := Q - 1 AND THE TEST IS REPEATED. VIDEND *JGT FDIV13 ; IS RESULT POSITIVE? *JEQ FDIV13 ; OR ZERO? *AB LB100,*R11 ; NO, ADD RADIX BACK *INC R0 ; INCREMENT PRODUCT CARRY TO BORROW C; FROM NEXT BYTE  FDIV13 DEC R11 ; POINT TO NEXT HIGHER BYTE OF DVDND *DEC R4 ; SUBTRACTED ALL BYTES OF DIVISOR? *JGT FDIV12 ; NO, CONTINUE SUBTRACTING. *SB FPWS+1,*R11 ; YES, SUB CARRY FROM DIVISOR PRODUCT  ; THIS WILL ENSURE THAT Q-1 LE NEXT-QUOTIENT-DIGIT  ; LE Q.  ; NOTE THAT 100*U(J)+U(J+1)-Q*V1 =  ; REMAINDER((100*U(J)+U(J+1))/V1)  ; Q*V IS THEN SUBTRACTED FROM U.  ; IF THE RESULT IS NEGATIVE, V IS ADDED BACK IN AND  ; Q := Q-1 (THE PROBABILITY OF ADDING BACK IS APPROX  ; .03)  ;  ; R0-R1 TEMPORARY  ; R2 NEXT QUOTIENT DIGIT  ; R3-R4 TEMPORARY  ; R5 QUOTIENT BYTE LOOP COUNT  ; R*JGT FDIV16 ; HIGH ORDER FROM HIGHEST ORDER *JEQ FDIV16 ; DIVIDEND BYTE. NEGATIVE RESULT? C; YES, ADD DIVIDEND BACK IN, Q WAS C; ONE TOO BIG. C; *DEC R2 ; DEC Q, WAS ONE TOO BIG. *MOV R6,R4 ; GET ADD-BACK LOOP COUNT *A R6,R11 ; POINT TO LOW ORDER BYTE OF DIVIDEND C; OF INTEREST  FDIV14 AB FDVSR(R4),*R11 ; ADD BYTE OF DIVISOR TO DIVIDEND *CB *R11,LB100 ; RESULT LARGER THAN RADIX? *JL FDIV15 6 NUMBER OF SIGNIFICANT BYTES IN DIVISOR  ; R7 V1  ; R8 V2  ; R9 100*V1+V2  ; R11 POINTER INTO DIVIDEND (USUALLY POINTS  ; TO U(J))  ;  FDIV06 LI R6,8 ; NUMBER DIVISOR BYTES + 1  FDIV07 DEC R6 ; COMPUTE NUMBER OF SIG BYTES C; IN DIVISOR *MOVB FDVSR(R6),R0 ; GET NEXT HIGHER ORDER BYTE C; OF DIVISOR *JEQ FDIV07 ; IGNORE IT IF IT IS ZERO  ; NO, RESULT IS CORRECT *SB LB100,*R11 ; YES, SUBTRACT RADIX *AB LB1,-1(R11) ; ADD 1 FOR CARRY TO HIGHER BYTE  FDIV15 DEC R11 ; TO NEXT HIGHER BYTE OF DIVIDEND *DEC R4 ; DONE ADDING IN ALL BYTES OF DIVIDND *JGT FDIV14 ; NO, ADD IN THE NEXT ONE  FDIV16 MOVB FPWS+5,FAC+10(R5) ; PUT AWAY NEXT QUOTIENT BYTE *INC R11 ; HIGH ORDER OF NEXT SIGNIF DVDND *CLR R7 ; CLR HIGH BYTE OF WHERE V1 WILL BE *MOVB FDVSR+1,FPWS+15 ; RB(R7) IS V1 *MOV R7,R8 ; COPY V1 TO COMPUTE 100*V1 *MPY LW100,R8 ; COMPUTE 100*V1 *MOVB FDVSR+2,FPWS+17; GET V2 (HIGH BYTE IS ZERO) *A R8,R9 ; COMPUTE 100*V1+V2 *LI R5,-9 ; COMPUTE 9 BYTES OF QUOTIENT *LI R11,ARG ; PTR TO HIGH BYTE OF DIVIDEND C;  FDIV08 CLR R2 ; CLEAR HIGH BYTE OF WHERE U(J) WILL C; BE *MO*INC R5 ; COMPUTED ALL NECESSARY BYTES OF QUO *JLT FDIV08 ; NO, CONTINUE *B FMEND ; YES, NORMALIZE AND FINISH UP.  FLT_RND .WORD FPWS,FLT_RND+4  ;  ; FLOATING TO INTEGER CONVERSION  ; *MOV FAC,R4 ; IS FAC = 0 ? *JEQ $11 ; YES, FINISHED *CLR R0 ; IN CASE FAC ROUNDS TO ZERO *LI R2,FAC+1 ; POINTER TO FIRST RADIX100 DIGITS *CLR R3 ; USED AS ACCUMULATOR *ABS FAVB *R11,FPWS+5 ; RB(R2) IS U(J) *MPY LW100,R2 ; COMPUTE 100*U(J) *CLR R0 ; WHERE U(J+1) WILL BE *MOVB 1(R11),FPWS+1 ; GET U(J+1) *A R0,R3 ; 100*U(J)+U(J+1) *DIV R7,R2 ; GET Q AND REMAINDER *MPY LW100,R3 ; 100*REMAINDER *MOVB 2(R11),FPWS+1 ; U(J+2) *A R0,R4 ; 100*REM + U(J+2) *MOV R2,R0 ; GET Q FOR THE TEST *MPY R8,R0 ; COMPUTE V2*Q C ; MAKE SURE FIRST DIGITS POSITIVE *CLR R5 ; CLEAR LOW BYTE OF EXPNT COPY *MOVB FAC,R5 ; GET EXPNT ISOLATED *CI R5,3F00H ; IS NUMBER < 1 *JLT $10 ; YES, < .01, RESULT = 0 *JEQ $3 ; .01 < NUMBER < 1, RESULT = 1 *CI R5,4100H ; IS NUMBER < 100000 ? *JLT $2 ; BETWEEN 1 AND 100 *JEQ $1 ; BETWEEN 100 AND 10000 *CI R5,4200H ; IS IT TOO BIG TO CONVERT ? *C R2,LW100 ; DOES Q = 100? C; I.E., V1 = U(J)? *JEQ FDIV09 ; YES, MAKE Q = 99 *S R4,R1 ; NO, COMPUTE V2*Q-(100*REM+U(J+2)) *JMP FDIV11 ; GO CHECK IF IT IS IN RANGE  FDIV09 S R4,R1 ; COMPUTE V2*Q-(100*REM+U(J+2))  FDIV10 DEC R2 ; DECREMENT Q *S R9,R1 ; COMPUTE ABOVE FOR NEW Q  FDIV11 JGT FDIV10 ; IF Q TOO BIG MAKE IT SMALLER *MOV R2,R2 ; IS Q ZERO? *      *  ; TEXAS INSTRUMENTS *  ; *  ; *  ; FOR UCSD PASCAL VERSION I.5 6-SEP-1978 *  ; II.1 21-AUG-1979 *  ; III.0 24-FEB-1980 *  ; IV.0 3-SEP-1980 *  $4 MOVB *R2+,R3 ; GET NEXT RADIX DIGIT (AFTER POINT) *JNE $5 ; NON-ZERO, ROUND UP *CI R2,FAC+8 ; LOOK AT REST OF DIGITS *JL $4 ; NO, LOOK AT NEXT ONE *JMP $6 ; ROUND DOWN  $5 INC R0 ; ROUND UP  $6 CI R0,8000H ; IS RESULT 32768 (-0) ? *JL $8 ; NO, PUT ON PROPER SIGN *JH $7 ; NO, BUT OVERFLOW ERROR *MOV R4,R4 ; IS IT ;****************************************************************  (  NO .EQU 0  YES .EQU ~NO   IV_0 .EQU YES ; TRUE FOR IV.0 BIOS, FALSE FOR II.1 BIOS  MAPPING .EQU YES ; MUST BE TRUE FOR 990/10 WITH MAPPING >; SHOULD BE FALSE IF MAPPING IS NOT REQUIRED >; ELSE BIOS WILL RUN SLOWER  SLAVE .EQU NO ; FOR DEBUGGING ON 990/5 SLAVE  XMEM .EQU YES ; FOR EXTENDED MEMORY CODE POOL (TILINE BANK 2)  XADRS  NEGATIVE ? *JLT $9 ; YES, FIX INTEGER SIGN  $7 B OVEXP1 ; ERROR EXIT  .EQU XMEM   HAWKDISK .EQU NO  SKEWED .EQU NO ; FOR TERAK SKEW (ONLY IF ~FD800) *.IF SKEWED  SK1 .EQU 4  SK2 .EQU 5 ; RSP DRIVE #'S FOR TERAK SKEW *.ENDC   S9902 .EQU NO ; FOR SERIAL I/O WITH 990/5 9902 PORTS  PARPTR .EQU NO ; FOR PARALLEL NEC/DIABLO >; AS ALTERNATE PRINTER  PRINTKEY .EQU YES ; FOR TOP-OF-FORM AND PRINT-SCREEN   $8 INV R4 ; IS NUMBER NEGATIVE ? *JLT $10 ; NO, RETURN POSITIVE  $9 NEG R0 ; RETURN NEGATIVE  $10 MOV R0,FAC ; PUT NUMBER INTO FAC  $11 RTWP  CTRL  EXRL .WORD BACK   LDRL .WORD $0 ; TOS HAS ADDRESS OF REAL; PUSH IT  $0 MOV *SP,R1 ; POP THE ADDRESS INTO R1, LEAVE SP *MOV 6(R1),*SP *DECT SP *MOV 4(R1),*SP *DECT SP *MOV 2(R1),*SP *DE DEBUG .EQU NO ; APPLIES ONLY TO 990'S WITH FRONT PANEL  FD800 .EQU YES ; FOR FD800 CRU-STYLE DISK CONTROLLER  USERU .EQU NO ; CHANGE USERU SWITCH HERE IF PARPTR FALSE *.IF ~FD800  TLDT00 .EQU 00H ; A TABLE IS BUILT IN BIOSDSEG  TLDT10 .EQU 00H ; USING THESE TLDTNN EQUATES. IT IS  TLDT20 .EQU 01H ; AN ARRAY OF BYTES WITH 6 ROWS AND 2 COLUMNS.  TLDT30 .EQU 01H ; THIS TABLE IS USED TO MAP PASCCT SP *MOV *R1,*SP  B *BK   STRL .WORD $0  $0 MOV 8(SP),R1 ; TOS IS REAL, TOS-1 IS ADDRESS *LI R2,4  $1 MOV *SP+,*R1+ *DEC R2 *JNE $1 *INCT SP *B *BK  LDCRL .WORD $0  $0 MOV IPC,IPCFLT *DEC IPCFLT *LI R2,$1 *B GET_BIG  $1 CLR R5 *LI R1,4 *MOV R3,R4 *MOV R1,R3 *B RLCONST  .END  AL UNIT NUMBERS  TLDT40 .EQU 01H ; TO TILINE CONTROLLER CARDS IN THE FOLLOWING  TLDT50 .EQU 01H ; WAY:  TLDT01 .EQU 00H ; PASCAL RSP PHYSICAL TILINE  TLDT11 .EQU 10H ; UNIT # # DRIVE # ADDRESS (-F800)  TLDT21 .EQU 00H ; 4 0 TLDT00 TLDT01  TLDT31 .EQU 00H ; 5 1 TLDT10 TLDT11  TLDT41 .EQU 00H ; 9 2 TLDT20 TLDT21 O^£±„s TLDT51 .EQU 00H ; 10 3 TLDT30 TLDT31 >; 11 4 TLDT40 TLDT41 >; 12 5 TLDT40 TLDT51   DTO0 .EQU 0 ; USED TO INITIALIZE THE DEFAULT TRACK OFFSET  DTO1 .EQU 0 ; TABLE. IF NEGATIVE, THE DISK WILL BE CONSIDERED  DTO2 .EQU 0 ; LOGICALLY OFF-LINE UNTIL "MOUNTED" BY USE OF  DTO3 .EQU 101 ; XOP 9. IF NOT ZERO, THE LOGICAL DISK STARTS  DTO4 .EQU 202 ; ON THAT TRACr*JH $7 ; TOO BIG, ERROR *MOVB *R2+,FPWS+1 ; MOVE TO LSB OF R0 *MPY ONE_HUND,R0 ; MULTIPLY BY RADIX TO GET INTEGER *MOV R1,R0 ; AND LEFT JUSTIFY DOUBLE WORD RESULT  $1 MOVB *R2+,FPWS+7 ; GET NEXT RADIX 100 DIGITS  A R3,R0 ; ADD TO PREVIOUS *MPY ONE_HUND,R0 ; MULTIPLY BY RADIX *MOV R0,R0 ; TEST FOR OVERFLOW *JNE $7 ; YES, ERROR *MOV R1,R0 ; NO, GET RES*.PROC BIOS990 *.TITLE "BASIC INPUT/OUTPUT SUB-SYSTEM (BIOS)"  ; *.NOASCIILIST *.NOPATCHLIST  .MACROLIST  (  ;  ;****************************************************************  ; *  ; BASIC INPUT/OUTPUT SUB-SYSTEM FOR THE UCSD PASCAL SYSTEM *  ; *  ; WRITTEN BY FRITZ WHITTINGTON *  ; ULT FOR LAST DIGITS *JLT $7 ; OVERFLOW IF HIGH BIT SET  $2 MOVB *R2+,FPWS+7 ; GET LAST RADIX 100 DIGITS *A R3,R0 ; ADD TO PREVIOUS  $3 CB *R2+,LW50H ; IS ROUNDING NECESSARY ?  JLT $6 ; NO, PUT ON PROPER SIGN *JGT $5 ; YES, ADD A 1 TO IT *MOV R4,R4 ; ONE OTHER CHECK *JGT $5 ; NUMBER IS POSITIVE, ROUND UP      K. APPLIED ONLY TO DSDD AND  DTO5 .EQU 303 ; HAWK DISKS. *.ENDC * *.IF XADRS *.DEF XMAP *.ENDC * *.DEF KEYBWS,BIOSWS,DISPWS,SELIWS,CLCKWS,INTPWS,TRAPWS *.DEF KEYBEP,BIOSEP,DISPEP,SELIEP,CLCKEP,DBUG,CUTBACK *.DEF BBBREAK,KEYQUE *.REF MEMTOPB,SEG_WORD,OPTABLE,EVEC *.REF CCLR,PCLR,RCLR,DCLR *.REF CSOUT,CLROP,OUTOP,CHAROUT *.REF XEQERR *.REF TEMP,START,DIRSZ,SYSREAD,SYSUNT,SEGDSZ *.REF SYSBLK,SEG,SYSCMB,SAVRTN *.REF TRAPSNAP,CPOFST,CPOOL *.REF SEXOK,NEGONE,SIB,EREC,ONE,ROOTTASK *.REF CHKSEX,NIL,SEGHI,TRUE,ZERO,GBLVEC *.REF CHRMASK *  ;  ; *.TITLE "EQUATES AND MACROS" *.PAGE *.IF IV_0 *.INCLUDE G4.EQUS.TEXT *.ENDC *.INCLUDE BX.EQUS.TEXT *.TITLE "RAM DATA SEGMENTS" *.PAGE *.INCLUDE BX.DSEG.TEXT *.TITLE "BIOS MAIN ENTRY" *.PAGE *.INCLUDE BX.ENTRY.TEXT *.TITLE "SERIAL I/O CODE" *.PAGE *.INCLUDE BX.SIO.TEXT *.TITLE "DISK SERVICE CODE" *.PAGE * *.IF FDO^„²„r800 /.INCLUDE BX.FD800.TEXT *.ELSE /.INCLUDE BX.TLDC0.TEXT /.INCLUDE BX.TLDC1.TEXT /.INCLUDE BX.TLDC2.TEXT *.ENDC *.TITLE "SERIAL DEVICE I/O CODE" *.PAGE *.INCLUDE B4.SERIAL.TEXT * *.IF USERU  /.TITLE "USER UNITS CODE" * .PAGE /.INCLUDE BX.USER1.TEXT /.INCLUDE BX.USER2.TEXT  *.ELSE  UREAD  UWRITE  UCTRL  USTAT *LI R1,9 *MOV R1,RETCD(R10) *RTWP  *.ENDC  .TITLE "SYSTEM INTERFACE" *.PAGE *.INCLUDE B4.SYS.TEXT  €’*.TITLE "DISPLAY XOP CODE" *.PAGE *.INCLUDE BX.DISP.TEXT *.TITLE "INTERRUPT HANDLERS" *.PAGE *.INCLUDE BX.INTS.TEXT *.TITLE "CONCURRENCY SUPPORT" *.PAGE *.INCLUDE B4.CONCUR.TEXT *.TITLE "INITIALIZATION CODE" *.PAGE  *.ALIGN 2 ; GUARANTEE NEW HEAP TOP ON WORD BOUNDARY * *.TITLE "IO INITIALIZATION" *.PAGE *.INCLUDE B4.CUTBACK.TEXT * *.TITLE " " *.ALIGN 2 ; GUARANTEE HEAP TOP ON WORD BOUNDARY *.END   ;  ; Procedures for support of hardware events.  ;  ;  QUIET ANDI R15,0FFF0H ; lock out interrupts in P; what will be the interpreter P; environment 0RTWP ; return to interpreter  ;  ;  ENABLE ORI R15,000FH ; enable interrupts 0RTWP  ;  ;  ; procedure cause ( event : integer ) ;  ;  ; Given an event # passed in R9, calls the interpreter procedure  ; EVENT to signal the event.  ;  CAUSEWS .BLOCK 32 ; new workspace  CAUSE .WORD CAUSEWS,$1 ; for blwp ($1 LIMI 0 ; lock out interrupts 0MOV EVENT,R2 ; get Event procedure addr 0JEQ $2 ; if 0 then exit 0BL *R2 ; off to Event procedure ($2 RTWP ; back to caller  O^¤c¤cO^¤c¤c€ƒ‡€r .PROC BOOTMES (.NOASCIILIST (.NOPATCHLIST  ; DUMMY FILE FOR TI BOOT MESSAGE (.DEF BOOTMSG  BOOTMSG B *R11 ; RETURN (.END       R,CLROP ; CLEAR-DATA-BLOCK:=CONSOLE CLEAR OFFSET (4) +BIOS CLROP ; CLEAR CONSOLE +.IF SLAVE +LI R12,17E0H +SBZ 1 +SBZ 2 +SBO 3 +.ENDC +.IF XMEM +LI R12,1FA0H +SBO 3 +CLR R1 +LI R2,32767  $1 SBO 3 +LDD EXTRA +MOV R2,*R1+ +DEC R2 +JNE $1 +LDD EXTRA +MOV R2,0FFFEH +RSET +LI R12,1FA0H +SBO 3 +JMP O99  EXTRA .WORD 0BFFFH,1000H *.WORD 07FFFH,1000H (JNE $2  $1 XOP R0,15 ; OFF TO TI-BUG  $2 MOV R3,R1 ; RESTORE R1 (MOV @OPTABLE(R1),R2 ; OPTABLE INDEX (B *R11 ; RESET IPC AND RETURN (.ELSE  DBUG MOV OPTABLE(R1),R2 (B *R11 ; JUST RETURN (.ENDC  CUTBACK .ALIGN 2  ;  ; I/O INITIALIZATIONS  ; *LIMI 0 ; DISABLE INTERRUPTS  ; *LI R1,DISPWS ; SET UP XOP VECTORS FOR *LI R2,DISPEP ; XOP 4 (CONSOLE DISPLAY) *L*.WORD 0,1000H  O99 NOP +.ENDC *.IF ~DEBUG *CKON ; AVOID TURNING ON CLOCK TO USE FRONT PANEL *.ENDC +LIMI 15 ; ENABLE INTERRUPTS +LI R1,0C00H ; CLEAR SCREEN BY OUTPUTTING 0CH TO CONSOLE +MOV R1,CHAROUT +MOV CSOUT,OUTOP +BIOS OUTOP +MOV PCLR,CLROP ; CLEAR-DATA-BLOCK:=PRINTER CLEAR OFFSET (8) +BIOS CLROP ; CLEAR PRINTER +MOV DCLR,CLROP ; CLEAR-DATA-BLOCK:=DISK CLEAR OFFSET (14) +BIOS I R3,80 *MOV R1,*R3+ *MOV R2,*R3  ; *LI R1,BIOSWS ; XOP 5 (BIOS CALL) *LI R2,BIOSEP *LI R3,84 *MOV R1,*R3+ *MOV R2,*R3  ; *.IF ~FD800 *LI R1,TILNWS ; XOP 7 (TILINE CONTROL) *LI R2,TILNEP *.ELSE *LI R1,CHEKWS ; OR CHECK IF FD800 DISK *LI R2,CHEKEP *.ENDC *LI R3,92 *MOV R1,*R3+ *MOV R2,*R3  ; *.IF ~IV_0 *LI R1,TRAPWS ; XOP 8 (TRAP CALL)  CLROP ; CLEAR DISK +MOV RCLR,CLROP ; CLEAR-DATA-BLOCK:=REMOTE CLEAR OFFSET (20) +BIOS CLROP ; CLEAR REMOTE  .IF DEBUG *XOP R0,15 *NOP *.ENDC  B *R11 ; BACK TO TBOOT  ; *LI R2,TRAPER *LI R3,96 *MOV R1,*R3+ *MOV R2,*R3  .ENDC  ; *.IF DEBUG *LI R1,CHEKWS ; XOP 15 (DBUG CALL) *LI R2,CHEKEP *LI R3,124 *MOV R1,*R3+ *MOV R2,*R3  .ENDC  ; *.IF ~FD800 *LI R1,TILNWS ; AND XOP 9 (DISK MANAGER) *LI R2,DMANEP *.ELSE *LI R1,CHEKWS *LI R2,CHEKEP *.ENDC *LI R3,100 *MOV R1,*R3+ *MOV R2,*R3  ; *LI R1,CHEKWS O^¤Ć¤ć ; THE ORDER OF THE LOADING FROM 0 THRU *LI R2,CHEKEP ; LEVEL 15 IS SEQUENTIAL THRU R3 ! *CLR R3 ; LOAD VECTORS FOR INT 0,1,2 *MOV R1,*R3+ *MOV R2,*R3+ *MOV R1,*R3+ *MOV R2,*R3+ *MOV R1,*R3+ *MOV R2,*R3+  ; *LI R1,KEYBWS *LI R2,KEYBEP *MOV R1,*R3+ *MOV R2,*R3+  ; *LI R1,SELIWS ; FOR LEVEL 4 INTERRUPT *LI R2,SELIEP *MOV R1,*R3+ *MOV R2,*R3+  ; €‚Q*LI R1,CLCKWS ; FOR LEVEL 5 INTERRUPT *LI R2,CLCKEP *MOV R1,*R3+ *MOV R2,*R3+  ; *LI R1,KEYBWS ; FOR LEVEL 6 INTERRUPT *LI R2,KEYBEP *MOV R1,*R3+ *MOV R2,*R3+  ; *LI R1,SELIWS ; FOR LEVEL 7 INTERRUPT *LI R2,SELIEP *MOV R1,*R3+ *MOV R2,*R3+  ; *LI R1,SELIWS ; FOR LEVEL 8 INTERRUPT *LI R2,SELIEP *MOV R1,*R3+ *MOV R2,*R3+  ; *LI R1,CHEKWS ; FOR LEVEL 9 INT ; **********************************************************************  ; Serial Device Module ;  ; ==================== ;  ; This module provides dummy routines for SERIALREAD, SERIALWRITE, ;  ; SERIALCONTROL and SERIALSTATUS. These routines support 3 'serial' ;  ; devices, which are actually memory buffers. ;  ;***********************************************************ERRUPT *LI R2,CHEKEP *MOV R1,*R3+ *MOV R2,*R3+  ; *LI R1,CHEKWS ; FOR LEVEL 10 INTERRUPT *LI R2,CHEKEP *MOV R1,*R3+ *MOV R2,*R3+  ; *LI R1,KEYBWS ; FOR LEVEL 11 INTERRUPT *LI R2,KEYBEP *MOV R1,*R3+ *MOV R2,*R3+  ; *LI R1,CHEKWS ; FOR LEVEL 12 INTERRUPT *LI R2,CHEKEP *MOV R1,*R3+ *MOV R2,*R3+  ; *LI R1,CHEKWS ; FOR LEVEL 13 INTERRUPT *LI R2,CHEKEP ;*********** INITIALIZATIONS **********  ;  ; FOR IV.0  ; *.IF DEBUG ; DEBUG  OPTRAP .WORD -1 ; -1 FORCES A HALT (ON FIRST P-CODE)  SEGTRAP .WORD 0 ; SEGMENT TO HALT ON  PROCTRAP .WORD 0 ; PROCEDURE TO HALT ON  OFFSETTR .WORD 0 ; OFFSET TO HALT ON   DBUG MOV R1,R3 ; SAVE R1 IN R3 (MOV @OPTRAP,R2 (CI R2,-1 ; CHECK FOR -1 FLAG (JEQ $1 (SRL *MOV R1,*R3+ *MOV R2,*R3+  ; *LI R1,KEYBWS ; FOR LEVEL 14 INTERRUPT *LI R2,KEYBEP *MOV R1,*R3+ *MOV R2,*R3+  ; *LI R1,CLCKWS ; ALSO SET CLOCK AT LEVEL 15 *LI R2,CLCKEP ; FOR SOME 990/10 CONFIGURATIONS *MOV R1,*R3+ *MOV R2,*R3  ; *CLR CLOCKLO *CLR CLOCKHI  ;  ; CLEAR ALL UNITS +MOV PCLR,CLROP ; CLEAR-DATA-BLOCK:=PRINTER CLEAR OFFSET (8) +BIOS CLROP ; CLEAR PRINTER +MOV CCL R1,1 (C R2,R1 ; CHECK IF PCODE TO TRAP ON (JEQ $1 (MOV @SEGTRAP,R2 (SLA R2,1 (A @EVEC,R2 (C *R2,@EREC ; CHECK IF SEGMENT TO TRAP ON (JNE $2 (MOV @PROCTRAP,R1 (SLA R1,1 (NEG R1 (A @SEGHI,R1 ; INDEX INTO PROCEDURE DICT (MOV R11,R0 (BL @SEG_WORD (MOV R0,R11 (SLA R2,1 (A @SEG,R2 (A @OFFSETTR,R2 (AI R2,3 ; THINK ABOUT IT... (C R2,IPC ; CHECK IF CORRECT IPC      ***********;  ;  ; Serial Control Table  ;  SERTAB .WORD SER0 ; address of table  SER0 .WORD 2 ; write buffer count (.WORD 0 ; read buffer count (.WORD SERB0 ; address of read buffer (.WORD 2 (.WORD 0 (.WORD SERB1 (.WORD 2 (.WORD 0 (.WORD SERB2  ;  ; Serial Table Constants  ;  STABSZ .EQU 6 ; size of table entry (bytes)  SERWCNT .EQU 0 ; write buffer count  ; procedure serst ( device : integer ; control : integer ; pointer : addr ) ;  ;  SERST SERENTRY (MOV @PARM5(R10),R1 ; get control word (MOV @PARM1(R10),R2 ; get pointer (ANDI R1,1 ; mask all but lsb (JEQ $2 ; if r1 = 0 then (MOV @SERRCNT(R3),*R2 ; return input count (JMP $3 ; else "$2 MOV @SERWCNT(R3),*R2 ; return output count  SERRCNT .EQU 2 ; read buffer count  SERBUFF .EQU 4 ; buffer address  ;  ;  ; Serial Buffers - allows contain 2 characters defining the device  ; for testing purposes  ;  SERB0 .ASCII "0:" (.BLOCK 126  SERB1 .ASCII "1:" (.BLOCK 126  SERB2 .ASCII "2:" (.BLOCK 126  ;  ; Serial entry point macro - determines which 'device' is being accessed  ; (.MACRO SERENTRY (MOV PARM4(R10),R1 ; pick up device number (LI R2,"$3 ; endif (CLR @RETCD(R10) ; AOK (RTWP  STABSZ ; get serial table size (MPY R1,R2 ; r3 := index into serial table (A SERTAB,R3 ; r3 := pointer to table entry (CI R1,3 ; if device >= 3 then (JLT $1 (LI R2,9 ; r9 := volume not on line (MOV R2,RETCD(R10) ; set return code (RTWP ; exit "$1 ; endif (.ENDM  ;  ; procedure serrd ( device : integer ; ch : char ; return_code : integer ) ;  ;  ; device - parm4 , ch - parm1 , return_code - retcd.  ;  SERRD SERENTRY (MOV @SERRCNT(R3),R2 ; get read count (CI R2,128 ; if bufout count >= 128 then (JLT $2 (LI R2,3 ; r2 := illegal i/o request (MOV R2,RETCD(R10) ; set return code (RTWP ; exit "$2 ; endif (MOV @SERBUFO^„r„rF(R3),R2 ; get buffer address (A @SERRCNT(R3),R2 ; add in current position (CLR @PARM1(R10) ; clear out character word (MOVB *R2,@PARM1(R10) ; stuff character (CLR R2 (MOVB @PARM1(R10),R2 ; get character in r2 (CI R2,0D00H ; if character = CR then (JNE $3 ; (*reset read count*) (LI R2,2 ; r2 := start read count €# (MOV R2,@SERWCNT(R3) ; reset write count to 2 (MOV ZERO,@SERRCNT(R3) ; reset read count to 0 (JMP $4 ; else "$3 INC @SERRCNT(R3) ; increment read count "$4 ; endif (CLR @RETCD(R10) ; return code = AOK (RTWP  ;  ; procedure serwt (device : integer ; ch : character ; return_code : integer);  ;  ; device - parm4. ch - parm1. return_code - retcd  ;  SERWT SERENTRY (MOV @SERW ;***********************************************************************;  ; System Communication Module ;  ; =========================== ;  ; This module contains the procedures Sysread, Syswrite, Syscontrol and ;  ; Sysstat. Sysread and Syswrite simply return control to the ;  ; Interpreter. Syscontrol is called by the Interpreter after ;  ; Initialization and is passed the address of the EvenCNT(R3),R2 ; get buffer count in r2 (CI R2,127 ; if buffer count < 127 then (JGT $2 ; (*put in character*) (MOV @SERBUFF(R3),R2 ; get buffer address (A @SERWCNT(R3),R2 ; make pointer to byte (MOVB @PARM1(R10),*R2 ; stuff character (INC @SERWCNT(R3) ; increment count (CLR @RETCD(R10) ; return_code := AOK (RTWP ; exit t procedure. ;  ; Sysstat is called by the CSP TIME to get the current value of the real;  ; time clock. ;  ;***********************************************************************;  ;  SREAD  SWRITE CLR RETCD(R10) ; clear return code (RTWP ; back to interpreter  ;  SCTRL MOV PARM3(R10),EVENT ; pick up address of EVENT (CLR RETCD(R10) ; clear return code "$2 ; endif (LI R2,15 ; r2 := buffer overflow (MOV R2,@RETCD(R10) ; set return code to r2 (RTWP  ;  ; procedure serct ( device : integer ) ;  ;  SERCT SERENTRY (CLR @SERRCNT(R3) ; set read count to zero (LI R2,2 ; r2 := start write count (MOV R2,@SERWCNT(R3) ; set write count (CLR @RETCD(R10) ; return code = AOK (RTWP ; exit  ;      T ENTRY IN DICTIONARY +INCT R5 +INCT R4 ; OFFSET TO NEXT ENTRY IN VECTOR +DEC R1 ; HAVE ALL SEGMENTS BEEN PROCESSED? +JGT $2 ; MORE TO DO  ;  ; FIX UP SIB OF SEGMENT 1 SO IT LOOKS LIKE IT HAS BEEN PUT ON STACK.  ; READ SEGMENT 1 ONTO THE STACK +LI R1,GBLVEC ; GET GBLVEC +MOV 2(R1),R1 ; GET EREC FOR 1 +MOV ENVSIB(R1),R1 ; GET SIB FOR 1 +MOV SEGLEN(R1),R2 ; GET SEGMENT LENGTH M1 M2 ĶO^£±¤³ +SLA R2,1 ; DOUBLE TO GIVE # OF BYTES TO READ IN +S R2,SP ; PUT STACK BELOW SEGMENT 1 +MOV SP,SEGBASE(R1) ; SET SEGBASE TO TOP OF STACK +INC SEGXXX(R1) ; SET REFERENCE COUNT TO 1 +MOV NEGONE,SEGRES(R1) ; SET RESIDENCY TO POSITION LOCKED +; +MOV SP,R3 ; SAVE LOCATION TO READ SEGMENT 1 +PUSHWORD SYSUNT ; SYSTEM DISK UNIT NUMBER +PUSHWORD R3 ; DISK READ DESTINATION BASE +PUSHWORD ZERO ; OFFSET OF DESTINATION€c( +PUSHWORD R2 ; # BYTES TO READ IN +PUSHWORD SEGADDR(R1) ; BLOCK NUMBER TO BEGIN READING +PUSHWORD ZERO ; DUMMY CONTROL WORD +BL SYSREAD ; SYSREAD(DISK0,SP^,SEG3SZ,SEG3ADDR)  ;  ; BUILD MSCW FOR SEGMENT 16, PROCEDURE 1 ON THE STACK AND SET MP. +AI SP,-MSCWSZ ; OPEN UP ROOM ON STACK FOR MSCW +MOV SP,MP ; INITIALIZE MP AT THIS MSCW +MOV MP,MSSTAT(SP) +MOV MP,MSDYN(SP) +CLR MSIPC(SP) +CLR MSENV(SP)  INIT *MOV R11,SAVRTN ; SAVE RETURN ADDRESS  ; CALL CUTBACK TO DO I/O INITIALIZATIONS *BL CUTBACK ; DO I/O INITIALIZATIONS *BL BOOTMSG ; PUT UP BOOT MESSAGE  ;  ; SET UP STACK +MOV MEMTOPB,SP ; SP:=MEMTOP  ;  ; READ SYSTEM.PASCAL BLOCK 0 (SEGMENT DICTIONARY) INTO MEMORY AT  ; SEGDICT IMMEDIATELY AFTER INIT CODE. IT WILL BE CUTBACK WITH INIT.  ; FLIP IT IF NECCESARY. +PUSHWORD SYSUNT ; SYSTEM DISK UNIT NUMBER +PUSHWORD SEGDICT ; DI+CLR MSPROC(SP)  ;  ; FIX UP SIB OF SEGMENT 16 SO IT CAN BE CALLED TO FINISH INITIALIZATION.  ; READ SEGMENT 16 ONTO THE STACK +LI R1,GBLVEC ; GET GBLVEC +MOV 32(R1),R1 ; GET EREC FOR 16 +MOV R1,EREC ; INITIALIZE EREC REGISTER +MOV ENVSIB(R1),R1 ; GET SIB FOR 16 +MOV SEGLEN(R1),R2 ; GET SEGMENT LENGTH +SLA R2,1 ; DOUBLE TO GIVE # OF BYTES TO READ IN +S R2,SP ; PUT STACK BELOW SEGMENT 16 +MOV R1,SIB ; SK READ DESTINATION BASE +PUSHWORD ZERO ; OFFSET OF DESTINATION +PUSHWORD SEGDSZ ; # BYTES TO READ IN +PUSHWORD SYSBLK ; BLOCK NUMBER TO BEGIN READING +PUSHWORD ZERO ; DUMMY CONTROL WORD +BL SYSREAD ; SYSREAD(DISK0,SEGDICT^,SEGDSZ,BLOCKNUM) +MOV SEGDICT,R1 ; SEE IF SEGMENT NEEDS TO BE FLIPPED +C 511(R1),ONE +JEQ $12 +MOV SEGDSZ,R2 ; YES - FLIP A WORD AT A TIME  $13 SWPB *R1+ +DECT R2 +JGT $13 INITIALIZE SIB REGISTER +MOV SP,SEGBASE(R1) ; SET SEGBASE TO TOP OF STACK +MOV SP,SEG ; INITIALIZE SEG REGISTER +; +MOV SP,R3 ; SAVE LOCATION TO READ SEGMENT 16 +PUSHWORD SYSUNT ; SYSTEM DISK UNIT NUMBER +PUSHWORD R3 ; DISK READ DESTINATION BASE +PUSHWORD ZERO ; OFFSET OF DESTINATION +PUSHWORD R2 ; # BYTES TO READ IN +PUSHWORD SEGADDR(R1) ; BLOCK NUMBER TO BEGIN READING +PUSHWORD ZERO ; DUMMY CONTROL WORD  ;  ; ALLOCATE, ON THE STACK, SEGMENT INFORMATION BLOCKS AND ENVIORNMENT  ; RECORDS FOR THE SEGMENTS PRESENT IN SYSTEM.PASCAL.  $12 MOV SEGDICT,R5 ; R5 IS POINTER INTO SEGMENT DICTIONARY +LI R4,2 ; R4 IS OFFSET INTO GLOBAL VECTOR +LI R1,16 ; WILL SET UP 16 SIBS AND ERECS  $2 C SDADDR(R5),ZERO; IS SEGMENT PRESENT (ADDR<>ZERO)? +JEQ $3 C; SEGMENT PRESENT SO BUILD SIB ON STACK C; REMEMBER: RECORDS ARE PUSHED ON BACKWARDS +AI +BL SYSREAD ; SYSREAD(DISK0,OLDSP^,SEG1SZ,SEG1ADDR) +; +MOV SEG,R1 ; SET SEXOK FLAG +MOV 14(R1),CPOFST +MOV 12(R1),R1 +CLR SEXOK +CI R1,1 ; IS THE SEGMENT OF THE CORRECT SEX? +JEQ $14 C; NO - FLIP IT AS WE SET IPC +SWPB CPOFST +MOV SEG,R1 +MOV CPOFST,14(R1) +SWPB *SP ; FLIP PROCEDURE DICTIONARY POINTER +MOV *SP,R3 ; GET RELATIVE WORD PTR TO TOP OF SEGMENT ... +SLA R3,1 ; ... SP,-SIBSZ ; OPEN UP ROOM ON STACK FOR SIB +CLR SEGPOOL(SP) +CLR SEGBASE(SP) +CLR SEGXXX(SP) +CLR SEGACT(SP) +MOV ONE,SEGLINK(SP) +CLR SEGRES(SP) +CLR SEGNAME(SP) ; 8 CHARACTERS LONG +CLR SEGNAME+2(SP) +CLR SEGNAME+4(SP) +CLR SEGNAME+6(SP) +MOV SDLEN(R5),SEGLEN(SP) +MOV SDADDR(R5),SEGADDR(SP) +A SYSBLK,SEGADDR(SP) ; MAKE RELATIVE BLOCK OFFSET ABSOLUTE +MOV SYSUNT,SEGUNIT(SP) +CLR SEGDATA(SP) (RTWP ; back to interpreter  ;  ;  SSTAT MOV PARM1(R10),R2 ; get statrec pointer (MOV MEMTOPB,*R2 ; memtop to first word (MOV CLOCKHI,2(R2) ; clock hi to second word (MOV CLOCKLO,4(R2) ; clock lo to third word (CLR RETCD(R10) ; clear return code (RTWP ; back to interpreter  ;  ;  +CLR SEGNEXT(SP) +CLR SEGPREV(SP) +CLR SEGTEMP(SP) C; BUILD EREC ON STACK +AI SP,-ERECSZ ; OPEN UP ROOM ON STACK FOR EREC +LI R2,CUTBACK +MOV R2,ENVDATA(SP) +LI R2,GBLVEC +MOV R2,ENVEVEC(SP) +MOV SP,ENVSIB(SP) ; POINT TO SIB JUST BUILT +LI R3,ERECSZ +A R3,ENVSIB(SP) +MOV ONE,ENVLINK(SP) +CLR ENVLIST(SP) +MOV SP,GBLVEC(R4) ; POINT GBLVEC ENTRY AT EREC JUST BUILT  $3 INCT R5 ; POINT TO NEX     NOW BYTES +A SEG,R3 ; ... NOW ABSOLUTE +MOV R3,SEGHI +SWPB *R3 ; FLIP NUMBER OF PROCEDURES +MOV *R3,R2 ; SAVE NUMBER OF PROCEDURES  $16 DECT R3 ; LOOP THROUGH PROCEDURE DICTIONARY +SWPB *R3 ; FLIP POINTER TO PROCEDURE +MOV *R3,R4 ; GET RELATIVE WORD PTR TO PROCEDURE ... +SLA R4,1 ; ... NOW BYTES +A SEG,R4 ; ... NOW ABSOLUTE +SWPB *R4 ; FLIP DATASIZE ROPER FUNCTION IS EXECUTED (IF IMPLEMENTED). * ; * ; 2: FAILING ALL ELSE, THE CHARACTER IS SENT TO THE * ; SCREEN FOR DISPLAY, AND THE CURSOR INCREMENTED, * ; SUBJECT ALWAYS TO THE BOUNDS OF THE SCREEN AND * ; THE SCROLLING RULES. IF THE CHARACTER HAS THE * ; MSB = 1, THEN IT WILL BE DISPLAYED AT HALF OF * ; THE NORMAL INTENSITY, ELSE AT FULL INTENSITY. * D+DECT R4 +SWPB *R4 ; FLIP EXITIC +DEC R2 ; R2>0 MEANS MORE PROCEDURES TO GO +JGT $16 +MOV SEGHI,R3 +DECT R3 +MOV *R3,R2 ; GET RELATIVE WORD PTR TO PROCEDURE 1 ... +SLA R2,1 ; ... NOW BYTES +A SEG,R2 ; ... NOW ABSOLUTE +INCT R2 ; MOVE PAST DATASIZE TO CODE +MOV R2,IPC +JMP $15  $14 INC SEXOK ; SEX IS OK - DON'T FLIP +MOV *SP,R3 ; GET RELATIVE W; (IF THE GRAPHICS TOGGLE IS TRUE, THE CONTROL *  ; CHARACTERS ARE DISPLAYED AS LINE-GRAPHICS.) *  ; * ; *CURSOR ADDRESSING* * ; * ; MOVEMENT IS IMPLEMENTED BY THE STRING 8FH FOLLOWED * ; BY ROW (Y) AND COLUMN (X) VALUES IN BINARY !! * ; **IF X OR Y IS INVALID, THE CURSOR DOES NOT MOVE *  ; ORD PTR TO TOP OF SEGMENT ... +SLA R3,1 ; ... NOW BYTES +A SEG,R3 ; ... NOW ABSOLUTE +MOV R3,SEGHI +DECT R3 ; GET RELATIVE WORD PTR TO PROCEDURE 1 ... +MOV *R3,R2 +SLA R2,1 ; ... NOW BYTES +A SEG,R2 ; ... NOW ABSOLUTE +INCT R2 ; MOVE PAST DATASIZE TO CODE +MOV R2,IPC  ;  ; SET EVERYTHING ELSE TO ALLOW RUNNING OF SEGMENT 16  **********ON THAT AXIS******** * ; BUT COULD MOVE ON THE OTHER AXIS, IF VALID. * ;************************************************************  ;  DISPEP *.IF MAPPING *BLWP REMAP ; MAP FOR 990/10 *.ENDC  ; *CLR R1 ; ENSURE RHS IS ZERO *MOVB *R11,R1 ; TAKE CHAR FROM CALLER *MOV CONSOL,R12 *SBO WRDSEL ; TURN CURSOR OFF *SBZ CURENB ; CURSOR IS TURNED BACK ON AFTER  $15 LI BASE,CUTBACK ; INITIALIZE BASE REGISTER TO TOP OF HEAP +MOV BASE,R3 ; R3 WILL KEEP TRACK OF HEAP TOP +MOV R3,MSSTAT(R3) ; ADD MSCW FOR SEGMENT 16 DATA +AI R3,MSCWSZ ; BUMP PAST MSCW +LI R4,SYSCMB ; STORE SYSCOM LOCATION IN MAGIC FIRST DATA WORD +MOV R4,*R3 +MOV SEGDICT,R1 ; GET DATASIZE FROM SEGMENT DICTIONARY +A 288(R1),R3 ; OPEN UP SEGMENT 16 DATASIZE ON THE HEAP +A 288(R1),R3 +LI R1,ROOTTASK C; UPDATING ITS POSITION  ; CHECK TO SEE IF WE ARE IN A GOTOXY SEQUENCE *MOV CMNDX,R2 *JEQ FINDIT ; IF ZERO, WE ARE NOT *CI R2,2 ; IF 2, WE HAVE ROW VALUE IN R1 *JNE $1 ; IF NOT, CHECK FOR 1 *DEC R2 *MOV R2,CMNDX ; UPDATE COMMAND FLAG(COUNTER) *SWPB R1 ; RIGHT-JUSTIFY COUNT *CI R1,23 ; VALID? *JGT BEXIT ; NO, FORGET IT *MOV R1,R1 *JLT BEXIT ; INVALID, NEG; SET HEAP TOP +MOV R3,TIBSPLW(R1) +CLR ADRSP +MOV CPOFST,R1 +SLA R1,1 +MOV R1,CPOFST +A SEG,R1 +MOV R1,CPOOL +MOV SAVRTN,R11 ; RESTORE RETURN ADDRESS +RT ; RETURN TO BEGIN FETCHING INSTRUCTIONS  ;  ; SEGMENT DICTIONARY BUFFER  SEGDICT .WORD $+2 ; THIS IS THE WORD BEFORE THE SEGMENT C; DICTIONARY. THE DICTIONARY IS READ IN. C ATIVE *MOV R1,R9 ; UPDATE SOFT CURSOR ROW *JMP BEXIT ; AND QUIT  $1 CI R2,1 ; IF 1, WE HAVE COL VALUE IN R1 *JNE FINDIT ; IF NOT, CONTINUE *CLR CMNDX ; RESET COMMAND FLAG *SWPB R1 ; RIGHT-JUSTIFY *CI R1,79 ; VALID? *JGT BEXIT ; NO, FORGET IT *MOV R1,R1 *JLT BEXIT ; INVALID, NEGATIVE *MOV R1,R10 ; PUT IN SOFT CURSOR COL O^¤c¤c*B SC20 ; UPDATE HARD CURSOR  BEXIT B SCEXIT  FINDIT LI R3,ENDFCT ; END OF TABLE *LI R2,BGNFCT ; START OF TABLE  FCNFND *C R1,*R2+ ; IF A MATCH... *JEQ FCNBR ; ...THEN BRANCH, ELSE... *INCT R2 ; ...BUMP OVER TABLE ENTRY AND... *C R2,R3 ; ...IF NOT AT END, THEN... *JL FCNFND ; ...LOOK SOME MORE, ELSE...  ; ; ...THE BRANCH WILL BE T€bXO SC4*  FCNBR *MOV *R2,R2 ; PICK UP TABLE ENTRY *B *R2 ; AND GO TO IT  BGNFCT *.WORD 0D00H,FCN1 ; CARRIAGE RETURN *.WORD 0A00H,FCN2 ; LINE FEED *.WORD 8B00H,FCN2 ; ANOTHER LINE FEED *.WORD 0800H,FCN3 ; CURSOR LEFT *.WORD 8A00H,FCN4 ; CURSOR RIGHT *.WORD 8900H,FCN5 ; CURSOR UP *.WORD 8200H,FCN6 ; CURSOR HOME *.WORD 0C00H,FCN7 ; HOME AND CLEAR *.WORD 8D00H,FCN8 ; ERASE TO END OF LINE  ;************************************************************ ;THIS XOP TAKES THE CHARACTER FROM THE CALLER AND DOES * ;ONE OF THE FOLLOWING BEFORE RETURNING: * ; * ; 1: IF NOT IN A GOTOXY COMMAND, THEN THE FUNCTION * ; TABLE IS SEARCHED TO SEE IF THE CHARACTER * ; HAS SOME SPECIAL MEANING (MOVE CURSOR, SOUND BELL, * ; ERASE TO END-OF-LINE, ETC.). IF FOUND, THEN * ; THE P      *SBO WRDSEL *LDCR R2,11 ; PUT OUT CURSOR ADDRESS  ; OUTPUT THE CURSOR  SCEXIT MOV CONSOL,R12 *SBO WRDSEL *SBO CURENB  RTWP  ;  ; ROUTINE TO SCROLL THE SCREEN UP*  ;  SCROLL *LI R1,2020H ; FILL UP LINE BUFFER WITH BLANKS *LI R2,LINBUF *LI R3,40 ; NUMBER OF WORDS TO MOVE  FCN21 *MOV R1,*R2+ ; MOVE A WORD OF BLANKS *DEC R3 ; BUMP WORD COUNTER *JMP BRSC20  ;  FCN2 ; LINE FEED *C GRAPHIC,TRUEB *JEQ SC4 ; IF GRAPHIC, DISPLAY *INC R9 *CI R9,24 ; NEED TO SCROLL? *JLT SC20 ; NO, FINISH *BL SCROLL *JMP BRSC20  ;  FCN3 ; BACK SPACE *C GRAPHIC,TRUEB *JEQ SC4 ; IF GRAPHIC, DISPLAY *MOV R10,R10 *JEQ SC20 ; IF ON COL 0, DO NOTHING *DEC R10 *JNE FCN21 ; LOOP UNTIL DONE *SBO WRDSEL *LI R1,24*80-1 ; ADDRESS OF END OF SCREEN *LDCR R1,11 ; SET CURSOR AT EOS *SBZ WRDSEL *LI R0,24 ; # OF LINES TO MOVE  FCN22 ; START NEW LINE MOVE *LI R1,80 ; # OF BYTES IN LINE *LI R2,LINBUF+79 ; START AT BACK OF BUFFER  FCN23 ; MOVE A CHARACTER *LDCR *R2,8 ; PUT TO BOARD (NOT TO SCREEN YET) * ; ELSE, MOVE SOFT CURSOR *JMP BRSC20 ; GO FIX HARD CURSOR  ;  FCN4 ; FORE SPACE *C GRAPHIC,TRUEB *JEQ SC4 ; IF GRAPHIC, DISPLAY *INC R10 ; TRY MOVE RIGHT *CI R10,80 ; OVER EDGE? *JLT SC20 ; NO, OK *DEC R10 ; ELSE, GO BACK *JMP BRSC20  ;  FCN5 ; UP LINE *C GRAPHIC,TRUEB STCR *R2,8 ; GET CHAR FROM SCREEN TO BUFF *SBZ CRTSTB ; NOW PUT FROM BOARD TO SCREEN *SBO CURMOV ; DECREMENT CURSOR ADDR *DEC R2 ; DEC BUFFER POINTER *DEC R1 ; DEC CHAR COUNTER *JNE FCN23 ; MOVE ANOTHER CHAR, THIS LINE *DEC R0 ; DEC LINE COUNTER *JNE FCN22 ; MOVE ANOTHER LINE *DEC R9 ; PUT SOFT CURSOR AT ROW 23 *JEQ SC4 ; IF GRAPHIC, DISPLAY *DEC R9 ; MOVE ROW UP *CI R9,-1 ; OVER TOP EDGE? *JGT SC20 ; NO, CONTINUE *BL REVRSE ; YES, ROLL DOWN *JMP BRSC20  ;  FCN6 ; HOME CURSOR *C GRAPHIC,TRUEB *JEQ SC4 ; IF GRAPHIC, DISPLAY *CLR R9 ; ROW = 0 *CLR R10 ; COL = 0 *JMP BRSC20  ;  FCN7 ; FORM FE*B *R11 ; THE SCROLL IS DONE  ;  ;ROUTINE TO SCROLL THE SCREEN DOWN*  ;  REVRSE *LI R1,2020H ; FILL UP LINE BUFFER WITH BLANKS *LI R2,LINBUF *LI R3,40 ; NUMBER OF WORDS TO MOVE  FCN51 *MOV R1,*R2+ ; MOVE A WORD OF BLANKS *DEC R3 ; BUMP WORD COUNTER *JNE FCN51 ; LOOP UNTIL DONE *SBO WRDSEL *CLR R1 *LDCR R1,11 *SBZ WRDSEL *LI R0,24  FCN52 *LI R1,80 *LI ED (HOME AND CLEAR) *C GRAPHIC,TRUEB *JEQ SC4 ; IF GRAPHIC, DISPLAY *CLR R9 *CLR R10 ; HOME SOFT CURSOR *SBO WRDSEL *CLR R1 *LDCR R1,11 ; HOME HARD CURSOR *JMP FCN9 ; USE ERASE TO END OF SCREEN  ;  FCN8 ; ERASE TO END OF LINE *C GRAPHIC,TRUEB *JEQ SC4 ; IF GRAPHIC, DISPLAY *MOV R10,R3 ; COPY COLUMN COUNTER  R2,LINBUF  FCN53 *LDCR *R2,8 *STCR *R2,8 *SBZ CRTSTB *SBZ CURMOV *INC R2 *DEC R1 *JNE FCN53 *DEC R0 *JNE FCN52 *CLR R9 *B *R11  ;  ; END OF DISPLAY XOP CODE  ; *LI R2,2000H ; BLANK IN R2 *SBZ WRDSEL  FCN81 *LDCR R2,8 ; DATA TO BOARD *SBZ CRTSTB ; BOARD TO SCREEN *SBZ CURMOV ; INC CURSOR *INC R3 ; INC COUNTER *CI R3,80 ; DONE WITH LINE? *JLT FCN81 ; NO, DO AGAIN *JMP SC20  ;  FCN9 ; ERASE TO END OF SCREEN *C GRAPHIC,TRUEB *JEQ SC4 ; IF GRAPHIC, DISPLAY *SBO WRDSEL *STCR O^„r„r R1,11 ; GET CURSOR ADDRESS *LI R2,24*80 *S R1,R2 ; R2 = # OF BYTES TO ERASE *LI R1,2000H ; BLANK IN R1 *SBZ WRDSEL  FCN91 *LDCR R1,8 *SBZ CRTSTB *SBZ CURMOV *DEC R2 *JNE FCN91 *JMP SC20  ;  FCN10 ; SOUND BEEPER *C GRAPHIC,TRUEB *JEQ SC4 ; IF GRAPHIC, DISPLAY *SBO WRDSEL *SBO BEEPER *JMP SC20  ; *.WORD 8E00H,FCN9 ; ERASE TO END OF SCREEN *.WORD 0700H,FCN10 ; SOUND ALARM *.WORD 8F00H,FCN11 ; START GOTOXY COMMAND *.WORD 0000H,SCEXIT ; NULLS DO NOT GO TO SCREEN  ENDFCT .WORD SC4 ; 'NOT-FOUND' WILL GO TO SC4.  SC4 SBZ WRDSEL *LDCR R1,8 ; SEND TO INTERFACE *SBZ CRTSTB ; STROBE TO MEMORY  ;TRY TO INCREMENT COLUMN* *INC R10 *CI R10,80 ; OVER RIGHT EDGE? *JNE SC5 ; NO, CO FCN11 ; START OF GOTOXY *LI R2,2 *MOV R2,CMNDX ; NEED 2 MORE CHARACTERS FOR ROW AND COLUMN *JMP SCEXIT  ;  ;  ;ROUTINE TO CALCULATE THE REAL CURSOR POSITION  ;BASED ON THE ROW AND COLUMN NUMBERS  ;KEPT IN R9 AND R10  ;  SC20 *LI R0,80 ; MULTIPLIER *MOV R9,R1 ; ROW COUNT IN R1 *MPY R0,R1  ;R2 NOW HAS ROW # TIMES 80 *A R10,R2 ; ADD IN COLUMN COUNT  ;R2 NOW HAS HARD CURSOR ADDRESSNTINUE *DEC R10 ; BACK TO 79 *JMP SC6 ; AND DO NOT MOVE REAL CURSOR  SC5 *SBZ CURMOV ; MOVE THE REAL CURSOR RIGHT  SC6 *B SCEXIT ; GO CLEAN UP  ;  ;  BRSC20 B SC20 ; REQUIRED TO KEEP JUMPS IN RANGE  ;  ;SCREEN FUNCTION HANDLERS*  ;  FCN1 ; CARRIAGE RETURN *C GRAPHIC,TRUEB *JEQ SC4 ; IF GRAPHIC, DISPLAY *CLR R10 ; SOFT COL = 0      €3ˆDC * *.IF PRINTKEY  PKCMCB .WORD 5 ; SVC CODE FOR PRINTER WRITE *.WORD 0 ; CHAR TO BE PRINTED (MSB) *.WORD 0,0,0,0,0 ; REST OF CMCB *.ENDC * *.ENDC ; END OF USERU|PRINTKEY   STXBIOS .BYTE 02H  SOHBIOS .BYTE 01H  CRBIOS .BYTE 0DH  LFBIOS .BYTE 0AH  CEOLBIOS .BYTE 8DH  CEOSBIOS .BYTE 8EH *.ALIGN 2  TRUEB .WORD 0FFFFH  NUL  FALSEB .WORD 0 *.IF ~FD800  ; ; ;  ;  ; RAM MEMORY LOCATIONS REQUIRED BY THE BIOS  ;  ; KEYBOARD QUEUE, POINTERS,FLAGS*  ; FLAGS ARE TRUE WHEN FFFF, FALSE WHEN 0000* *.ALIGN 2  KEYQUE .BLOCK 256  QFULL .WORD 0 ; TRUE WHEN QUEUE IS FULL  QMT .WORD -1 ; TRUE WHEN QUEUE IS EMPTY  FLUSHX .WORD 0 ; TRUE WHEN FLUSHING  STOPX .WORD 0 ; TRUE WHEN HALTED  CAPSX .WORD 0 ; TRUE IF UPPER CASE ONLY  PRNTX .WORD 0 ; TRUE IF PRINTER P ;THE FOLLOWING ARE FOR TILINE DISK CONTROLLER CARDS  ;  TILNWS .BLOCK 32 ; FOR XOP 6 (TILINE CONTROLLER)  TBASE .WORD 0F800H ; STORAGE FOR ADDRESS OF CURRENT CARD  DRVSEL .WORD 0 ; STORAGE FOR CURRENT SELECTED DRIVE (W6 FORM)  DRSTAT .WORD 0,0,0,0,0,0 ; STORE 3RD WORD OF ST REGS FOR DRIVES 0-5  TOFFSET .WORD DTO0,DTO1 ; STORE STARTING TRACK OF DISK IMAGES *.WORD DTO2,DTO3 ; FROM DEFAULTS IN MAIN FILE. MODIFIED BY *.WORD DTO4,DTO5 ; USRESENT  LINEX .WORD 0 ; TRUE IF MODEM PRESENT  INITX .WORD 0 ; TRUE IF CONSOLE INITIALIZED  PINITX .WORD 0 ; TRUE IF PRINTER INITIALIZED  RINITX .WORD 0 ; TRUE IF REMOTE INITIALIZED  CMNDX .WORD 0 ; TRUE WHEN PROCESSING TERMINAL COMMAND  SDONEX .WORD 0 ; TRUE WHEN SERIAL OUTPUT DONE  BRKPC .BLOCK 2 ; STORAGE FOR BREAK ADDRESS  SYSCM .BLOCK 2 ; STORAGE FOR SYSCM POINTER E OF XOP 9  CURCMD .WORD 0 ; STORE READ OR WRITE COMMAND  RDCMD .WORD 0200H  WTCMD .WORD 0300H  TLCOPY ; COPY OF PARMS PASSED TO BIOS  TLSVC .WORD 0 ; ORIGINAL BIOS SVC #  TLBLK .WORD 0 ; PASCAL LOGICAL BLOCK #  TLCNT .WORD 0 ; BYTES TO TRANSFER  TLBUFF .WORD 0 ; BUFFER ADDRESS  TLDRV .WORD 0 ; DRIVE # (PASSED TO BIOS AS 4,5)  LINBUF .BLOCK 80 ; STORAGE FOR SCREEN SCROLLING  CONSOL .WORD KBASE1 ; CRU ADDRESS OF CURRENT CONSOLE  REMQUE .BLOCK 256 ; STORAGE FOR REMOTE INPUT  RQFULL .WORD 0 ; TRUE WHEN QUEUE IS FULL  RQMT .WORD -1 ; TRUE WHEN QUEUE IS EMPTY  ALTPRNT .WORD 0 ; TRUE IF ALTERNATE PRINTER CHOSEN  VIDEO .WORD -1 ; TRUE IF VIDEO IS ENABLED (PRIVATE SCREEN)  GRAPHIC .WORD 0 ; TRUE IF IN GRAPHICS MODE  FKEY TLCONT .WORD 0 ; CONTROL WORD FOR UNITSTATUS *.WORD 0 ; UNUSED CURRENTLY (RET CODE IN BIOS)  TLWORDS ; WORDS TO WRITE TO TILINE CARD  TLW0 .WORD 0  TLW1 .WORD 0  TLW2 .WORD 0  TLW3 .WORD 0  TLW4 .WORD 0  TLW5 .WORD 0  TLW6 .WORD 0  TLW7 .WORD 0  STRRGS .WORD 0,0,0 ; PLACE FOR STORE REGS COMMAND TO WRITE  ;  ; TILINE DISK TABLE-- MSB IS PHYSICAL DRIVE NUMBER, LSB S .WORD 0 ; TRUE IF FUNCTION KEYS TREATED AS CHARS  ALTQUE .WORD 0 ; TRUE IF UTILITY QUEUE IS SELECTED FOR CONSOLE  EVENT .WORD 0 ; contains address of interpreter Event procedure  *.IF USERU  UTILQUE .BLOCK 256 ; UTILITY QUEUE *.BLOCK 256  UQFULL .WORD 0 ; TRUE WHEN QUEUE IS FULL  UQMT .WORD -1 ; TRUE WHEN QUEUE IS EMPTY  UINPTR .WORD 0  UOUTPTR .WORD 0 *.ENDC *.IF FD800 IS LSB OF  ; TILINE CONTROLLER ADDRESS FOR THAT DRIVE. POSITION IN TABLE IS  ; THE DRIVE NUMBER PASSED FROM THE RSP.  ;  TLDT .BYTE TLDT00,TLDT01 *.BYTE TLDT10,TLDT11 *.BYTE TLDT20,TLDT21 *.BYTE TLDT30,TLDT31 *.BYTE TLDT40,TLDT41 *.BYTE TLDT50,TLDT51 *.IF SKEWED  TTT .BLOCK 8  SSS .BLOCK 8  TC128 .WORD 128  TERAK .WORD TWS,TEP  TWS .BLOCK 32  SAVER2 .WORD 0  SAVER7 .WORD 0  ;  ; MASKS FOR THE DISK COMMANDS*  RESET .WORD 0D000H  RAMLOD .WORD 0D522H  SEEK .WORD 01200H  READ .WORD 04200H  WRITE .WORD 07200H  STOPB .WORD 0B000H *.ENDC  ; WORKSPACES*  INTPWS .BLOCK 32  DISPWS .BLOCK 32  KEYBWS .BLOCK 32  BIOSWS .BLOCK 32  TRAPWS .BLOCK 32  SELIWS .BLOCK 32  CLCKWS  CLOCKHI .WORD 0  CLOCKLO .WORD 0 ; NOTE THAT THE CLOCKWS OVERLAPS MAPWS *.WORD 0,0  MAP ;BOOLEAN FOR TERAK SKEW  ;  ISTERK .WORD 0  ; *.ENDC *.ENDC *.IF DEBUG  BUGSAVE .WORD 0  BUGHOLD .WORD 0 *.ENDC  WS .BLOCK 32 ; FOR 990/10 REMAP  CHEKWS .BLOCK 32 ; FOR MACHINE ERROR CHECK INTERRUPTS  ; *.IF PARPTR  ;  ; WORKING STORAGE FOR FIXED PITCH PRINT  ;  WPBOOT .WORD -1 ; BOOT SWITCH FOR TOP OF FORM  WPOPEN .BLOCK 2 ; DEVICE OPEN SWITCH  LINES .BLOCK 2 ; MODULO 66 LINE COUNTER  HORPOS .BLOCK 2 ; HORIZONTAL POSITION ACCUMULATOR  DIRECT .BLOCK 2 ; CARRIAGE MOVEMENT DIRECTION *.ENDC  ; *.IF <|>  USERWS .BLOCK 32 ; FOR RECURSIVE BIOS CALL (THRU KEYBOARD) >; THIS USED BY KEYBOARD HANDLER  USERBIOS .WORD USERWS,USEREP ; VECTOR FOR CALLING BIOS THRU BLWP * *.IF USERU  U129CMCB .WORD 17 ; SVC CODE FOR USER WRITE *.WORD 0 ; UNUSED *.WORD 0 ; UNUSED *.WORD 0 ; BUFFER ADDRESS *.WORD 129 ; UNIT NUMBER *.WORD 0 ; UNUSED *.WORD 0 ; RETURN CODE  .EN     2 ; DISABLE KEYBOARD INTERRUPTS *CLR KEYBWS+16 ; CLEAR R8 OF KEYBWS (IN QPTR) *CLR KEYBWS+18 ; CLEAR R9 OF KEYBWS (OUT QPTR) *SETO QMT ; MARK INPUT QUEUE AS EMPTY *SETO VIDEO ; MAKE SCREEN VISIBLE TRUE *CLR GRAPHIC ; MARK TRANSPARENT FALSE (NORMAL MODE) *CLR QFULL *CLR FLUSHX *CLR STOPX *SETO INITX  ;PICK UP PC FOR BREAK* *MOV PARM1(R10),BRKPC  ;GET ADDR OF RSP SYSCM AREA* ; ; ;MAIN ENTRY POINT FOR THE BIOS FROM THE RSP* ;  BIOSEP *.IF MAPPING *BLWP REMAP ; MAP FOR 990/10 *.ENDC  BUG "BIOS ENTRY"  ;CHECK FOR STOP*  $1 C STOPX,TRUEB *JNE USEREP ; THE KEYBOARD INTERRUPT WILL CLEAR *IDLE ; STOPX WHEN THE STOP/START KEY IS HIT *JMP $1 ; CHECK AGAIN  USEREP ; ENTRY FOR BLWP CALL FROM KEYBOARD *MOV R11,R10 ; R10 NOW HAS ADDR OF CALLER'S PARMS  ;CHECK SVCNO *MOV PARM2(R10),R2 *AI R2,SYSOFF ; ADD OFFSET *MOV R2,SYSCM ; STORE IN MY SYSCM AREA  ;INITIALIZE THE VIDEO INTERFACE FOR BOTH VDT'S *LI R12,KBASE1 *SBZ WRDSEL ; FIRST WORD *SBZ CRTTST ; SET NORMAL MODE *SBZ CBLINK ; STEADY CURSOR *SBO INTENB ; ALLOW KEYBOARD INTERRUPTS *SBO HLENB ; ALLOW HI/LO BASED ON MSB *SBO VIDENB ; TURN ON VIDEO GENERATOR *SBO WRDSEL ; NEXFOR ILLEGAL PARMS* *MOV SVCNO(R10),R1 *JLT ERROR *CI R1,MAXSVC *JLE BIOS1  ERROR MOV TRUEB,RETCD(R10) *RTWP  ;THE SVC NUMBER IS VALID, BRANCH TO THE  ;APPROPRIATE SECTION OF CODE  ;  BIOS1 SLA R1,1 *MOV SVCTBL(R1),R2 *B *R2  ;  SVCTBL .WORD CREAD,CWRITE,CCTRL,CSTAT *.WORD PREAD,PWRITE,PCTRL,PSTAT *.WORD DREAD,DWRITE,DCTRL,DSTAT *.WORD RREAD,RWRITE,RCTRL,RSTAT *.WORD UREAD,UWRITE,UCTRL,USTAT T WORD *SBO BEEPER ; BEEP *LI R12,KBASE2 *SBZ WRDSEL ; FIRST WORD *SBZ CRTTST ; SET NORMAL MODE *SBZ CBLINK ; STEADY CURSOR *SBO INTENB ; ALLOW KEYBOARD INTERRUPTS *SBO HLENB ; ALLOW HI/LO BASED ON MSB *SBO VIDENB ; TURN ON VIDEO GENERATOR *SBO WRDSEL ; NEXT WORD *SBO BEEPER ; BEEP  ;RETURN A-OK TO RSP* *.WORD SREAD,SWRITE,SCTRL,SSTAT  .WORD QUIET,ENABLE  .WORD SERRD,SERWT,SERCT,SERST  ;  ;  CREAD BUG "CONSOLE READ" *.IF USERU *C ALTQUE,TRUEB ;HAS THE ALTERNATE QUEUE BEEN SELECTED? *JEQ READALTQ *.ENDC  ;OBTAIN NEXT CHARACTER FROM THE KEYBOARD QUEUE.  ;IF QUEUE IS EMPTY, WAIT FOR A CHARACTER *CLR FLUSHX ; ADDED 15 MAR 79 FZW  CRSPIN C QMT,TRUEB ; IS QUEUE EMPTY? *JNE $1 ; NO, GO GE ;THE RSP IS RESPONSIBLE FOR CLEARING THE SCREEN, IF DESIRED.  ;AT POWER-UP THE SCREEN BUFFER, AND THE HARD AND SOFT  ;CURSOR POSITIONS ARE UNDEFINED. THE FIRST CHARACTER WRITTEN  ;AFTER POWER-UP SHOULD BE A 'HOME AND CLEAR' (FF) SEQUENCE  ; (THIS IS DONE IN INITIALIZATION CODE AFTER BOOT) *CLR RETCD(R10) *RTWP  CSTAT BUG "CONSOLE STATUS"  MOV PARM5(R10),R1 ; GET CONTROL WORD *MOV PARM1(R10),R2 ; GET POINTER *ANDI R1,1 ; MASK ALL BUT LSB *JT CHAR *MOV CONSOL,R12 ; TURN ON CURSOR FOR INPUT *SBO WRDSEL *SBO CURENB *IDLE ; IDLE UNTIL INTERRUPT (ANY INTERRUPT) *JMP CRSPIN ; CHECK AGAIN  $1 CLR R2 *LIMI 0002H ; INHIBIT KEYBOARD INTERRUPTS *MOV KEYBWS+16,R8 ; GET COPY OF IN QPTR *MOV KEYBWS+18,R9 ; GET COPY OF OUT QPTR *MOVB KEYQUE(R9),R2 ; GET THE CHARACTER *CLR QFULL ; CLEAR THE "QUEUE FULL" FLAG *INC R9 EQ $1 ; IF 0, I/O DIRECTION = OUT (ALWAYS EMPTY) *C QMT,TRUEB ; IS INPUT QUEUE EMPTY? *JNE $2 ; NOT EMPTY, FIGURE HOW MANY  $1 CLR R1 ; EMPTY, RETURN COUNT = 0 *MOV R1,*R2 *JMP CSEXIT  $2 LIMI 2 ; MASK KEYBOARD INTERRUPTS *MOV KEYBWS+16,R8 ; COPY OF IN QUEUE POINTER *MOV KEYBWS+18,R9 ; COPY OF OUT QUEUE POINTER *S R9,R8 *JGT $3 *AI R8,255 *ANDI R9,00FFH ; FORCE COUNT TO CIRCULATE *C R8,R9 ; IS QUEUE EMPTY? *JNE $2 ; NO, CONTINUE *SETO QMT ; YES, SET FLAG  $2 MOV R9,KEYBWS+18 ; RESTORE POINTER *CLR RETCD(R10) ; ZERO RETURN CODE *MOV R2,PARM1(R10) ; RETURN CHARACTER *RTWP  ;  ;OBTAIN NEXT CHARACTER FROM THE UTILITY QUEUE.  ;IF QUEUE IS EMPTY, JUMP BACK TO REAL KEYBOARD QUEUE  ; (BUT DON'T CHANGE THE STATE OF THE ALTQUE FLAG).  ; *.IF  $3 MOV R8,*R2 ; RETURN COUNT OF CHARS IN QUEUE  CSEXIT CLR RETCD(R10) *RTWP  ;  USERU  READALTQ  $0 C UQMT,TRUEB ; IS QUEUE EMPTY? *JEQ CRSPIN ; YES, GO GET CHAR FROM REAL QUEUE  $1 CLR R2 *MOV UINPTR,R8 ; GET COPY OF IN QPTR *MOV UOUTPTR,R9 ; GET COPY OF OUT QPTR *MOVB UTILQUE(R9),R2 ; GET THE CHARACTER *CLR UQFULL ; CLEAR THE "QUEUE FULL" FLAG *INC R9 *ANDI R9,01FFH ; FORCE COUNT TO CIRCULATE *C R8,R9 ; IS QUEUE EMPTY? O^„²¤Ć*JNE $2 ; NO, CONTINUE *SETO UQMT ; YES, SET FLAG  $2 MOV R9,UOUTPTR ; RESTORE POINTER *CLR RETCD(R10) ; ZERO RETURN CODE *MOV R2,PARM1(R10) ; RETURN CHARACTER *RTWP *.ENDC  CWRITE C FLUSHX,TRUEB ; DOING FLUSH? *JEQ CWEXIT ; YES, EXIT *CLR R2 *MOVB PARM1(R10),R2 *BUG "CONSOLE WRITE" *DISPLAY R2  CWEXIT CLR RETCD(R10) *RTWP  CCTRL BUG "CONSOLE CLEAR" *LIMI €I      ; ;OUTPUT* ; ;FOR WORD SELECT = 0* ; ;BITS 0-6 ARE LSB'S OF SCREEN DATA* ;BIT 7 IS MSB OF DATA, 0=HIGH INTENSITY IF HI/LO IS ENABLED  CRTSTB .EQU 0008H ; STROBES PREVIOUS 8 BITS TO SCREEN  CRTTST .EQU 0009H ; SET TO 0 FOR NORMAL OPERATION  CURMOV .EQU 000AH ; 0 INCREMENTS CURSOR, 1 DECREMENTS  CBLINK .EQU 000BH ; 1 TO BLINK CURSOR AT 2 HZ  INTENB .EQU 000CH ; 1 TO ENABLE INTERRUPTS FROM KBDRDY O^„²¤Ć HLENB .EQU 000DH ; 1 TO ALLOW HI/LO INTENSITY BY CHAR  VIDENB .EQU 000EH ; 1 TO ENABLE VIDEO GENERATION  WRDSEL .EQU 000FH ; BANK-SELECT FOR CRU  ;  ;FOR WORD SELECT = 1* ; ;BITS 0-A ARE CURSOR ADDRESS WRITE* ;BIT >B IS NOT USED*  CURENB .EQU 000CH ; 1 TO SHOW CURSOR  KBDACK .EQU 000DH ; RESET INTERRUPT (0 OR 1)  BEEPER .EQU 000EH ; SET 1 TO GET .3 SEC BEEP ;BIT >F IS WORD SELECT*  ; *.IF PARPTR  WPCRU .EQU 6€)4 ; CRU BASE ADDRESS FOR PRINTER  RESTOR .EQU 12 ; RESTORE COMMAND BIT  SELECT .EQU 16 ; SELECT COMMAND BIT  PAPOUT .EQU 22 ; PAPER OUT STATUS BIT  RIBBON .EQU 21 ; RIBBON OUT STATUS BIT  CHECK .EQU 20 ; PRINT CHECK STATUS BIT  READY .EQU 16 ; PRINTER READY STATUS BIT  LIFT .EQU 20 ; RIBBON LIFT COMMAND BIT  WAY .EQU 10 ; VERTICAL/HORIZONTAL DIRECTION COMMAND BIT  ;  MAXUSER .EQU 133 ; MAXIMUM USER UNIT NUMBER IN TABLES  ;  ;  MAXSVC .EQU 29  ;  ;DATA TEMPLATES FOR BIOS CALLS  ;  SVCNO .EQU 0  PARM1 .EQU 2  PARM2 .EQU 4  PARM3 .EQU 6  PARM4 .EQU 8  PARM5 .EQU 10  RETCD .EQU 12  ; *.IF S9902  RBASE .EQU 1700H ; REMOTE LINE CRU BASE (P5 ON 990/5 CARD)  PBASE .EQU 1700H ; 810 PRINTER CRU BASE (P4 ON 990/5 CARD) *.ELSE  RBASE .EQ PWSTB .EQU 18 ; PRINT WHEEL STROBE COMMAND BIT  PFSTB .EQU 17 ; PAPER FEED STROBE COMMAND BIT  CARSTB .EQU 19 ; CARRIAGE STROBE COMMAND BIT  HALFSP .EQU 11 ; HORIZONTAL 1/120" BIT  PFRDY .EQU 17 ; PAPER FEED READY STATUS BIT  PWRDY .EQU 18 ; PRINT WHEEL READY STATUS BIT  CARRDY .EQU 19 ; CARRIAGE READY STATUS BIT  .ENDC * *.IF FD800  ; ;FOR THE FLOPPY DISK CONTROLLER* ; ;IU 0000H ; HALF-SIZE CRU CARD  PBASE .EQU 0020H ; HALF-SIZE CRU CARD *.ENDC  ;  SBASE2 .EQU 0060H ; SERIAL LINE 2 (UTILITY)  FBASE1 .EQU 0080H ; FD CRU BASE FOR BITS 0-F  FBASE2 .EQU 00A0H ; FD CRU BASE TO MAP BITS 10-1F TO 0-F  KBASE1 .EQU 00C0H ; CRT CRU BASE FOR VDT 1  KBASE2 .EQU 00E0H ; CRT CRU BASE FOR VDT 2  ;  .IF ~S9902  ;  ;  ;FOR THE SERIAL I/O BOARDS (810 PRINTER, 733ASR, REMOTE)* NPUT* ; ;BITS 0-F ARE 16 BITS OF DATA READ FROM CONTROLLER*  OPCOMP .EQU 0000H ; OPERATION COMPLETE WHEN HIGH*  XFRRDY .EQU 0001H ; TRANSFER READY  DNR .EQU 0002H ; SET IF DRIVE NOT READY  ; ; IS RESET BY ANY ADDRESSING OF BIT >F  FDFAIL .EQU 0007H ; SET WHEN DIAGNOSTIC FAILED  FCBUSY .EQU 000AH ; SET WHEN A COMMAND IS GIVEN;  ; ; RESETS ITSELF WHEN COMMAND COMPLETED  ; INPUT *  CIN .EQU 0 ; BITS 0 -> 7 ARE CHARACTER  WRQ .EQU 11 ; HIGH WHEN TBE  RRQ .EQU 12 ; HIGH WHEN RDA  DCD .EQU 13 ; HIGH WHEN CARRIER ON  DSR .EQU 14 ; HIGH WHEN TERMINAL READY (PIN 20)  SERINT .EQU 15 ; HIGH WHEN BOARD CAUSES INTERRUPT  ; OUTPUT *  COUT .EQU 0 ; BITS 0 -> 7 ARE CHARACTER  DTR .EQU 9 ; MUST DWP .EQU 000BH ; SET WHEN DISK WRITE-PROTECTED  FDINT .EQU 000FH ; SET WHEN COMMAND COMPLETED, >; RESETS WHEN COMMAND ISSUED   ;OUTPUT*  ; ;BITS 0-F ARE 16 BITS OF DATA TO CONTROLLER ;BITS 10-1F ARE 16 BITS OF COMMAND TO CONTROLLER .ENDC  ;REFERENCE TO THE SOFT CHARACTERS 'FLUSH', 'STOPB', ;AND THE 'BREAK' FUNCTION WILL BE DONE BY ;INDEXED INSTRUCTIONS. THE CONSOLEINIT FUNCTION WILL ;BE PASSED THE ADDRESS OF 'SYSCM', AND WILL STORE THIS ;ADDRESS AFTER ADDING  BE HIGH TO COMMUNICATE (PIN 6)  RTS .EQU 10 ; MUST BE HIGH TO WRITE CHAR (PIN 8)  CLRWRQ .EQU 11 ; HIGH ==> RESET WRQ  CLRRRQ .EQU 12 ; HIGH ==> RESET RRQ  CLRNSF .EQU 13 ; HIGH ==> RESET NSF  INTRPT .EQU 14 ; HIGH ==> ENABLE INTERRUPTS  DIAGNS .EQU 15 ; HIGH ==> DIAGNOSTIC MODE  .ENDC  ;  ;FOR THE 911 VIDEO TERMINAL BOARD*  ;  ;INPUT*  ;FOR WORD SELECT = 0*  ; THE VALUE OF 'SYSOFF'. ;THE FOLLOWING EQUATES ALLOW TAILORING ;OF THE ACTUAL LOCATIONS OF THESE PARAMETERS. ;  SYSOFF .EQU 52H  SBREAK .EQU 3  SFLUSH .EQU 0  SSTOP .EQU 2  SCAPS .EQU 9200H ; SCAPS IS NOT A SOFT CHARACTER ;THUS, A REFERENCE TO SSTOP IS: ; MOV SSTOP(R7),R2 ;WHERE R7 CONTAINS THE SUM OF 'SYSOFF' AND THE 'SYSCM' ;ADDRESS PASSED TO THE CONSOLEINIT ROUTINE  *.IF ~IV_0   *.MACRO TILINE *XOP %1,6 *.ENDM (  ;BITS 0-6 ARE CHARACTER READ FROM CRT MEMORY*  ;BIT 7 IS THE INTENSITY BIT* ;BITS 8-E ARE THE 7 LSB'S OF THE KEYBOARD DATA* KBDRDY .EQU 000FH ;FOR WORD SELECT = 1* ; ;BITS 0-A ARE THE CURRENT CURSOR ADDRESS*  KBDMSB .EQU 000BH ; HIGH-ORDER BIT OF KEYED DATA  CRTRDY .EQU 000CH ; 0 IF TERMINAL CONNECTED AND ON  PRESEL .EQU 000DH ; STATE OF PRIOR SELECT WORD  KBDERR .EQU 000EH ; 1 IF PARITY ERROR FROM KEYBOARD  ;BIT 000FH IS KBDRDY FOR WRDSEL = 0*      ENTERIC .EQU -2 ; JTAB INDEX OF ENTRY OFFSET  EXITIC .EQU -4 ; " " " EXIT POINT  PARMSZ .EQU -6 ; " " " # WORDS OF PARAM TO COPY AT ENTRY  DATASZ .EQU -8 ; " " " # WORDS TO OPEN IN STACK  ;  ;  ; MSCW (MARK STACK CONTROL WORD) FORMAT  ; THESE OFFSETS ARE RELATIVE TO THE STATIC LINK WORD  ;  MSSTAT .EQU 0 ; STATIC LINK:PTS TO LEX PARENT'S STATIC LINK WORD  MSDYN .EQU 2 ; DYNAMIC LINO^„s„sK:PTS TO CALLER'S STATIC LINK WORD  MSJTAB .EQU 4 ; ABSOLUTE MEMORY ADDRESS OF CALLER'S JTAB  MSSEG .EQU 6 ; " " " OF SEGTABLE OF CALLER  MSIPC .EQU 8 ; " " " OF NEXT OPCODE IN CALLER  MSSP .EQU 10 ; VALUE TO RESTORE SP TO UPON EXIT  MSBASE .EQU -2 ; BASE REG (ONLY IN BASE MSCW'S)  UBREAK .EQU 8  *.ELSE  UBREAK .EQU 8  *.MACRO TILINE *XOP %1,7 *.ENDM ‚*.ENDC  * *.IF USERU  ;  ; THE FOLLOWING THREE MACROS ARE SPECIAL-PURPOSE FOR USER UNITS CODE  ;  ; "NONESUCH" IS A COMMON EXIT WHICH RETURNS CODE 9  ; (UNIT NOT ON LINE) TO THE RSP. "DONEGOOD" IS A COMMON  ; EXIT WHICH RETURNS CODE 0 (ALL OK) TO THE RSP.  ; SINCE RELATIVE JUMPS TO THESE LOCATIONS WILL IN GENERAL  ; GET OUT OF RANGE FOR THE JUMP INSTRUCTION, REGISTERS  ; R8 AND R9 ARE LOADED WITH THE ADDRESSES OF DONEGO;  ;*********************************************************** ;TO FIND THE TRACK AND STARTING SECTOR NUMBER ON THE *  ;FLOPPY WHEN GIVEN THE PASCAL LOGICAL BLOCK NUMBER: *  ; *  ; (BLOCKNO*4)/26 * ; * ; GIVES THE TRACK AS QUOTIENT, AND * ; THE SECTOR-1 AS REMAINDER * ; OD AND  ; NONESUCH, AND TWO MACROS ARE DEFINED TO DO B *R8 AND B *R9  ; *.MACRO AOK *B *R8 *.ENDM *.MACRO NOUNIT *B *R9 *.ENDM  ;  ; THE FOLLOWING MACRO IS USED TO GENERATE A CALL TO  ; THE BIOS TO WRITE TO USER UNIT 129, WHICH UNIT CONTROLS  ; CERTAIN FLAGS AND TOGGLES.  ; *.MACRO SWITCH *LI R2,%1*256+%2 *LI R3,KEYBWS+4 ; GET ADDRESS OF R2 INTO R3 *MOV R3,U129CMCB+6 ; BUFFER ADDRESS FOR USER UNIT CALL  * ;BLOCK 000 IS TRACK 00, SECTORS 01-04 * ;BLOCK 499 IS TRACK 76, SECTORS 21-24 * ; (THE LAST TWO SECTORS ARE NOT USED) * ; *  ; IN PHYSICAL SECTOR MODE (FLAGGED BY BYTES TO MOVE = 0) *  ; THE PARAMETER PASSED AS THE BLOCKNO IS NOT MULTIPLIED *  ; BY 4, AND THE BYTES TO MOVE IS CHANGED TO 128 * *LI R3,U129CMCB *MOV R3,USERWS+22 ; PUT U129CMCB ADDRESS IN R11 OF USERWS *BLWP USERBIOS ; INVOKE THE BIOS VIA BLWP INSTEAD OF XOP *.ENDM *.ENDC  ; *.IF PRINTKEY *.MACRO PRINTIT *MOV %1,PKCMCB+2 ; PUT PARM INTO CMCB CHAR FIELD *LI R7,PKCMCB *MOV R7,USERWS+22 ; PUT ADDRESS OF CMCB IN R11 OF USERWS *BLWP USERBIOS *.ENDM *.ENDC * *.MACRO RT *B *R11 *.ENDM *.MACRO BIOS *XOP %1,5 *.ENDM *.MACRO PUSHWORD  ;***********************************************************  .IF XMEM  XMAP .WORD 0BFFFH *.WORD 0 *.WORD 07FFFH *.WORD 0 *.WORD 0 *.WORD 0 *.ENDC  DREAD BUG "DISK READ" *.IF XMEM *LI R12,1FA0H *SBO 3 *.ENDC *BL SEEKER ; GET TO RIGHT TRACK *MOV PARM2(R10),R7 ; GET # OF BYTES TO MOVE *SRL R7,1 ; CHANGE TO # OF WORDS *MOV PARM3(R10),R8 ; GET BUFFER ADDRESS *SOC R3,R5*DECT SP *MOV %1,*SP *.ENDM *.MACRO DISPLAY *XOP %1,4 *.ENDM *.MACRO BUG *.IF DEBUG  ; JMP $0003  ;0001 .ASCII %1  ; .ALIGN 2  ; .WORD 078EH ; BELL AND ERASE EOS  ;0002 .WORD 0D0AH  ;0003 MOV R1,BUGSAVE  ; LI R1,$0001  ;0004 MOV *R1+,BUGHOLD  ; DISPLAY BUGHOLD  ; SWPB BUGHOLD  ; DISPLAY BUGHOLD  ; SWPB BUGHOLD  ;  ; DEFINE REGISTERS TO BE USED AS THE P-MACHINE PSEUDO-REGISTERS.  ;  BASE .EQU R6 ; POINTER TO PROCEDURE OF LEX LEVEL 0  IPC .EQU R7 ; PROGRAM COUNTER THRU THE P-CODE  JTAB .EQU R8 ; POINTER TO JUMP TABLE OF CURRENT PROC  MP .EQU R9 ; POINTER TO ACTIV. RECORD OF CURRENT PROC  SP .EQU R10 ; STACK POINTER TO TOP OF EXECUTION STACK  ;  MSDLTAP2 .EQU -12 ; -(MSDLTA PLUS 2) = -(SIZE OF MSCW IN BYTES ; C BUGHOLD,$0002  ; JNE $0004  ; MOV BUGSAVE,R1  ; BLWP 0FFFCH *NOP *.ENDC *.ENDM  )  SBLOCK .EQU 2 ; BYTE OFFSET TO SEGTABLE[I].SEG BLOCKNUM(ABSLTE)  SSIZE .EQU 4 ; " " " .SEG CODESIZE  SUNITNO .EQU 0 ; " " " .SEG UNITNUM  SGDBLOCK .EQU 0 ; BYTE OFFSET TO SEGMENT DICT.RELATIVE BLK NUMBER  SGDCODE .EQU 2 ; " " " " .CODESIZE  ;  ;  ; CODE SEGMENT FORMAT  ;  ; JTAB POINTS TO WORD WITH PROC # (LOW BYTE) AND LL (HIGH BYTE)       ; OR UNIT INTO SECTOR *MOV READ,R6 ; GET READ COMMAND MASK *SOC R5,R6 ; OR IN UNIT AND SECTOR *LDCR R6,0 ; SEND COMMAND *LI R12,FBASE1 ; LOOK AT DATA PORT  DR3 TB XFRRDY+16 ; READY? *JEQ DR4 ; YES, GET WORD *TB FCBUSY+16 ; NOT READY, STILL BUSY? *JEQ DR3 ; YES, WAIT  ;  ;IF NOT READY FOR TRANSFER AND NOT BUSY, THEN ERROR  ; *JMP DERROR  DR4 .IF XMEM  FDFAIL *JNE DI2 *LI R1,9 *MOV R1,RETCD(R10) *RTWP  DI2 LDCR RAMLOD,0  DI21 TB XFRRDY *JNE DI21 *LI R12,FBASE1 *LI R1,0200 ; ALLOWS 2-SECOND TIME-OUT ON HEAD LOAD *LDCR R1,0  DIEXIT CLR RETCD(R10) *RTWP  ;  DSTAT BUG "DISK STATUS" *MOV PARM1(R10),R1 ; GET POINTER *CLR R2 *MOV R2,*R1+ ; RETURN BYTES BUFFERED = 0 *LI R2,128 ; BYTES PER SECTOR *STCR R1,0 *LDD XMAP *MOV R1,*R8+ *.ELSE  STCR *R8+,0 ; GET WORD INTO BUFFER *.ENDC *SBO 15 ; ACKNOWLEDGE FETCH *DEC R7 ; MORE COMING? *JGT DR3 ; YES, HURRY & WAIT *LI R12,FBASE2 ; ADDRESS COMMAND PORT *SOC R3,R7 ; R7=0, OR IN UNIT # *SOC STOPB,R7 ; OR IN STOP COMMAND *LDCR R7,0 ; ISSUE COMMAND  DR41 TB FCBUSY *JEQ DR41 *TB *MOV R2,*R1+ *LI R2,26 ; SECTORS PER TRACK *MOV R2,*R1+ *LI R2,77 ; TRACKS PER DISK *MOV R2,*R1 *CLR RETCD(R10) ; SET GOOD RETURN CODE  ; NOW CHECK DRIVE FOR 1) READY AND 2) NOT WRITE-PROTECT IF I/O = WRITING  ; *LI R12,FBASE2 ; COMMAND PORT *MOV PARM4(R10),R3 ; GET DRIVE NUMBER *ANDI R3,0003H ; INSURE IN RANGE 0..3 *SLA R3,10 ; SHIFT TO RIGHT SPOT *LDCR R3,0 ; SEND TO CONTROLL OPCOMP *JEQ DREXIT *JMP DERROR  DREXIT CLR RETCD(R10) *.IF XMEM *; reset memory map *LI R7,0 *MOV R7,XMAP+2 *MOV R7,XMAP+6 *MOV R7,XMAP+10 *.ENDC *RTWP  SEEKER MOV PARM1(R10),R5 ; GET PASCAL BLOCKNO *MOV PARM2(R10),R4 ; IS BYTES TO MOVE = 0? *CI R4,0 *JNE $1 ; NO, CONTINUE *LI R4,128 *MOV R4,PARM2(R10) *JMP $2  $1 SLA R5,2 ; MULTIPLY BY 4 ER (SELECT DRIVE COMMAND)  $1 TB FCBUSY ; WAIT *JEQ $1 *TB DNR *JEQ DSBAD *MOV PARM5(R10),R2 ; GET CONTROL WORD *ANDI R2,1 ; MASK ALL BUT LAST BIT *JEQ $2 *JMP DSEXIT ; IF ZERO, CHECK FOR WRITE PROTECT  $2 TB DWP *JEQ DSBAD *JMP DSEXIT  DSBAD LI R2,9 *MOV R2,RETCD(R10)  DSEXIT RTWP  ;  ; END OF DISK CODE  ;   $2 CLR R4 ; DIVIDEND IN DOUBLE REG R4-R5 *LI R3,26 ; LOAD DIVISOR *DIV R3,R4 ; DO DIVISION, QUOTIENT IN R4 *INC R5 ; INCREMENT REMAINDER  ;TRACK I N R4, SE CTOR IN R5* *MOV PARM4(R10),R3 ; PICK UP DRIVE NO *CI R3,3 ; CANNOT HANDLE MORE THAN 4 DRIVES *JGT DERROR *SLA R3,10 ; SHIFT TO NEEDED SPOT *ANDI R3,0C00H ; ZERO ALL OTHER BITS {9/30 0A00->0C00 JEE} *SOC R3O^„²„²,R4 ; OR INTO TRACK *MOV SEEK,R6 ; GET SEEK MASK *SOC R4,R6 ; FILL IN DRIVE & TRACK *LI R12,FBASE2 ; SET UP FOR COMMAND PORT *LDCR R6,0 ; ISSUE SEEK COMMAND*  SR1 TB FCBUSY *JEQ SR1 *TB OPCOMP *JEQ SR2  DERROR LI R2,9 *MOV R2,RETCD(R10) *.IF XMEM *; reset map *LI R7,0 *MOV R7,XMAP+2 *MOV R7,XMAP+6 *MOV R7,XMAP+10 *.ENDC *RTWP  SR2 B *R11 €BU DWRITE BUG "DISK WRITE" *.IF XMEM *MOV PARM5(R10),R7 *SRL R7,2 *MOV R7,XMAP+2 *MOV R7,XMAP+6 *MOV R7,XMAP+10 *LI R12,1FA0H *SBO 3 *.ENDC *BL SEEKER  ;ON TRACK-- GET BUFFER, LENGTH, SECTOR* *MOV PARM2(R10),R7 ; BYTES TO MOVE *SRL R7,1 ; WORDS TO MOVE {10/7/78 '2'->'1' JEE} *MOV PARM3(R10),R8 ; BUFFER START *SOC R3,R5 ; OR UNIT WITH SECTOR *MOV WRITE,R6 ; GET COMMAND MA ;  ; *.IF MAPPING  REMAP .WORD MAPWS,MAPEP  MAPEP LIMI 0 *ORI R15,00080H *RTWP *.ENDC  CLCKEP *.IF MAPPING *BLWP REMAP *.ENDC *INC R1 ; INCREMENT LO CLOCK WORD *JNE $1 ; IF = 0, MUST HAVE ROLLED OVER- INC HI WORD *INC R0  $1 CI R1,03400H ; COULD IT BE MIDNIGHT AGAIN? *JNE $2 ; NO, EXIT *CI R0,0009EH ; IS IT REALLY MIDNIGHT? *JNE $2 ; NO, EXISK *SOC R5,R6 ; OR IN DRIVE & SECTOR *LDCR R6,0 ; ISSUE COMMAND *LI R12,FBASE1 ; LOOK AT DATA PORT  DW3 TB XFRRDY+16 *JEQ DW4 *TB FCBUSY+16 *JEQ DW3 *JMP DERROR  DW4 .IF XMEM *LDS XMAP *MOV *R8+,R1 *LDCR R1,0 *.ELSE  LDCR *R8+,0 ; WRITE WORD FROM BUFFER *.ENDC *DEC R7 ; MORE IN BUFFER? *JGT DW3 ; GO WAIT SOME MORE T *CLR R0 ; IT IS MIDNIGHT! CLEAR CLOCK TO ZERO *CLR R1 ; NOTE- 86,400 SECONDS/DAY * 120 = 009E3400H *INC R3 ; INCREMENT JULIAN DATE  $2 CKOF *CKON ; (OFF & ON SEQUENCE CLEARS INTERRUPT) *RTWP  S1 .WORD 0  S2 .WORD 0  S3 .WORD 0  ;  ;ENTRY POINT FOR THE KEYBOARD INTERRUPT SERVICE*  ;  KEYBEP *.IF MAPPING *BLWP REMAP ; MAP FOR 990/10 *.ENDC  DW41 TB XFRRDY+16 ; **WAIT FOR LAST WORD!!! *JNE DW41 *LI R12,FBASE2 ; TO COMMAND PORT *SOC R3,R7 ; R7=0, OR IN DRIVE # *SOC STOPB ,R7 *LDCR R7,0 ; TELL FDC TO STOP  DW42 TB FCBUSY *JEQ DW42 *TB OPCOMP *JEQ DWEXIT *JMP DERROR  DWEXIT CLR RETCD(R10) *RTWP  DCTRL BUG "DISK CLEAR" *LI R12,FBASE2 *LDCR RESET,0  DI1 TB FCBUSY *JEQ DI1 *TB      ; CHECK FLAG FOR ORIGINAL WRDSEL *JNE $4 *SBZ WRDSEL ; RESTORE PRIOR VALUE OF WRDSEL  $4 RTWP ; AND QUIT THE KEYBOARD ROUTINE  PKYXIT ; CONTINUE KEY TESTING *.ENDC * *.IF USERU *CI R2,9500H ; IS IT F4? (PRINTER SWITCH) *JNE $2 ; NO, GO ON *SWITCH "P","I" *B KBEXIT ; AND QUIT  $2 CI R2,9600H ; IS IT F5? (VIDEO ENABLE) *SBZ WRDSEL-8 ; RESTORE PRIOR VALUE OF WRDSEL  ;THE CHARACTER IS IN THE MSB OF R2*  ;CHECK TO SEE IF CONSOLEINIT HAS BEEN CALLED*  KBI3 C INITX,TRUEB *JNE KBEXIT *MOV SYSCM,R7 ; GET POINTER *CB SBREAK(R7),R2 *JNE KBI4 ; IF NOT BREAK KEY, GO ON *CLR FLUSHX *CLR STOPX *CLR FKEYS ; RE-ENABLE THE NORMAL FUNCTIONS *MOV BRKPC,R11 ; (BREAK IS TO LABEL 'BBBREAK' ABOVE) *B *R11 ; NEV*JNE $3 ; NO, GO ON *SWITCH "V","I" *B KBEXIT ; AND QUIT  $3 CI R2,9900H ; IS IT F8? (GRAPHICS) *JNE $4 ; NO, GO ON *SWITCH "G","I" *B KBEXIT ; AND QUIT  $4 CI R2,9C00H ; IS IT THE BLANK ORANGE KEY (PANIC) *JNE $5 *SWITCH "H","T" *B KBEXIT  $5 CI R2,9700H ; IS IT F6? (QUEUE SWITCH) *JNE $6 ; NO, GO ON *SWITCH "Q","T" *B ER TO RETURN*  KBI4 C FKEYS,TRUEB ; SHOULD FUNCTION KEYS BE STORED? *JNE $1 *B KBI7  $1 CB SFLUSH(R7),R2 ; CHECK FOR FLUSH KEY *JNE KBI5 ; IF NOT, GO ON *INV FLUSHX ; TOGGLE FLAG *CLR STOPX ; INSURE NOT STOPPED *JMP KBEXIT  KBI5 CB SSTOP(R7),R2 ; CHECK FOR STOP KEY *JNE KBI6 ; IF NOT, GO ON *INV STOPX ; TOGGLE FLAG *JMP KBEXIT  KBEXIT ; AND QUIT  $6 JMP KBI7 *.ENDC  ;  ;ALL OTHER CHARACTERS WILL BE PUT IN QUEUE, IF NOT QFULL*  ;THE CODE TO PUT A CHARACTER IN THE QUEUE IS CALLED BY  ;A BRANCH AND LINK INSTRUCTION-- COULD BE USED FROM OTHER CODE  ;  KBI7 BL STUFFIT *B KBEXIT  ;  STUFFIT C CAPSX,TRUEB ; ALL CAPS DESIRED? *JNE KBI8 ; NO, CONTINUE *CI R2,6100H *JL KBI8 ; LOWER THAN LOWER CASE 'A' *CI R2,7A00H  KBI6 CI R2,SCAPS ; CHECK IF ALL CAPS KEY *JNE KBI6A ; IF NOT, GO ON *INV CAPSX ; TOGGLE FLAG *B KBEXIT  KBI6A *.IF PRINTKEY *CI R2,9F00H ; IS IT TOP-OF-FORM KEY? *JNE $0 ; NO, CONTINUE *.IF PARPTR *LI R12,KBASE1 *SBZ WRDSEL *SBZ INTENB ; MUST DISABLE KEYBOARD INTERRUPTS *LI R12,KBASE2 *SBZ WRDSEL *SBZ INTENB *.ENDC *LI R2,0C00H ; SEND*JH KBI8 ; HIGHER THAN LOWER CASE 'Z' *ANDI R2,0DFFFH ; CONVERT TO UPPER CASE  KBI8 C QFULL,TRUEB ; IS THE QUEUE FULL? *JNE KBI9 ; NO, CONTINUE *SBO WRDSEL-8 *SBO BEEPER-8 ; SOUND BELL *MOV R6,R6 *JNE STEXIT *SBZ WRDSEL-8 ; RESTORE PRIOR STATE OF WRDSEL *JMP STEXIT  ;  ;*************************************************************  ; NOTES ON KEYBOARD QUEUE  FORM-FEED TO PRINTER *PRINTIT R2 *JMP $3 ; AND QUIT  $0 CI R2,9A00H ; IS IT THE PRINT-SCREEN KEY? *JNE PKYXIT ; NO, QUIT THIS AND CONTINUE TESTS *.IF PARPTR *LI R12,KBASE1 *SBZ WRDSEL *SBZ INTENB ; MUST DISABLE KEYBOARD INTERRUPTS *LI R12,KBASE2 *SBZ WRDSEL *SBZ INTENB *.ENDC *MOV CONSOL,R12 ; RESTORE CURRENT CONSOLE BASE *SBO WRDSEL ; GET TO ADDRESS SIDE  *  ;THE KEYBOARD QUEUE IS CIRCULAR IN NATURE. THIS IS DONE *  ;BY KEEPING INDEX POINTERS IN R8 AND R9 WHICH ALWAYS RANGE *  ;FROM 0 TO 255 AND BACK TO 0. THIS OFFSET IS USED *  ;TO INDEX INTO THE BUFFER FROM ITS STARTING ADDRESS. *  ;THE OFFSET FOR DRAINING THE QUEUE IS KEPT IN R9, & POINTS *  ;AT THE CHARACTER TO BE TAKEN. THE INPUT OFFSET IS KEPT IN *  ;R8, AND POINTS TO THE NEXT EMPTY SPOT FOR INPUT. * *STCR R3,11 ; SAVE THE CURRENT CURSOR ADDRESS *CLR R0 ; SET ADDRESS 0 *LDCR R0,11 ; ON THE VIDEO RAM *CLR R2 ; R2 HOLDS THE CHARACTER TO BE PRINTED *LI R4,0D00H ; R4 HAS CARRIAGE RETURN *LI R5,0A00H ; R5 HAS LINE FEED *SBZ WRDSEL ; MOVE TO DATA SIDE *LI R0,24 ; COUNT OF LINES TO PRINT  $1 LI R1,80 ; COUNT OF CHARS/LINE  $2 STCR R2,8 ; ;WHEN THE OUTPUT OFFSET IS INCREMENTED AFTER TAKING A *  ;CHARACTER, AND BECOMES EQUAL TO THE INPUT OFFSET, *  ;THE QUEUE IS EMPTY. WHEN THE INPUT OFFSET IS INCREMENTED *  ;AFTER STORING A CHARACTER, AND BECOMES EQUAL TO THE OUTPUT *  ;OFFSET, THE QUEUE IS FULL. *  ;*************************************************************  KBI9 CI R2,8300H ; CHECK FOR 911 TAB KEY *JNE $001 *LI R2,0900H ; CHANGE TO NORMA GET A CHARACTER FROM SCREEN *ANDI R2,7FFFH ; ZERO THE TOP BIT (LOW INTENSITY) *CI R2,1F00H ; DON'T SEND GRAPHICS *JGT $21 *LI R2,2000H ; SUBSTITUTE A SPACE  $21 PRINTIT R2 ; SEND TO PRINTER *SBZ CURMOV ; INCREMENT CURSOR ADDRESS *DEC R1 ; DEC CHAR/LINE COUNTER *JNE $2 ; REPEAT FOR ENTIRE LINE *PRINTIT R4 ; SEND CARRAIGE RETURN *PRINTIT R5 ; SEND LINE FEED *LI R12,KBASE1 *MOV R12,CONSOL ; SAVE AS CURRENT CONSOLE *TB KBDRDY *JEQ CHRPRS *LI R12,KBASE2 ; TRY OTHER VDT *MOV R12,CONSOL ; SAVE AS CURRENT CONSOLE *TB KBDRDY *JEQ CHRPRS  KBEXIT RTWP  ;  ;CALL EXECERROR WITH 'PROGRAM INTERRUPTED BY USER'  ;  BBBREAK LI R1,UBREAK *.IF ~IV_0 *XOP R1,8 *.ELSE *MOV R1,XEQERR *LI R2,TRAPSNAP *MOV R2,INTPWS+24 ; PUT ADDRESS OF TRAP IN INTP'S R12 **DEC R0 ; DEC LINES COUNTER *JNE $1 ; REPEAT FOR ENTIRE SCREEN *SBO WRDSEL ; GO BACK TO CURSOR ADDRESS SIDE *LDCR R3,11 ; RESTORE ORIGINAL CURSOR ADDRESS  $3 .IF PARPTR *LI R12,KBASE1 *SBZ WRDSEL *SBO INTENB *LI R12,KBASE2 *SBZ WRDSEL *SBO INTENB ; RE-ENABLE CONSOLE INTERRUPTS *MOV CONSOL,R12 ; RE-ESTABLISH CURRENT CRU BASE *.ENDC  MOV R6,R6 .ENDC *RTWP  ;  ;  CHRPRS SBO WRDSEL *AI R12,16 ; INCREASE CRU BASE BY 8 BITS *CLR R6 *TB PRESEL-8 *JNE KBI1 *SETO R6 ; SET FLAG IN R6 IF PRIOR WRDSEL=1  KBI1 SBZ WRDSEL-8 *CLR R2 *STCR R2,7 ; GET 7 LSB'S *SBO WRDSEL-8 *TB KBDMSB-8 ; CHECK MSB *JNE KBI2 *ORI R2,8000H ; SET MSB IN R2  KBI2 SBO KBDACK-8 *MOV R6,R6 *JNE KBI3      L ASCII TAB *JMP $004  $001 CI R2,8500H ; CHECK FOR 911 SKIP KEY *JNE $002 *LI R2,0900H ; CHANGE TO NORMAL ASCII TAB *JMP $004  $002 CI R2,8800H ; CHECK FOR 911 BACK ARROW *JNE $004 *LI R2,0800H ; CHANGE TO ASCII BACKSPACE  $004 ; APPLY CHARACTER MASK  MOVB CHRMASK,R3 ; get character mask *INV R3 ; complement it *SZC R3,R2 ; apply to character CII " Press RUN button to attempt recovery" *.BYTE 07H,00H ; BELL AND END OF MESSAGE *.ALIGN 2   *MOVB R2,KEYQUE(R8) ; PUT IN QUEUE *; LET INTERPRETER KNOW ABOUT EVENT *LI R3,EKYSRDY ; r3 := keysready event # *MOV R3,CAUSEWS+18 ; cause(r9) := keysready event # *BLWP @CAUSE ; cause the event *MOV FALSEB,QMT ; MAKE NOT EMPTY *INC R8 ; ADVANCE POINTER *ANDI R8,00FFH ; FORCE TO COUNT IN CIRCLES *C R8,R9 ; IS QUEUE FULL? *JNE $005 ; NO, CONTINUE *SETO QFULL ; ELSE, SHOW FULL 3 4 1 2 5 *•†v E@@@@@@O”ä L0.*JMP STEXIT  $005 CLR QFULL ; MAKE QFULL FALSE  STEXIT B *R11  ;  ;END OF KEYBOARD INTERRUPT CODING*  ;  SELIEP *.IF MAPPING *BLWP REMAP ; MAP FOR 990/10 *.ENDC *LI R12,RBASE *.IF S9902 *TB 21 ; IS IT A READ REQUEST INTERRUPT ? *JEQ SECHRPR ; YES, GO PROCESS CHARACTER  SEEXIT SBO 18 ; LEAVE INTERRUPTS ENABLED ON RECEIVER *SBZ 19 *SBZ 20 €"R*SBZ 21 ; CLEAR ALL OTHER POSSIBLE INTERRUPTS *.ELSE *TB SERINT ; IS THIS FROM SERIAL BOARD?? *JNE SEEXIT ; NO, IGNORE *TB RRQ ; IS IT A READ REQUEST INTERRUPT?? *JEQ SECHRPR ; YES, PROCESS CHARACTER  SEEXIT TB WRQ ; IS A WRITE COMPLETE ALSO ACTIVE? *JNE $1 ; NO, IGNORE *SETO SDONEX ; MUST BE WRITE COMPLETE  $1 SBO CLRRRQ *SBO CLRWRQ ; CLEAR  ;  ; FOR 990/10, 990/4, AND 990/5 HALF-SIZE SERIAL I/O CARDS  ; AND FOR TMS9902 SERIAL PORTS ON 990/5 CARD  ; ALSO HANDLES NEC/DIABLO WITH 24-BIT PARALLEL CARD  ;  PREAD *.IF USERU *C ALTPRNT,TRUEB *JEQ ALTPREAD *.ENDC  PRIPREAD *LI R1,9 *MOV R1,RETCD(R10) *RTWP *.IF USERU  ALTPREAD *LI R1,9 *MOV R1,RETCD(R10) *RTWP *.ENDC  PWRITE *.IF USERU *C ALTPRNT,TRUEB *JEQ ALTPWRITE *.ENDC  PRIPWRITE *.IF <&<~USERU>> ; IMPLIES ONLY 1 PRINTER *B WPWRITE * *.ELSE * *C FLUSHX,TRUEB ; FLUSHING? *JNE $1 ; NO, CHECK PRINTER THERE *CLR RETCD(R10) ; YES, TELL RSP *RTWP  $1 C PRNTX,TRUEB ; PRINTER? *JEQ $2 ; YES, CONTINUE  ; NO, REPORT ALL OK TO RSP *RTWP  $2 LI R12,PBASE ; SET CRU BASE * *.IF S9902 *TB 27 ; CHECK READY (AND NOT BUSY)  ;KEYBOARD QUEUE. *  ;*************************************************************  ;  SEI9 MOVB R2,REMQUE(R8) ; PUT IN QUEUE *CLR RQMT ; MAKE NOT EMPTY *INC R8 ; ADVANCE POINTER *ANDI R8,00FFH ; FORCE TO COUNT IN CIRCLES *C R8,R9 ; IS QUEUE FULL? *JNE $1 ; NO, CONTINUE *SETO RQFULL ; ELSE, SHOW FULL *JMP SEEXIT  $1 CLR RQFULL *JNE $2 ; PIN 6 ON EIA INTERFACE  $20 TB 28 *JNE $20 ; PIN 5 ON EIA INTERFACE  $21 TB 22 ; XMIT BUFFER EMPTY *JNE $21  $22 TB 27 ; CHECK READY (AND NOT BUSY) *JNE $22 ; PIN 6 ON EIA INTERFACE *TB 28 ; CHECK PIN 5 AGAIN *JNE $22 ; AND WAIT *LI R11,800  $23 DEC R11 *JNE $23 *LDCR PARM1(R10),8 ; SEND CHAR TO INT ; MAKE QFULL FALSE *JMP SEEXIT  ;  ;END OF REMOTE LINE INTERRUPT CODING*  ;  ; MACHINE CHECK INTERRUPT CODE  ; (ENTRY FOR LEVEL 0, 1, AND 2 INTERRUPTS)  CHEKEP *LI R12,1FA0H ; FRONT PANEL *SBO 4 ; CLEAR THE CHECK INTERRUPT BIT *CLR R2 ; INSURE RHS = 0  $0 LI R1,MCMSG ; TRY TO PUT MESSAGE ON CONSOLE  $1 MOVB *R1+,R2 *JEQ CHK1 ; NULL BYTE = END OF MESSAGE *DISPLAY R2 ERFACE * *.ELSE * *TB DSR ; CHECK READY *JNE $2 *LDCR PARM1(R10),8 ; SEND CHAR TO INTERFACE  $3 TB WRQ ; WAIT UNTIL SENT *JNE $3 *SBO CLRWRQ ; CLEAR WRITE REQUEST * *.ENDC * *CLR RETCD(R10) *RTWP *.ENDC ; END CONDITION FOR "IF <&<~USERU>>" * *.IF USERU  ALTPWRITE *.ENDC * *.IF PARPTR  WPWRITE  ;  ; THIS ENTRY POINT PRINTS THE CHARACTER PASSED  ; *.IF PRINTKEY *JMP $1  CHK1 *.IF MAPPING ; MUST UNMAP TO GET TO FRONT PANEL ROMS *BLWP UNMAP *JMP FRONTPAN  UNMAP .WORD MAPWS,UNMAP+4 *ANDI R15,0FF7FH ; GO BACK TO MAP 0 *RTWP *.ENDC  FRONTPAN *BLWP 0FFFCH ; GO TO FRONT PANEL *NOP *.IF MAPPING *BLWP REMAP *.ENDC *RTWP ; AND HOPE FOR THE BEST  MCMSG .WORD 0D0DH ; CARRIAGE RETURN TWICE- NO LINE FEED *.ASCII "** M A C H I N E C H E C K **" *.AS     OUT *B CLOSED ; CLOSE THE PRINTER ON ERROR  ;  ; MOVE THE PAPER R0 1/48"  ;  PAPMOV *LDCR R0,0 *LI R0,4096 ; TIME OUT ON PAPER MOVE  $1 TB PFRDY *JEQ $2 *IDLE *DEC R0 *JNE $1 *JMP TIMOUT  $2 SBO PFSTB *SBZ PFSTB *B *R11  ; *.ENDC ; THAT IS, IF NOT PARPTR C; THEN PUT IT ON THE CONSOLE *.IF USERU ; (IF NOT USERU, NO CODE NEEDED) *CLR R2 *BL MOVCAR ; MOVE THE CARRIAGE BACK TO HOME *CLR DIRECT ; MAKE DIRECTION RIGHT *CLR HORPOS ; ZERO ACCUMULATED MOTION *JMP WPEXIT  ;  ; TEST FOR LINE FEED  ;  $3 *CI R1,10 *JNE $6 *MOV LINES,R0 ; GET VERTICAL LINE COUNT *INC R0 *CI R0,66 ; TEST IT FOR PAGE OVERFLOW *JLE $4 ; NO OVERFLOW, SAVE LINE COUNT *CLR R0 ; CLEAR LINE COUNTER FOR MOD 66  $4 *MOV R0*MOVB PARM1(R10),R2 *DISPLAY R2 *CLR RETCD(R10) *RTWP *.ENDC  PCTRL *.IF USERU *C ALTPRNT,TRUEB *JEQ ALTPCTRL *.ENDC  PRIPCTRL *.IF <&<~USERU>> *B WPCTRL *.ELSE * *LI R12,PBASE ; SET CRU BASE * *.IF S9902 *C PINITX,TRUEB ; HAS PRINTER BEEN INITIALIZED AT BOOT? *JEQ $5 ; IF SO, SKIP A LOT  ;  ;JUST AFTER THE BOOT, IN BIOSINIT CODE, THE PRINTER IS UNITCLEARED FIRST,  ; THEN THE REMOTE. ,LINES ; SAVE THE UPDATED LINE COUNT *LI R0,8 ; 8/48" FOR ONE LINE VERTICAL  $5 *BL PAPMOV ; MOVE THE PAPER *JMP WPEXIT  ;  ; TEST FOR FORM FEED  ;  $6 *CI R1,12 *JNE WPEXIT ; IGNORE ANY OTHER CONTROL CHARACTERS *LI R0,66 ; MOVE TO THE TOP OF THE NEXT PAGE *S LINES,R0 *SLA R0,3 ; IN INCREMENTS OF 1/6" *CLR LINES *JMP $5  ; ALL THREE 9902 CHIPS ARE THUS RESET HERE, AND THE  ; EIA DRIVERS ENABLED.  ; *SBO 31 ; RESET 9902 CHIP AT P4 *LI R12,RBASE *SBO 31 ; INITIALIZE CHIP AT P5 *AI R12,64 ; AND AT P6 *SBO 31 *LI R12,17C8H ; MAGIC NUMBER *SBZ 0 *SBO 1 ; ALLOW INTERRUPTS FROM P5 *SBZ 2 ; NO INTERRUPTS FROM P4,P6 *SBO 3 ; ALLOW COMMUNICATIONS  ; THE CHARACTER IS ASCII, MOVE THE CARRIAGE, THEN PRINT  ;  ASCII *LI R7,12 ; MOVE 12/120" for 10-PITCH *BL MOVCAR *TB PWRDY ; SEE IF THE PRINT WHEEL IS READY *JEQ $2 *LI R0,256 ; IT WASN'T, WAIT UP TO 160MS FOR IT  $1 IDLE *TB PWRDY *JEQ $2 ; IT IS READY, FIRE THE HAMMER *DEC R0 *JNE $1 *B CLOSED ; TIMED OUT, CLOSE THE PRINTER  $2 *LDCR R1,0 *SBO PWSTB *SBZ*LI R12,PBASE ; BACK TO 9902 CHIP AT P4 *LI R1,0AA00H ; SET 7BITS+EVEN PARITY+1 STOP+4MHZ *LDCR R1,8 *SBZ 13 ; NO USES FOR TIMER *LI R1,0034H ; 9600 BAUD *LDCR R1,12 *SBO 16 ; TURN ON RTS *SBZ 18 ; NO-INTERRUPT MODE *SBZ 19 ; NO-INTERRUPT MODE *SBZ 20 ; NO-INTERRUPT MODE *SBZ 21 ; NO-INTERRUPT MODE *LI R2,1100H ; DC-1 CHARACTER SE PWSTB  WPEXIT *CLR RETCD(R10) *RTWP  ;  ; TEST THE PRINTER FOR READY. LOOP ON PAPER OR RIBBON OUT  ;  PTRDY *TB RIBBON *JNE $3 *IDLE *JMP PTRDY  ;  ; THE RIBBON ISN'T OUT, CHECK PAPER  ;  $3 TB PAPOUT *JNE $4 *IDLE *JMP $3  ;  ; PAPER AND RIBBON ARE OK, SEE IF IT IS READY  ;  $4 *LI R0,4000 ; UP TO 32 SEC FOR CHECK  $5 TB CHECK *JNE $6 *IDLE *TB CHECK *JNE $6 LECTS PRINTER *LDCR R2,8 ; SEND IT OUT *LI R5,2000 ; DELAY FOR PRINTHEAD RETURN  $0 DEC R5 *JNE $0  ;SEND 3 BLANKS AND 3 RETURNS TO PRINTER  ; (THERE IS A BUG IN THE 810 PRINTER FIRMWARE  ; WHICH CAUSES IT TO LOSE THE SECOND CHARACTER  ; SENT AFTER A DC-1 SELECTION)  ; *LI R5,3 *LI R2,2000H  $01 CLR R0  $1 TB 22 *JEQ $11 *DEC R0 *JNE $1  $11 LDCR R2,8 *DEC R5 *DEC R0 *JNE $5 *B CLOSED  $6 TB READY *JEQ $7 *IDLE *TB READY *JEQ $7 *DEC R0 *JNE $6 *B CLOSED  $7 B *R11  ;  ; MOVE THE CARRIAGE, BUT NOT BEYOND 132 CHARACTERS  ; AND NO MORE THAN 1023 1/120" IN ONE MOVE  ;  MOVCAR *CI R7,1023 ; MAKE SURE THE MOVE ISN'T TOO LONG *JLE $1 *AI R7,-1023 ; GET DISTANCE-1023 *MOV R7,R6 ; SAVE IT FOR FINAL MOVE *LI *JNE $01 *LI R5,3 *LI R2,0D00H  $02 CLR R0  $2 TB 22 *JEQ $21 *DEC R0 *JNE $2  $21 LDCR R2,8 *DEC R5 *JNE $02 *SETO PINITX ; MARK PRINTER INITIALIZED ONCE  $5 CLR RETCD(R10) ; SET UP FOR GOOD RETURN *SETO PRNTX *TB 27 ; IS THE PRINTER ON-LINE? *JEQ PIEXIT ; YES, EXIT *CLR PRNTX ; NO, MAKE A NOTE *  .ELSE * *SB R7,1023 *MOV R11,R9 ; SAVE RETURN FROM RECURSIVE CALL *BL MOVCAR *MOV R6,R7 *MOV R9,R11 ; RECOVER RETURN ADDRESS  $1 MOV R7,R0 ; AND REMAINING MOTION *SRL R0,1 ; SEE IF THERE'S ANY ODD MOTION *LDCR R0,0 *JNC $2 *SBO HALFSP ; SET UP ODD MOTION  $2 MOV DIRECT,R0 *JEQ $3 *NEG R7 *SBO WAY  $3 LI R0,4096  $4 TB CARRDY *LIMI 5 ; THIS COULD BE DANGEROUS-- BUT NECESSARY *.ENDC * *LI R12,WPCRU *MOV WPOPEN,R0 *JNE $1 ; THE PRINTER ISN'T OPEN, DON'T TRY *BL PTRDY ; MAKE SURE IT IS READY *MOV PARM1(R10),R1 ; GET THE CHARACTER TO PRINT *SRL R1,8 ; RIGHT JUSTIFIED *CI R1,32 ; TEST AGAINST SPACE *JH ASCII ; IT'S BIGGER, PRINT THE CHARACTER *JNE $2 ; IT'S NOT A SPACE, CHECK CONTROL CH*JEQ $5 *IDLE *DEC R0 *JNE $4 *JMP TIMOUT  $5 A HORPOS,R7 *CI R7,1584 *JLE $6  ;  ; MOTION PAST 132 CHARACTERS IS CONVERTED TO CARRIAGE  ; RETURN AND LINE FEED.  ; *SETO DIRECT *MOV HORPOS,R7 *MOV R11,R9 *BL MOVCAR *LI R0,8 *BL PAPMOV ; LINE FEED *CLR DIRECT *INC LINES *B *R9  $6 MOV R7,HORPOS *SBO CARSTB *SBZ CARSTB *B *R11  TIMARACTERS *LI R7,12 ; 12/120" MOVEMENT FOR A SPACE *BL MOVCAR ; MOVE THE CARRIAGE *JMP WPEXIT ; AND EXIT  $1 B WPCTRL  ;  ; THE CHARACTER IS A CONTROL CHARACTER, HANDLE , ,  ; AND THROW EVERYTHING ELSE AWAY.  ;  $2 *CI R1,13 ; CARRIAGE RETURN? *JNE $3 *SETO DIRECT ; MAKE DIRECTION LEFT *MOV HORPOS,R7 ; GET ACCUMULATED HORIZONTAL MOTION      Z INTRPT ; NO-INTERRUPT MODE *SBZ DIAGNS ; NOT DIAGNOSTIC MODE *SBO DTR ; TELL PRINTER WE'RE READY *SBO CLRWRQ ; AND WAITING *SBO RTS *C PINITX,TRUEB ; HAS PRINTER BEEN INITIALIZED AT BOOT? *JEQ $5 ; IF SO, SKIP THE DC-1 SEQUENCE *LI R2,1100H ; DC-1 CHARACTER SELECTS PRINTER *LDCR R2,8 ; SEND IT OUT *LI R5,2000 ; DELAY FOR PRINTHEAD RETURN  $0 DEC R5 CD(R10) ; SET COMPLETION CODE *RTWP  ;  ;  ;  RREAD  ;OBTAIN NEXT CHARACTER FROM THE REMOTE QUEUE.  ;IF QUEUE IS EMPTY, WAIT FOR A CHARACTER *C LINEX,TRUEB ; IS MODEM THERE? *JEQ $0 *CLR PARM1(R10) ; RETURN A NULL *CLR RETCD(R10) ; NO, TELL RSP ALL OK *RTWP  $0 C RQMT,TRUEB ; IS QUEUE EMPTY? *JNE $1 ; NO, GO GET CHAR *IDLE ; IDLE UNTIL INTERRUPT (ANY INTERRUPT) *JNE $0  ;SEND 3 BLANKS AND 3 RETURNS TO PRINTER  ; (THERE IS A BUG IN THE 810 PRINTER FIRMWARE  ; WHICH CAUSES IT TO LOSE THE SECOND CHARACTER  ; SENT AFTER A DC-1 SELECTION)  ;THE TRANSMISSION DELAY IS TIMED WITH A LOOP  ;IN CASE THE PRINTER BOARD IS NOT INSTALLED  ; *LI R5,4  $1 LI R4,500  $2 DEC R4 *JNE $2 *LI R2,2000H *LDCR R2,8 *DEC R5 *JNE $1 *LI R5,4  $3 LI R4,500  $4 DEC R4 *JMP $0 ; CHECK AGAIN  $1 CLR R2 *LIMI 3 ; INHIBIT REMOTE INTERRUPTS *MOV SELIWS+16,R8 ; GET COPY OF IN QPTR *MOV SELIWS+18,R9 ; GET COPY OF OUT QPTR *MOVB REMQUE(R9),R2 ; GET THE CHARACTER *CLR RQFULL ; CLEAR THE "QUEUE FULL" FLAG *INC R9 *ANDI R9,00FFH ; FORCE COUNT TO CIRCULATE *C R8,R9 ; IS QUEUE EMPTY? *JNE $2 ; NO, CONTINUE *SETO RQMT ; YES*JNE $4 *LI R2,0D00H *LDCR R2,8 *DEC R5 *JNE $3 *SETO PINITX ; MARK PRINTER INITIALIZED ONCE  $5 CLR RETCD(R10) ; SET UP FOR GOOD RETURN *SETO PRNTX *TB DSR ; IS THE PRINTER ON-LINE? *JEQ PIEXIT ; YES, EXIT *CLR PRNTX ; NO, MAKE A NOTE   .ENDC *  ; BUT LET RSP THINK THAT THERE IS ONE ANYWAY  PIEXIT RTWP  ; , SET FLAG  $2 MOV R9,SELIWS+18 ; RESTORE POINTER *CLR RETCD(R10) ; ZERO RETURN CODE *MOV PARM5(R10),R5 ; GET CONTROL WORD *SLA R5,2 ; SHIFT OUT BIT 14 *JNC $3 *ANDI R2,7FFFH ; IF BIT 14 SET, CLEAR MSB OF CHAR  $3 MOV R2,PARM1(R10) ; RETURN CHARACTER *RTWP  ;  RWRITE LI R12,RBASE ; SET CRU BASE *C LINEX,TRUEB ; IS MODEM THERE? *JEQ RW1 ; YES, CONTINUE *.ENDC ; END CONDITION FOR "IF <&<~USERU>>" * *.IF USERU  ALTPCTRL *.ENDC * *.IF PARPTR  WPCTRL  ;  ; OPEN THE PRINTER. SELECT IT, WIGGLE RESTORE, WAIT FOR READY  ; *.IF PRINTKEY *LIMI 5 ; THIS COULD BE DANGEROUS-- BUT NECESSARY *.ENDC * *LI R12,WPCRU ; POINT TO THE PRINTER CRU BASE *CLR R0 *LDCR R0,0 ; GUARANTEE THE 16 LSB'S LOW *SBO SELECT ; SELECT THE PRINTER *SBO RESTOR *CLR RETCD(R10) ; NO, TELL RSP ALL OK *RTWP  RW1 CLR RETCD(R10) ; ZERO RETURN CODE *CLR R5  MOVB PARM1(R10),R5 ; GET THE BYTE *MOV PARM5(R10),R2 ; GET CONTROL WORD *SLA R2,2 ; SHIFT BIT 14 OUT *JNC RW2 ; IF BIT 14 SET, GENERATE EVEN PARITY *MOVB R5,R5 ; SET STATUS FOR PARITY *JOP $1 ; JUMP IF NOW ODD PARITY *JMP RW2  $1 ORI R5,8000H ; MAKE EVEN PARITY  ; TAKE RESTORE LOW *SBZ PFSTB ; TURN OFF PAPER FEED STROBE *SBZ PWSTB ; AND PRINT WHEEL STROBE *SBZ CARSTB ; AND CARRIAGE STROBT *SBO LIFT ; LIFT THE RIBBON *LI R0,5 ; SET UP 40MS RESTORE  $1 IDLE *DEC R0 *JNE $1  ;  ; NOW LET RESTORE GO HIGH AND WAIT FOR VITAL SIGNS  ; *LI R0,750 ; GIVE IT UP TO 6 SECONDS *SBZ RESTOR  $2 IDLE *.IF S9902  RW2 TB 22 *JNE RW2  $2 LDCR R5,8 ; SEND BYTE *.ELSE  RW2 CLR SDONEX ; CLEAR TRANSMIT DONE FLAG *LDCR R5,8 ; SEND BYTE  $3 C SDONEX,TRUEB ; THRU TRANSMITTING? *JEQ RWEXIT ; WAIT UNTIL THROUGH *IDLE ; WAIT FOR ANY INTERRUPT *JMP $3 ; LOOK AGAIN *.ENDC  RWEXIT RTWP  RCTRL LI R12,RBASE ; SET CRUBASE *TB READY ; TEST FOR READY *JEQ OPEN *DEC R0 *JNE $2  ;  ; THE PRINTER FAILED TO READY, MARK IT OFF LINE  ;  CLOSED *SETO WPOPEN *SBZ LIFT ; DROP THE RIBBON *LI R0,9 *MOV R0,RETCD(R10) *RTWP  ;  ; THE PRINTER IS READY, MARK IT OPEN AND SET UP FOR FIXED PITCH  ;  OPEN *CLR WPOPEN *CLR DIRECT *CLR HORPOS *MOV WPBOOT,R0 *JEQ $1 *CLR WPBOOT *CLR LINES  $1 CLR RE*LIMI 3 ; DISABLE REMOTE INTERRUPTS *CLR SELIWS+16 ; CLEAR R8 OF SELIWS (IN QPTR) *CLR SELIWS+18 ; CLEAR R9 OF SELIWS (OUT QPTR) *SETO RQMT ; MARK INPUT QUEUE AS EMPTY *CLR RQFULL  *.IF S9902  *C RINITX,TRUEB ; WAS REMOTE INITIALIZED ONCE? *JEQ $1 ; SKIP BAUD RATE STUFF *LI R1,8B00H ; SET 8BITS+NO PARITY+1 STOP+4MHZ *LDCR R1,8 *SBZ 13 ; NO USES FOR TIMER *LI TCD(R10) *RTWP *.ELSE ; IF NOT PARPTR *CLR RETCD(R10) *RTWP *.ENDC ; END OF IF PARPTR  ;  PSTAT *LI R12,PBASE *.IF USERU *C ALTPRNT,TRUEB *JEQ ALTPSTAT *.ENDC  PRIPSTAT *.IF <&<~USERU>> *B WPSTAT *.ELSE *MOV PARM1(R10),R1 ; GET POINTER *CLR *R1+ ; RETURN 0 BYTES BUFFERED (IN OR OUT) *CLR R2 *.IF S9902 *TB 27 *.ELSE *TB DSR *.ENDC  R1,04D0H ; 300 BAUD *LDCR R1,12 *SBO 16 ; TURN ON RTS *SBO 18 ; ALLOW INPUT INTERRUPT MODE *SBZ 19 ; NO-INTERRUPT MODE *SBZ 20 ; NO-INTERRUPT MODE *SBZ 21 ; NO-INTERRUPT MODE *SETO RINITX ; MARK REMOTE INITIALIZED ONCE  $1 CLR RETCD(R10) *SETO LINEX *TB 27 ; IS MODEM THERE? *JEQ RIEXIT ; YES, EXIT *JEQ $1 *INC R2  $1 MOV R2,*R1 ; PUT HARDWARE READY BIT INTO STATUS BUFFER *CLR RETCD(R10) ; SET COMPLETION CODE *RTWP  .ENDC ; END OF "IF <&<~USERU>>"  ; *.IF USERU  ALTPSTAT *.ENDC  .IF PARPTR  WPSTAT *.ENDC ; SAME CODE FOR PARPTR OR SERIAL  MOV PARM1(R10),R1 ; GET POINTER *CLR *R1 ; RETURN 0 BYTES BUFFERED (IN OR OUT) *CLR RET     lling. These are: *  ; *  ; CUTBACK - i/o initialization and Top of Heap Mark *  ; BOOTMSG - optional boot message *  ; *  ; CUTBACK is called to initialize i/o devices. It is also *  ; assummed that Cutback marks the end of The Interpreter *  ; code that needs to remain resident after the tertiary * *MOV SELIWS+18,R9 ; COPY OF OUT QUEUE POINTER *S R9,R8 *JGT $3 *AI R8,255  $3 MOV R8,*R2+ ; RETURN COUNT OF CHARS IN QUEUE *CLR R1 *.IF S9902 *TB 27 *JNE $4 *.ELSE *TB DSR *JNE $4 *.ENDC *INC R1  $4 MOV R1,*R2+  RSEXIT CLR RETCD(R10) *RTWP  ;  ;END OF SERIAL I/O CODE  ;   ; bootstrap. *  ; BOOTMSG is called to display an optional bootmessage. If *  ; no message is desired BOOTMSG may simply return. *  ; Both of these procedures are called with a BL instruction. *  ; To return simply branch indirect through R11. No registers*  ; need be saved. *  ;****************************************************************  ;  ( (  NO .EQU 0  YES .EQU ~NO   IV_0 .EQU YES ; TRUE FOR IV.0 BIOS, FALSE FOR II.1 BIOS  MAPPING .EQU YES ; MUST BE TRUE FOR 990/10 WITH MAPPING >; SHOULD BE FALSE IF MAPPING IS NOT REQUIRED >; ELSE BIOS WILL RUN SLOWER  SLAVE .EQU NO ; FOR DEBUGGING ON 990/5 SLAVE  XMEM .EQU YES ; FOR EXTENDED MEMORY CODE POOL (TILINE BANK 2)  XADRS .EQU XMEM   DEBUG .EQU NO ; APPLIES ONLY TO 990'S WITH FRONT PANEL * O^¤c¤³*.DEF INIT *.REF CUTBACK,DBUG,BOOTMSG *.REF MEMTOPB,SEG_WORD,OPTABLE,EVEC *.REF TEMP,START,DIRSZ,SYSREAD,SYSUNT,SEGDSZ *.REF SYSBLK,SEG,SYSCMB,SAVRTN *.REF TRAPSNAP,CPOFST,CPOOL *.REF SEXOK,NEGONE,SIB,EREC,ONE,ROOTTASK *.REF CHKSEX,NIL,SEGHI,TRUE,ZERO,GBLVEC *  ;  ; *.TITLE "MACROS USED BY TERT BOOT" *.PAGE  ;  ; *.MACRO PUSHWORD *DECT SP *MOV %1,*SP *.ENDM  ;  ; *.MACRO RT *B *R11 *.ENDM  ;  ; *.TITLE "E€SHQUATES AND MACROS" *.PAGE *.INCLUDE G4.EQUS.TEXT *.TITLE "TERTIARY BOOTSTRAP CODE" *.PAGE *.INCLUDE B4.TXINIT.TEXT  ENDINT ; ABSOLUTE END OF INTERPRETER CODE *.END   *.PROC TBOOT990 *.TITLE "TERTIARY BOOTSTRAP FOR TI9900 IV.1 "  ; *.NOASCIILIST *.NOPATCHLIST  .NOMACROLIST  (  ;  ;****************************************************************  ; *  ; TERTIARY BOOTSTRAP SUB-SYSTEM FOR THE UCSD PASCAL SYSTEM *  ; *  ; WRITTEN BY FRITZ WHITTINGTON *  ; ü’O.ˆ¦ˆ¦’’ *  ; TEXAS INSTRUMENTS *  ; *  ; *  ; FOR UCSD PASCAL VERSION I.5 6-SEP-1978 *  ; II.1 21-AUG-1979 *  ; III.0 24-FEB-1980 *  ; IV.0 3-SEP-1980 * *CLR LINEX ; NO, MAKE A NOTE  *.ELSE * *SBZ DIAGNS *SBO DTR *SBO RTS *SBO CLRWRQ *SBO CLRRRQ *SBO CLRNSF *SETO SDONEX *SBO INTRPT *CLR RETCD(R10) *SETO LINEX *TB DSR ; IS MODEM THERE? *JEQ RIEXIT ; YES, EXIT *CLR LINEX ; NO, MAKE A NOTE *.ENDC *  ; BUT LET RSP THINK THAT THERE IS ONE  RIEXIT RTWP  ;  RSTAT LI R12,RBASE *MOV PARM5(R10),R1 ; GET ; IV.1 8-MAR-1981 *  ;****************************************************************  ; *  ; NOTE ON TERTIARY BOOT / BIOS INTERFACE *  ; -------------------------------------- *  ; *  ; The Tertiary Bootstrap Code expects two external entry *  ; points to be available for ca CONTROL WORD *MOV PARM1(R10),R2 ; GET POINTER *ANDI R1,1 ; MASK ALL BUT LSB *JEQ $1 ; IF 0, I/O DIRECTION = OUT (ALWAYS EMPTY) *C RQMT,TRUEB ; IS INPUT QUEUE EMPTY? *JNE $2 ; NOT EMPTY, FIGURE HOW MANY  $1 CLR R8 ; EMPTY, RETURN COUNT = 0 *JMP $3  $2 LIMI 3 ; MASK REMOTE INTERRUPTS *MOV SELIWS+16,R8 ; COPY OF IN QUEUE POINTER      oopopopopopopo     qpqpqpqpqpqqpqp     qrqrqrqrqrrrrrr     srssssssssssrsr     sttttttttttttut     uuuuuuvuvuvuuuu     vvvvvwvwvwvwvwv     xwxwxwxwxwxwwxw     xyxyxyxyxyxyyyy      zyzyzzzzzzzzyzy      z{z{{{{{{{{{{{{!     ||||||||}|}||||!     }}}}}}}~}~}~}~}"     ~~~~~~~~~"     €€€€€€€€#     €€€€€#     ‚‚‚‚‚‚‚‚‚‚‚‚$     ƒƒƒƒƒƒƒƒƒƒ„ƒ‚ƒƒ$     „„„„„„„„„…„…„…„%     ……†…†…†…†…†…………%     †‡†‡†‡†‡†‡†‡†‡†&     ˆ‡ˆ‡ˆ‡ˆ‡ˆˆˆˆ‡ˆ‡&     ˆ‰ˆ‰ˆ‰ˆ‰‰‰‰‰‰‰‰'     ŠŠŠŠŠŠŠŠŠŠŠŠ‰Š‰'     ‹‹‹‹‹‹‹‹‹‹‹Œ‹Œ‹(     ŒŒŒŒŒŒŒŒŒŒŒ(     ŽŽŽŽŽŽ)     ŽŽŽŽŽŽŽ)     *     ‘‘‘‘‘‘‘‘‘‘‘‘*     ‘’’’’’’’’’’’’“’+     ““““““”“”“”““““+     ”””””•”•”•”•”•”,     –•–•–•–•–•–••–•,     –—–—–—–—–—–————-     ˜—˜—˜˜˜˜˜˜˜˜—˜—-     ˜™˜™™™™™™™™™™™™.     šššššššš›š›šššš.     ›››››››œ›œ›œ›œ›/     œœœœœœœœœ/     žžžžžžžž0     ŸžŸžŸžŸŸŸŸŸŸžŸž0     Ÿ Ÿ Ÿ          1     ””””””””””¢” ””1     ¢¢¢¢¢¢¢¢¢£¢£¢£¢2     ££¤£¤£¤£¤£¤££££2     ¤„¤„¤„¤„¤„¤„¤„¤3     ¦„¦„¦„¦„¦¦¦¦„¦„3     ¦§¦§¦§¦§§§§§§§§4     ØØØØØØØØØØØاا4     ©©©©©©©©©©©Ŗ©Ŗ©5     ŖŖŖŖ«Ŗ«Ŗ«Ŗ«ŖŖŖŖ5     «««¬«¬«¬«¬«¬«¬«6     SUM,BUFFPTR,BYTE0,BYTE1,ANSWER:INTEGER; " $FUNCTION PUTBLOCK(VAR ONEBLOCK:BLOCK):BOOLEAN; $BEGIN &PUTBLOCK:=TRUE; &BUFF^[BUFFPTR]:=ONEBLOCK; &BUFFPTR:=BUFFPTR+1; &IF BUFFPTR=BUFFSIZE THEN &BEGIN (PUTBLOCK:=BLOCKWRITE(F,BUFF^,BUFFSIZE)=BUFFSIZE; (BUFFPTR:=0; &END; $END; $ "BEGIN $BUFFPTR:=0; $UNOCNTR:=0; $BADOUTPUT:=FALSE; $REPEAT &ANSWER:=WAIT; &IF ANSWER=NOTLASTBLOCK THEN &BEGIN (UNITREAD(REMIN,INBLOCK,1026,0,12); (CHECKSUM:=0; (FOR BYTENUM:=0 TO 511 DO (BEGIN ¬*BYTE0:=ORD(ODD(15) AND ODD(INBLOCK[BYTENUM+BYTENUM])); *BYTE1:=ORD(ODD(15) AND ODD(INBLOCK[BYTENUM+BYTENUM+1])); *PACKBLOCK[BYTENUM]:=BYTE0*16+BYTE1; *CHECKSUM:=CHECKSUM+BYTE0+BYTE1; (END; (IF CHECKSUM=ORD(ODD(127) AND ODD(INBLOCK[1024]))*128+ +ORD(ODD(127) AND ODD(INBLOCK[1025])) THEN (BEGIN *IF PUTBLOCK(PACKBLOCK) THEN *BEGIN ,UNO('.'); ,SIGNAL(SENDNEXT); *END ELSE *BEGIN ,BADOUTPUT:=TRUE; ,SIGNAL(ABORT); *END; (END ELSE (BEGIN *UNO('?'); *SIGNAL(SENDAGAIN); (END; &END ELSE (IF AN¬SWER=ABORT THEN *BEGIN ,WRITELN; ,WRITE(' ERROR in input file'); *END; $UNTIL ANSWER IN [FINALBLOCK,ABORT]; $BADOUTPUT:=BADOUTPUT OR (BLOCKWRITE(F,BUFF^,BUFFPTR)<>BUFFPTR); $CLOSE(F,LOCK); " IF (IORESULT<>0) OR BADOUTPUT THEN $BEGIN &SIGNAL(ABORT); &WRITELN; &WRITE(' ERROR in output file'); $END ELSE &SIGNAL(FILECLOSED); "END; " "PROCEDURE SENDIT; "VAR ANS,BYTE0,BYTE1,BYTENUM,CHECKSUM,BLOCKSREAD,BUFFPTR:INTEGER; &BADINPUT:BOOLEAN; &UNPACKBLOCK:PACKED ARRAY[0..1023] OF BYTE; ¬&JUSTTWO:TWOBYTES; " $FUNCTION GETBLOCK(VAR ONEBLOCK:BLOCK):BOOLEAN; $BEGIN &BUFFPTR:=BUFFPTR+1; &IF BUFFPTR>=BLOCKSREAD THEN &BEGIN (BLOCKSREAD:=BLOCKREAD(F,BUFF^,BUFFSIZE); (BADINPUT:=IORESULT<>0; (BUFFPTR:=0; &END; &GETBLOCK:=(BLOCKSREAD<>0) AND (NOT BADINPUT); &ONEBLOCK:=BUFF^[BUFFPTR]; $END; $ "BEGIN $BADINPUT:=FALSE; $UNOCNTR:=0; $BUFFPTR:=-1; $BLOCKSREAD:=0; $ANS:=SENDNEXT; $WHILE GETBLOCK(PACKBLOCK) AND (ANS<>ABORT) DO $BEGIN &CHECKSUM:=0; &SIGNAL(NOTLASTBLOCK); &FOR BYTENU¬M:=0 TO 511 DO &BEGIN (BYTE0:=PACKBLOCK[BYTENUM] DIV 16; (UNPACKBLOCK[BYTENUM+BYTENUM]:=BYTE0; (BYTE1:=ORD(ODD(PACKBLOCK[BYTENUM]) AND ODD(15)); (UNPACKBLOCK[BYTENUM+BYTENUM+1]:=BYTE1; (CHECKSUM:=CHECKSUM+BYTE0+BYTE1; &END; &UNITWRITE(REMOUT,UNPACKBLOCK,1024,0,12); &JUSTTWO[0]:=CHECKSUM DIV 128; &JUSTTWO[1]:=ORD(ODD(CHECKSUM) AND ODD(127)); &UNITWRITE(REMOUT,JUSTTWO,2,0,12); &ANS:=WAIT; &CASE ANS OF (SENDNEXT :UNO('.'); (SENDAGAIN:BEGIN 4BUFFPTR:=BUFFPTR-1; 4UNO('?'); 2END; &END; $END; (*$R-,I-*)  PROGRAM REMOTETALK;   CONST version='IV.0 a1'; &res_segs='fileops,pascalio,extraio,heapops'; {resident segments} &slop=2000; {extra slop for buffer allocation} &  REMIN=7; &REMOUT=8; &FINALBLOCK=50; &NOTLASTBLOCK=51; &SENDAGAIN=52; &SENDNEXT=53; &ABORT=54; &UNSLAVE=55; &CLOSEFILE=56; &RECEIVEFILE=57; &SENDFILE=58; &OPENFILE=59; &FILEOPENED=60; &BUMFILE=61;  FILECLOSED=62;   TYPE BYTE=0..255; %BLOCK=PACKED ARRAY[0..511] OF BYTE; %TWOBYTES=PACKED ARRAY[0..1] $CLOSE(F); $IF BADINPUT THEN $BEGIN &WRITELN; &WRITE(' ERROR in input file'); &SIGNAL(ABORT); $END ELSE &SIGNAL(FINALBLOCK); " IF WAIT<>FILECLOSED THEN &BEGIN (WRITELN; (WRITE(' ERROR in output file'); &END; "END; " "PROCEDURE DOCOMMAND(SENDORRECEIVE:CHAR); "VAR CH:CHAR; &I,TRANSFERUNIT:INTEGER; &ANSWER:TWOBYTES; &S:STRING; "BEGIN $FILLCHAR(COMMAND,82,0); $IF SENDORRECEIVE='S' THEN $BEGIN &COMMAND[0]:=SENDFILE; &REPEAT (WRITE(' Send what file? '); (READLN(S); (IF LENGTH(S)=0 TOF BYTE; %SETOFCHAR=SET OF CHAR; %BLOCKARRAY=ARRAY[0..0] OF BLOCK; %BLOCKPTR=^BLOCKARRAY;   VAR BUFF,FOON:BLOCKPTR; $PACKBLOCK:BLOCK; $FILENAME:STRING; $INCH:CHAR; $F:FILE; $COMMAND:PACKED ARRAY[0..81] OF BYTE; $FIRSTBLOCK,UNITNUM,LASTBLOCK,UNOCNTR,BUFFSIZE:INTEGER;  "PROCEDURE SIGNAL(COMMAND:INTEGER); "VAR WART:TWOBYTES; "BEGIN $WART[0]:=COMMAND; $UNITWRITE(REMOUT,WART[0],1,0,12); "END; " "FUNCTION WAIT:INTEGER; "VAR WART:TWOBYTES; "BEGIN $UNITREAD(REMIN,WART[0],1,0,12); ¬$WAIT:=WART[0]; "END; " "PROCEDURE UNO(CH:CHAR); "BEGIN $UNOCNTR:=UNOCNTR+1; $WRITE(CH); $IF UNOCNTR=40 THEN $BEGIN &WRITELN; &UNOCNTR:=0; $END; "END; " "FUNCTION GETCHAR(OKSET:SETOFCHAR):CHAR; "VAR CH:CHAR; "BEGIN $REPEAT &READ(KEYBOARD,CH); &IF CH IN ['a'..'z'] THEN (CH:=CHR(ORD(CH)-ORD('a')+ORD('A')); $UNTIL CH IN OKSET; $WRITELN(CH); $GETCHAR:=CH; "END; " "PROCEDURE RECEIVEIT; "VAR INBLOCK:PACKED ARRAY[0..1025] OF BYTE; &JUSTONE:TWOBYTES; &BADOUTPUT:BOOLEAN; &BYTENUM,CHECK¬6     HEN *EXIT(DOCOMMAND); (RESET(F,S); &UNTIL IORESULT=0; &REPEAT (WRITE(' Send to what remote file? '); (READLN(S); (IF LENGTH(S)=0 THEN (BEGIN *CLOSE(F); *EXIT(DOCOMMAND); (END; (FOR I:=0 TO LENGTH(S) DO *COMMAND[I+1]:=ORD(S[I]); (UNITWRITE(REMOUT,COMMAND,82,0,12); &UNTIL WAIT=FILEOPENED; &SENDIT; $END ELSE $BEGIN &REPEAT (WRITE(' Receive what remote file? '); (READLN(S); (IF LENGTH(S)=0 THEN *EXIT(DOCOMMAND); (COMMAND[0]:=OPENFILE; (FOR I:=0 TO LENGTH(S) DO e: STRING; "f: FILE OF data_array; "  PROCEDURE receive_file; "VAR $done,check_error: BOOLEAN; $in_header: t_header; $in_data: data_array; $in_trailer: t_trailer; " $PROCEDURE send(blk_type: b_types); $VAR &i,checksum: INTEGER; &out_header: t_header; &out_trailer: t_trailer; $BEGIN &FILLCHAR(out_header,SIZEOF(out_header),0); &FILLCHAR(out_trailer,SIZEOF(out_trailer),0); &WITH out_header, out_trailer DO (BEGIN *block_type := blk_type; *LSB_checksum := ORD(blk_type); (END; *COMMAND[I+1]:=ORD(S[I]); (UNITWRITE(REMOUT,COMMAND,82,0,12); &UNTIL WAIT=FILEOPENED; &REPEAT (WRITE(' Write to what file? '); (READLN(S); (IF LENGTH(S)=0 THEN (BEGIN *COMMAND[0]:=CLOSEFILE; *UNITWRITE(REMOUT,COMMAND,82,0,12); *EXIT(DOCOMMAND); (END; (REWRITE(F,S); &UNTIL IORESULT=0; &COMMAND[0]:=RECEIVEFILE; &UNITWRITE(REMOUT,COMMAND,82,0,12); &RECEIVEIT; $END; "END; " "PROCEDURE DOSLAVECOMMANDS; "VAR I:INTEGER; &S:STRING; "BEGIN $REPEAT &UNITREAD(REMIN,COMMAND,82,0,12); &FOR I:&UNITWRITE(REMOUT,out_header,SIZEOF(out_header),,12); &UNITWRITE(REMOUT,out_trailer,SIZEOF(out_trailer),,12); $END; { send } $ $PROCEDURE bad(message: STRING); $BEGIN &send(error); &WRITELN(message); &done := TRUE; $END; { bad } $ $PROCEDURE get_data(block_type: b_types); $VAR &i,checksum: INTEGER; $BEGIN &CASE block_type OF (header : WRITE('Header'); (data : WRITE('Data'); (trailer: WRITE('Trailer'); &END; &WRITELN(' block received'); &WITH in_header, in_trailer DO (BEGIN *UNITREA=0 TO COMMAND[1] DO (S[I]:=CHR(COMMAND[I+1]); &WRITELN; &CASE COMMAND[0] OF (CLOSEFILE :CLOSE(F); (SENDFILE :BEGIN 6REWRITE(F,S); 6IF IORESULT=0 THEN 6BEGIN 8WRITE('Opening new file: ',S); 8COMMAND[0]:=FILEOPENED; 6END ELSE 6BEGIN 8WRITE('ERROR opening new file: ',S); 8COMMAND[0]:=BUMFILE; 6END; 6UNITWRITE(REMOUT,COMMAND,1,0,12); 6WRITELN; 6IF COMMAND[0]=FILEOPENED THEN 8RECEIVEIT; 4END; (RECEIVEFILE:SENDIT; (OPENFILE :BEGIN 6RESET(F,S); 6IF IORESULT=0 THEN 6BEGIN D(REMIN,in_data,MSB_data_length*256 + LSB_data_length,,12); *UNITREAD(REMIN,in_trailer,SIZEOF(in_trailer),,12); *checksum := MSB_data_length + LSB_data_length + ORD(block_type) + 6block_sequence; *FOR i := 0 TO 3 DO ,checksum := checksum + reserved[i]; *FOR i := 1 TO MSB_data_length*256 + LSB_data_length DO ,checksum := checksum + in_data[i]; *check_error := (checksum <> (MSB_checksum*256 + LSB_checksum)); (END; &IF check_error THEN { Ask to re-send it } (BEGIN *send(NAK); 8WRITE('Opening old file: ',S); 8COMMAND[0]:=FILEOPENED; 6END ELSE 6BEGIN 8WRITE('ERROR opening old file: ',S); 8COMMAND[0]:=BUMFILE; 6END; 6UNITWRITE(REMOUT,COMMAND,1,0,12); 4END; &END; $UNTIL COMMAND[0]=UNSLAVE; "END; "  BEGIN "buffsize:= 1 + ((varavail(res_segs)-slop) div 256); "if varnew(buff,buffsize*256) = 0 $then &begin & writeln('program error allocating buffer'); (exit(program); &end; "WRITELN('REMTALK [',version,'] - press S(lave first'); "REPEAT $WRITE('M(aster S(lave Q*WRITELN('Checksum error - Retrying...'); (END &ELSE { Good read } (send(ACK); $END; { get_data } $ "BEGIN { receive_file } $check_error := FALSE; $done := FALSE; $REPEAT &FILLCHAR(in_header,SIZEOF(in_header),0); &FILLCHAR(in_data,SIZEOF(in_data),0); &FILLCHAR(in_trailer,SIZEOF(in_trailer),0); &UNITREAD(REMIN,in_header,SIZEOF(in_header),,12); &IF IORESULT = 0 THEN (WITH in_header DO *CASE block_type OF ,not_used, ,ACK, ,NAK, ,error : BEGIN 8UNITREAD(REMIN,in_trailer,SIZEOF(in_trailer(uit '); $CASE GETCHAR(['M','S','Q']) OF &'M':BEGIN ,REPEAT .WRITE(' S(end R(eceive Q(uit '); .INCH:=GETCHAR(['S','R','Q']); .CASE INCH OF 0'S', 0'R':DOCOMMAND(INCH); 0'Q':BEGIN 6COMMAND[0]:=UNSLAVE; 6UNITWRITE(REMOUT,COMMAND,82,0,12); 4END; .END; .WRITELN; ,UNTIL INCH='Q'; *END; &'S':DOSLAVECOMMANDS; &'Q':EXIT(REMOTETALK); $END; $WRITELN; "UNTIL FALSE;  END. ),,12); 8bad('Illegal block received'); 6END; ,header : get_data(header); ,data : BEGIN 8get_data(data); 8IF NOT check_error THEN :BEGIN  0 THEN >bad('Error on writing to disk'); :END; 6END; ,trailer : BEGIN 8get_data(trailer); 8IF NOT check_error THEN :BEGIN WRITELN('File received and written'); :END; 6END; *END &ELSE $CURSOR $EQUAL $SYNTAX ŅO.¦(¦(bad('Receive header error'); $UNTIL done; "END; { receive_file } "  BEGIN { file_comm }  UNITCLEAR(REMIN); "UNITCLEAR(REMOUT); "WRITELN; "WRITELN('File Comm [A1]'); "WRITELN; "REPEAT  REPEAT &CLOSE(f); &WRITE('Output file name: '); &READLN(out_file); &IF LENGTH(out_file) = 0 THEN (EXIT( file_comm ); &REWRITE(f,out_file); &good := (IORESULT = 0); &IF good THEN (WRITELN('Can''t open file ',out_file);  UNTIL good;  FILLCHAR(f^,SIZEOF(data_array),0); { Put 2 blocks of nulls } $PUT(f); $PUT(f); $PUT(f); $PUT(f); $WRITELN('Ready to receive - Start up FILECOMM on OMNIDATA'); $receive_file; "UNTIL FALSE;  END { file_comm }.   PROGRAM file_comm;  CONST "REMIN = 7; { Remote Input } "REMOUT = 8; { Remote Output }  TYPE "byte = 0..255; "b_types = (not_used,header,data,trailer,ACK,NAK,error); "data_array = PACKED ARRAY [1..256] OF byte; "t_header = PACKED RECORD /MSB_data_length: byte; /LSB_data_length: byte; /block_type: b_types; /block_sequence: byte; /reserved: PACKED ARRAY [0..3] OF byte; -END; "t_trailer = PACKED RECORD 0MSB_checksum: byte; 0LSB_checksum: byte; .END;  VAR "good: BOOLEAN; "in_file, out_fil7     M:=0 TO 511 DO &BEGIN (BYTE0:=PACKBLOCK[BYTENUM] DIV 16; (UNPACKBLOCK[BYTENUM+BYTENUM]:=BYTE0; (BYTE1:=ORD(ODD(PACKBLOCK[BYTENUM]) AND ODD(15)); (UNPACKBLOCK[BYTENUM+BYTENUM+1]:=BYTE1; (CHECKSUM:=CHECKSUM+BYTE0+BYTE1; &END; &UNITWRITE(REMOUT,UNPACKBLOCK,1024,0,12); &JUSTTWO[0]:=CHECKSUM DIV 128; &JUSTTWO[1]:=ORD(ODD(CHECKSUM) AND ODD(127)); &UNITWRITE(REMOUT,JUSTTWO,2,0,12); &ANS:=WAIT; &CASE ANS OF (SENDNEXT :UNO('.'); (SENDAGAIN:BEGIN 4BUFFPTR:=BUFFPTR-1; 4UNO('?'); 2END; &END; $END; (*$R-,I-*)  PROGRAM REMOTETALK;   CONST version='IV.0 a1'; &res_segs='fileops,pascalio,extraio,heapops'; {resident segments} &slop=2000; {extra slop for buffer allocation} &  REMIN=7; &REMOUT=8; &FINALBLOCK=50; &NOTLASTBLOCK=51; &SENDAGAIN=52; &SENDNEXT=53; &ABORT=54; &UNSLAVE=55; &CLOSEFILE=56; &RECEIVEFILE=57; &SENDFILE=58; &OPENFILE=59; &FILEOPENED=60; &BUMFILE=61;  FILECLOSED=62;   TYPE BYTE=0..255; %BLOCK=PACKED ARRAY[0..511] OF BYTE; %TWOBYTES=PACKED ARRAY[0..1] $CLOSE(F); $IF BADINPUT THEN $BEGIN &WRITELN; &WRITE(' ERROR in input file'); &SIGNAL(ABORT); $END ELSE &SIGNAL(FINALBLOCK); " IF WAIT<>FILECLOSED THEN &BEGIN (WRITELN; (WRITE(' ERROR in output file'); &END; "END; " "PROCEDURE DOCOMMAND(SENDORRECEIVE:CHAR); "VAR CH:CHAR; &I,TRANSFERUNIT:INTEGER; &ANSWER:TWOBYTES; &S:STRING; "BEGIN $FILLCHAR(COMMAND,82,0); $IF SENDORRECEIVE='S' THEN $BEGIN &COMMAND[0]:=SENDFILE; &REPEAT (WRITE(' Send what file? '); (READLN(S); (IF LENGTH(S)=0 TOF BYTE; %SETOFCHAR=SET OF CHAR; %BLOCKARRAY=ARRAY[0..0] OF BLOCK; %BLOCKPTR=^BLOCKARRAY;   VAR BUFF,FOON:BLOCKPTR; $PACKBLOCK:BLOCK; $FILENAME:STRING; $INCH:CHAR; $F:FILE; $COMMAND:PACKED ARRAY[0..81] OF BYTE; $FIRSTBLOCK,UNITNUM,LASTBLOCK,UNOCNTR,BUFFSIZE:INTEGER;  "PROCEDURE SIGNAL(COMMAND:INTEGER); "VAR WART:TWOBYTES; "BEGIN $WART[0]:=COMMAND; $UNITWRITE(REMOUT,WART[0],1,0,12); "END; " "FUNCTION WAIT:INTEGER; "VAR WART:TWOBYTES; "BEGIN $UNITREAD(REMIN,WART[0],1,0,12); HEN *EXIT(DOCOMMAND); (RESET(F,S); &UNTIL IORESULT=0; &REPEAT (WRITE(' Send to what remote file? '); (READLN(S); (IF LENGTH(S)=0 THEN (BEGIN *CLOSE(F); *EXIT(DOCOMMAND); (END; (FOR I:=0 TO LENGTH(S) DO *COMMAND[I+1]:=ORD(S[I]); (UNITWRITE(REMOUT,COMMAND,82,0,12); &UNTIL WAIT=FILEOPENED; &SENDIT; $END ELSE $BEGIN &REPEAT (WRITE(' Receive what remote file? '); (READLN(S); (IF LENGTH(S)=0 THEN *EXIT(DOCOMMAND); (COMMAND[0]:=OPENFILE; (FOR I:=0 TO LENGTH(S) DO $WAIT:=WART[0]; "END; " "PROCEDURE UNO(CH:CHAR); "BEGIN $UNOCNTR:=UNOCNTR+1; $WRITE(CH); $IF UNOCNTR=40 THEN $BEGIN &WRITELN; &UNOCNTR:=0; $END; "END; " "FUNCTION GETCHAR(OKSET:SETOFCHAR):CHAR; "VAR CH:CHAR; "BEGIN $REPEAT &READ(KEYBOARD,CH); &IF CH IN ['a'..'z'] THEN (CH:=CHR(ORD(CH)-ORD('a')+ORD('A')); $UNTIL CH IN OKSET; $WRITELN(CH); $GETCHAR:=CH; "END; " "PROCEDURE RECEIVEIT; "VAR INBLOCK:PACKED ARRAY[0..1025] OF BYTE; &JUSTONE:TWOBYTES; &BADOUTPUT:BOOLEAN; &BYTENUM,CHECK*COMMAND[I+1]:=ORD(S[I]); (UNITWRITE(REMOUT,COMMAND,82,0,12); &UNTIL WAIT=FILEOPENED; &REPEAT (WRITE(' Write to what file? '); (READLN(S); (IF LENGTH(S)=0 THEN (BEGIN *COMMAND[0]:=CLOSEFILE; *UNITWRITE(REMOUT,COMMAND,82,0,12); *EXIT(DOCOMMAND); (END; (REWRITE(F,S); &UNTIL IORESULT=0; &COMMAND[0]:=RECEIVEFILE; &UNITWRITE(REMOUT,COMMAND,82,0,12); &RECEIVEIT; $END; "END; " "PROCEDURE DOSLAVECOMMANDS; "VAR I:INTEGER; &S:STRING; "BEGIN $REPEAT &UNITREAD(REMIN,COMMAND,82,0,12); &FOR I:SUM,BUFFPTR,BYTE0,BYTE1,ANSWER:INTEGER; " $FUNCTION PUTBLOCK(VAR ONEBLOCK:BLOCK):BOOLEAN; $BEGIN &PUTBLOCK:=TRUE; &BUFF^[BUFFPTR]:=ONEBLOCK; &BUFFPTR:=BUFFPTR+1; &IF BUFFPTR=BUFFSIZE THEN &BEGIN (PUTBLOCK:=BLOCKWRITE(F,BUFF^,BUFFSIZE)=BUFFSIZE; (BUFFPTR:=0; &END; $END; $ "BEGIN $BUFFPTR:=0; $UNOCNTR:=0; $BADOUTPUT:=FALSE; $REPEAT &ANSWER:=WAIT; &IF ANSWER=NOTLASTBLOCK THEN &BEGIN (UNITREAD(REMIN,INBLOCK,1026,0,12); (CHECKSUM:=0; (FOR BYTENUM:=0 TO 511 DO (BEGIN =0 TO COMMAND[1] DO (S[I]:=CHR(COMMAND[I+1]); &WRITELN; &CASE COMMAND[0] OF (CLOSEFILE :CLOSE(F); (SENDFILE :BEGIN 6REWRITE(F,S); 6IF IORESULT=0 THEN 6BEGIN 8WRITE('Opening new file: ',S); 8COMMAND[0]:=FILEOPENED; 6END ELSE 6BEGIN 8WRITE('ERROR opening new file: ',S); 8COMMAND[0]:=BUMFILE; 6END; 6UNITWRITE(REMOUT,COMMAND,1,0,12); 6WRITELN; 6IF COMMAND[0]=FILEOPENED THEN 8RECEIVEIT; 4END; (RECEIVEFILE:SENDIT; (OPENFILE :BEGIN 6RESET(F,S); 6IF IORESULT=0 THEN 6BEGIN *BYTE0:=ORD(ODD(15) AND ODD(INBLOCK[BYTENUM+BYTENUM])); *BYTE1:=ORD(ODD(15) AND ODD(INBLOCK[BYTENUM+BYTENUM+1])); *PACKBLOCK[BYTENUM]:=BYTE0*16+BYTE1; *CHECKSUM:=CHECKSUM+BYTE0+BYTE1; (END; (IF CHECKSUM=ORD(ODD(127) AND ODD(INBLOCK[1024]))*128+ +ORD(ODD(127) AND ODD(INBLOCK[1025])) THEN (BEGIN *IF PUTBLOCK(PACKBLOCK) THEN *BEGIN ,UNO('.'); ,SIGNAL(SENDNEXT); *END ELSE *BEGIN ,BADOUTPUT:=TRUE; ,SIGNAL(ABORT); *END; (END ELSE (BEGIN *UNO('?'); *SIGNAL(SENDAGAIN); (END; &END ELSE (IF AN8WRITE('Opening old file: ',S); 8COMMAND[0]:=FILEOPENED; 6END ELSE 6BEGIN 8WRITE('ERROR opening old file: ',S); 8COMMAND[0]:=BUMFILE; 6END; 6UNITWRITE(REMOUT,COMMAND,1,0,12); 4END; &END; $UNTIL COMMAND[0]=UNSLAVE; "END; "  BEGIN "buffsize:= 1 + ((varavail(res_segs)-slop) div 256); "if varnew(buff,buffsize*256) = 0 $then &begin & writeln('program error allocating buffer'); (exit(program); &end; "WRITELN('REMTALK [',version,'] - press S(lave first'); "REPEAT $WRITE('M(aster S(lave QSWER=ABORT THEN *BEGIN ,WRITELN; ,WRITE(' ERROR in input file'); *END; $UNTIL ANSWER IN [FINALBLOCK,ABORT]; $BADOUTPUT:=BADOUTPUT OR (BLOCKWRITE(F,BUFF^,BUFFPTR)<>BUFFPTR); $CLOSE(F,LOCK); " IF (IORESULT<>0) OR BADOUTPUT THEN $BEGIN &SIGNAL(ABORT); &WRITELN; &WRITE(' ERROR in output file'); $END ELSE &SIGNAL(FILECLOSED); "END; " "PROCEDURE SENDIT; "VAR ANS,BYTE0,BYTE1,BYTENUM,CHECKSUM,BLOCKSREAD,BUFFPTR:INTEGER; &BADINPUT:BOOLEAN; &UNPACKBLOCK:PACKED ARRAY[0..1023] OF BYTE; O^2£2£&JUSTTWO:TWOBYTES; " $FUNCTION GETBLOCK(VAR ONEBLOCK:BLOCK):BOOLEAN; $BEGIN &BUFFPTR:=BUFFPTR+1; &IF BUFFPTR>=BLOCKSREAD THEN &BEGIN (BLOCKSREAD:=BLOCKREAD(F,BUFF^,BUFFSIZE); (BADINPUT:=IORESULT<>0; (BUFFPTR:=0; &END; &GETBLOCK:=(BLOCKSREAD<>0) AND (NOT BADINPUT); &ONEBLOCK:=BUFF^[BUFFPTR]; $END; $ "BEGIN $BADINPUT:=FALSE; $UNOCNTR:=0; $BUFFPTR:=-1; $BLOCKSREAD:=0; $ANS:=SENDNEXT; $WHILE GETBLOCK(PACKBLOCK) AND (ANS<>ABORT) DO $BEGIN &CHECKSUM:=0; &SIGNAL(NOTLASTBLOCK); &FOR BYTENUA„†7     (uit '); $CASE GETCHAR(['M','S','Q']) OF &'M':BEGIN ,REPEAT .WRITE(' S(end R(eceive Q(uit '); .INCH:=GETCHAR(['S','R','Q']); .CASE INCH OF 0'S', 0'R':DOCOMMAND(INCH); 0'Q':BEGIN 6COMMAND[0]:=UNSLAVE; 6UNITWRITE(REMOUT,COMMAND,82,0,12); 4END; .END; .WRITELN; ,UNTIL INCH='Q'; *END; &'S':DOSLAVECOMMANDS; &'Q':EXIT(REMOTETALK); $END; $WRITELN; "UNTIL FALSE;  END.  …Ģ³ā’žū\Ģ³ż\ Č\ \ `ŽĮDĮ `€ĄC\ Č„ĄÄČ 8t ”bbĄŠ  ąLĶ”  ąNJʃ\ VĄZĘŖŹ\ dJĘŖ\ nĄJ*’ųĄŠĢ±Ģ±Ģ±Ä‘\ ‚Ąz  `> nJʑ\JĘ”@\  Ą:Ąz  n `>Ä@ĀĢ`˜Č@@\€€Č\`\ ` ŖzĄˆ"’żČ\ ` Ŗ€Č €€Č€Č\`\Į xĮ`8Į v  Š\tČ\`\`\ v` ŖzČ €€  ¼Į`š€ !’‘ĮAČ\`\Č€z„  ¼Č€Ąˆ"’żČ\ĮD ĄĮ„ Ž  Š j\ ŒČ\ \ ^Įj ČĄŚČ*€衉ĮĄ’żČ€[ƒ' Ą£,R[Č lĄC  D P  †ĄB}MAININTP ˆMAININTP IV.0 [a.3] PąJ  J" Ą ~Č„Čt ”ą~Ą ^*ą^Ą J ąJ‘Į`8 Č Ž\b‚b vŹ PŹ 8ŹˆŹ‰Ź €ĀČPĀJĀąl[Č8Č%<Ć„ĮeĄ 6 ÖÉ`ÖČ6Čv[Į >Į$$P” „‚„ PØ„Ā \ ²[ ”`<ĮUĄeĮ!Ā \ ²€[ĄD!  |Ą  Pą|‚ | P ČN „ČLĄD P ”ČxPČ\ \.`”ˆ)8 Įi ČĮ„ Ž jĀ‰Č*PĀ*Ą`P P  `x P   vĄBA PĀĀj¢ v* ¢ƒ\ĮŚĄgˆ”ŹĄŗ[ĮWĮĮČ ÄĄeĮ! ²€”ŹĄŗĄDĀąÄ[ČČ\ \Ų`”ĄĆ*\ Œ| z’’Ø®ą Č  -` f\( AZ09az_$   ’’’’ż‚™˜‰ŠˆP‹‰Šˆ”“›?ˆ ’’€’’ Ģ±ż\€Č\`\ ŒŃ˜ ”„Ģ±ż\ ² Ąz Ąŗ ĄśĄÓ”äĮ"œD@ÄJʃ\8ĄzĄŗ Ąś Į#œD@DĄ¢ÄȆĄcœAąA@¢Ąz@D@ä`†\zĄĄz< ¦€JʃĄ8Jʁ\ŒZFŗ\”ęŗ\šZ\ ĄZAAʁ\®Z\“š\ŗ\Ą¦ŗ\Ę\Ģfŗ\ŅĄś&ĄšJʃCBĮ L € ^ž’Š¾Ź Ž Ā : P VĘī Ī Ö V˜˜˜˜˜˜rrr¦¦¦° T Ī lL 62 h ž Ž – p Ø ² @p \Ž.>b¬Ä b˜ . 8ŅŅŅ,²ø ¾ Ę f V V V V V V V V €š 8ĀŹZ¾ü6J^üčŖŗĘbźp @€ @€?’’’’’’?’’’’”ČŚ  ! 1 A Q a q  ‘ ” ± Į Ń į ń€r JĄZBȆāĄ` †Čˆ `†ĮČ † b‚ĄŠĄą†Ģ³żĄ`ˆņż`ŽĄA[0 Žģŗż\@ ŽČ†ZLŗüĄZ``†ņż\d ŽLŗż\tĮA ŽBĮ2 ”Čb%ž”Į%¾BĄņTĄAŒŗ ūĄĆ ĄrüĀ bJĘ ’\Ā bJĘ  \ĄALŗšū`¢ĄAļN²ēüźĄzĄŗ -`bČBj-`d\-`b\-`d\ Ąz-`b –-`d\Ąz-`bˆ!¦ čĮ!Į`> 0ČDĄ >ȁČ Ŗf!-`d\ n-`bČ :>Č Øf-`d ˜\ĄI ˆ!j”ĄajČ ” –Āą”[ˆ!”!ˆ!¦Į!Č ę `ČDÉ`”Į : 0ĀąęČ:Į >™dČ Ŗf”[  # 3 C S c s ƒ “ £ ³ Ć Ó ć ó š ą Š Ą °    € p ` P @ 0 ˜¬¶Źņ8ŽBŽŽjt~ˆœŽÄŲö2<ŽŽŽ@@@@@@@@AND 'ARRAY ,BEGIN CASE CONST DEFINITIDIV 'DO DOWNTO ELSE END EXTERNAL5FOR FILE .FORWARD "FUNCTION GOTO IF IMPLEMEN4IN )INTERFAC3LABEL MOD 'NOT &OF OR (PACKED +PROCEDURPROCESS 8PROGRAM !RECORD -REPEAT SEPARATE6SET ˆ >: Ą >Č":Č ”[Ą :Ąą¦Ą‚ˆ>ĄĀĄ¢÷‚ČāČ ”[Į„Įą”ˆ”™fĮĘĮ¦õÉFˆ”ÉÅ[Į[ĮDĮ%É`”[Į`>ÉI ÉHi`vÉ`8ÉJŁ`QŁ`­[Č lĮ`>Āe Ā%Ā„ąPŲ%QŲ%­ĮeČ8Č%<Č%6Ć„ąvČ\ ČČv¢ ÖĄ`6Č`ÖĀąl`ŽĄ`¬\ ² ĄśĄz zĄŗ ŗĮįį ĢrCż\Ürż\*\ĄśūśĄz zĄŗ ŗĮ D „ŌRū\ĄśĆĮ:Ąz zĄą ŲĢCDż\ÜCż\*\Č FŠČH-`FĮ"Ą¢ĄĀ  ņį ĄzÄDĄzÄC\ĄŹĄz zĄŗĀĄśĮ: ±ĄĆ€łĄĆ  *SEGMENT !THEN TO TYPE UNIT 2UNTIL USES 1VAR WHILE WITH Ą±[Ą±Č ||Ā[`XŠx qĄ”.Ą2PÅŲ8 ÄŲ8 ĆŲ8RÅŲ8 ÄŲ8 ĆŠųĆRCŲ8R fĄ`®Ą[€ČĄąĀ Č tĄĄ „ ČĀČ >¾ČÄŗJʁ QJŚJŚ ~JʁĄ`P  `x P   vĀ ˆČ€(Įa z`Č <ˆĆ`v HX fĀ \€¢\ X ² ` ²€Ąz \€Ąz \ƒ€c’¢\€śū€nŗó\€nŗļ\zŃ ¢\zĄz ų\”  ąLĄC TĄ TĄś€ƒ`Ą  C T¢\ Ž Jʁ\łĄ‘ĄĆ„ųĄĆłĘ€\Ę ¬\ ² ĄzČ‚Ąŗ RČrĮĀ$ĮDĶ ŒüĮѱ˜Fü˜C Fߘ@ ˜A ļŻķ˜Bł˜GöA``‚ČVĮĮŠTĮ!’æ !Ąį&Ąa(`Č†ŒōüĄ`rÄ`VŅŲ³ĀŅŲ³ĀĢ Œü\Ąą† ąŽĮŻĄ rÄ VĀņā\ĄzĄŖ„‘ˆ” ˆ”ˆ”Į Į"  ’’Į"Į:ÅŹĘ\Ą„ŻĄzĄśĄŗĮzĄAŻsż\ĄzĄśĄŗĮzĄAÜõż\ĄzĄŗĄś ĄćĄć ĀÓĆü\ĄzĄ”Ą¢Ąā/  ĀĮ „ĮSÅ …Į&„ ² Į$¶T¾ĄÄŌ\Į‚ Į” ”…Į–Į¦CĮCĮÓ”Ā„Ę č IJĘ”’Ź\ ō NJĘ”’Ŗ\ !’ Zʑ\f Ąz ZŚŚ‘\ Ąj jŌj*\”  ŚĘ“\” ¦ƒ\”Ą:8 ¦\ PJŚ\zŃ Jʄ\”  ÉJĘ£\” ĄC! ~!’JA’ž IJʁ\” ĄC ˜!’2 IČz\”  ĪJĘ£\”  Ī#Jʃ\”  ĪČś\””ŽĄ‰Ą’ż  ĀJĘ£\ŽĄ‰Ą’ż # ĀJʃ\ŽĄ‰Ą’ż  ĀČś\ "ĄjÄzŹ\ ” <ĮĮ$ ”[Ž  ,Jʤ\Ž  ,$Jʄ\Ž  ,É:\€Č\`\ Č„Č 8t ”Ąŗ  „BƒJʒBCū\€ĄJ C CĄQĢzżŹ\€Ą‰ĄĆĄ’żJʂ\€Jʃ\ŽĄCĄśĄŗĮD ąvˆ | 8     ROOTTASK EVEC <SYSREAD øCSOUT īNIL ”SYSSN SYSBLK MAININTP MAININTPSBR Ź R NGR  R FLT ą T CHKSEX ŽDVR Ī R DBUG DIRSZ MPR Ģ R CCLR  DCLR POT † T XMAP GEQREAL ęRQAE LLDRL .LR KEYQUE  Ų Ī,-`*Č 6¬ä[Č ō8Č ö8 Č#f@ Č ō8Č ö8`ÄČ@Č<Č>-`8Č D¬[Č 8-`8[Č 8-`8[Č Č ¶ ”Č$ @Āą¶[Č *Č ¶ ”Č2 &Āą¶[Į ĘŃ`Ś …”D`ÅĮC#[ĄzXUĘ ’\ĄzPM\Ąz Č! `:ĄafĄį²Ųą’xŲą’•-€Č ž&ˆĘ`DČ  ÖƒČ ƒ Č  ĄĮ#Ųą’xŲą’•`^Č-`Č ¬\`BČ:PČ:HĄz Č!FĄaf#€Č FˆĘ`DČ ųF ÖƒČ ųFƒČ  F`^ČN-`FČ R¬\Į ĘŃ`Ś …”DAPCLR LEQREAL äRQAE LRCLR INIT :TI TEMP †CTRL 2LR CLCKWS TRAPSNAPØCPOFST NXEQERR ®EXRL 4LR CMP3TABL’TRUE  SEGHI xEQUREAL āRUAE LMEMTOPB ZERO ¦CHAROUT ,SEGDSZ œSTRL 0LR RLCONST  &LDCRL ,RC L SELIWS SAVRTN lGBLVEC (9”ąŲ‰ą¦`:Įē ‡ ĄgfaĘ[Ń Ū †”……`E[[,.>@DLVX,.ōöųśüž  "HJLNPRTVXZ\^`bdfhjlnprtvxz|~€‚„†ˆŠŒŽ’”–˜šœž ¢¤¦ØŖ¬®°²“¶øŗ¼¾ĄĀÄĘČŹĢĪŠŅŌÖŲŚÜŽąāäęčźģīšņōöųśüž   "$&(*,.02468:<>@BDFHJLNPRTVXZ\^`bdfhjlnprtvxz|~€‚„†ˆŠŒŽ’”–˜šœž ¢¤¦ØŖ¬®°²“KEYBWS PUSHRSLTtTRAPWS CHRMASK  BIOSWS GETBIG ”SEGWORD PDISPWS CPOOL LCLCKEP  ¶øŗ¼¾ĄĀŠŅŌÖŲŚÜŽčźģīšņōöųśüž   "$&(*68:<>@BDFNbdfjlnprtvxz|~€‚„ˆŠŽ’”ŲŚÜ@DHLPTX\`dhlptx|€„ˆŒ”˜œ ¤rt~ˆÄČÖŚęčģņöųü    & * 0 > B N R T Z ^ d j p t x | € Š ¢ Ø ° ø Ā Ģ Ņ Ų Ž š ö  $ & 4 H R Z h p | Š – Ø ° ¾ Ģ Ü č š ų  & : J X \ f j v z ‚ † Š  ” – š   ¶ Ģ ą č ų ü ž  $ ( , 4 8 D J L P \ ` f n | † š ¤ Ø “ ø Ä Č Š Ō Ų ą č ģ š ō ö        " & * . 2 6 : > B F •BIOS990 ˆBIOS990 IV.0 [a.3] H L P T X \ h l p t ~ ‚ Œ ’ ˜ œ   ¤ Ø ¬ ° ø Ą Ņ ą ģ ų $(,0:>DJNRZ^drz€†Œ˜œ ¦Ŗ°¾ĢŠŌŽīņ $*26:>BFLV\`htx~‚ˆš®¾ĢŚąäčģšž ,0@DP^hlp|†Š¤¬²øĘĢŅŲŽäź>BL^ptvxz’²¶¾ĄÄŌŽźģšž,BFbf|€„†ŠŽŹÜąźīņō"&*.0>BFJLPXZ`drvŠØŗĘĪŌŚčō$.8BHLX\`p|€Œ’ž¦ĢŅŲŽņ "(,04:@FNRZbdntx|~‚„ˆŒ–˜ž ”  ’’’’’Ą¢¦Ŗ“¼ĘŹŅŲÜąäčōö "*DNRl‚Š–œ¦¬“øČĪŌÜāčšōųü  ¬®²¶ŗ &.6HX^hn|‚ŠŽ ¤Ø°¼ĄŲęźņöÄĢŠŅŌÖšĘĢŌÖŚŽąęčģšō "&(.2:<DHNPVX^`|ŠŽ¢Ŗ°“¼ĄŹŠŌŲęšōųśž "&(,028:DNVX\fjlrt€‚†ŠŒ’” Ŗ¬°“¶¾ĄĘČĪŌŚąāčźšņö  ",.8:BLRTfhlpr‚ˆŠ”š ¦Ŗ®²“ŗĄŹĢŠŌÖāęźģņōś $&,.46<>H’’’’ŠÕ"Br°’Ž Ž’’ ōˆ Ź@śĀ‹ĄjLPTXZ`bflnrxz~‚†ŠŽ”–šž¢¦Ŗ°“Šģīōųü ,.4>@LNXZ^`fjnrtz~‚’–¢¤ŖøŗĄŹĢŲŚŽāęźģņö   & 8*6:*ÄĘČŹĢĪąāäę,.024†’˜ž¦¬¾ ¼ t0RŒ# ¢Ŗ°“¼ĄŹŠŌŲęšōųśž "&(,028:DNVX\fjlrt€‚†ŠŒ’” Ŗ¬°“¶¾ĄĘČĪŌŚąāčźšņö  ",.8:BLRTfhlpr‚ˆŠ”š ¦Ŗ®²“ŗĄŹĢŠŌÖāęźģņōś $&,.46<>HśCÓ\ĄzĄŗĄśĮ#Įc\ĮĮöĶü  ”Į”…ĮcĮÖÅFDśĮ#Įd\Į„a ”DĮ „„EĮ aD EĮEĮć”Õ„ĘłEé\ĄzĄŗĄ”ĄāĮ"Įb Į¢Į¦JʆJʇJʃJʅJʄJʇ øJĘ ¬\Č  ŅČ hČ ÖŌČ ŲŌą¬Č:ŠČ::ĄzĄŗ ŗĄśČ ¶ JĀą¶ĄAĮ`ŠEČ Š&Č Š4Č ŠB $” ŌĮ$Ś”ˆ Ņ \ąŅĀąh[Č Z¬ņČ X¬īČ T¬źƒĮ[ƒ€ [ˆĘ [Į`ĘŃ Ś †”FC9C” ŲĄę ˆĘ`^‰ ¦`:‰ : `2Ø&:`JŃ Ū †”F€Å`: [ČXČZČ Š^ą`SYSUNT °INTPWS ŒR0 t ¼¾¬¦ž˜’6NEGONE ˜CLROP SEXOK |SYSCMB ¬SELIEP KEYBEP BBBREAK *RBAE KSTART BACK fSIB 6BIOSEP TRAPER ²SEG vONE šEREC 8ABR  R DISPEP TNC Ä C RND Ę D OPTABLE .ADR Č R OUTOP *IPCFLT \Č śT-`TČ `¬[ČXČZČ Š^ą`Č üT-`TČ `¬[Č ģ ąąČ ī*Į`ŠEM-`Č (¬F˜ >ƒ Ų ,-`*Č 6¬6˜ Ķƒ+Į`ŠE&Ų Ī,-`*Č 6¬!˜ ’(˜ Ń#•DŲÄ•ĘŃ#• ˜ D˜ Ex HÜ “[-`Č (¬Ü ö[Ü –ü[Č ī* Č š*Č ņ*Į`ŠEKŃ#xŲą’xÄŃ2Ä$’ą  Č Œ,-`*Č 6¬QųMŃ2˜ĢŲą”xDßŃc•˜D˜Eq HŲ,-`*Č 6¬0˜ĶĮ`ŠE Ų Ī,-`*Č 6¬ĻŲ2,-`*Č 6¬˜ ,ĶĮ`ŠE8     Ź Ź € Ą”üR8‚˜8BrŽ.śd–`¢Ž ˜ ˜ ˜ ˜ ¢ ¢ Ø “ĀČ | ä , \ąˆ ŹĆ l @öĀĀ ŚĀ`ÜŠ©ą‰I’‚H Č Üź Ź‚€ˆ ŹĀŠŖ-ź €ąŚąÜ  tąvąąą Č*ĄŖ"RČ Ą     ą    ź €Ąj ĄŖAˆ ŹĮā Ā ŚĀ`Üb (’Ĉź € Ź €ˆ Źź €ˆ  Ź€ ü2* ž ź €    ˆ Ź2Šžōž 2÷ōž 2÷ ź   ą €ź € Ąj D f h x Œ š ŗ Ų öFNZpœž¤®²¶ŗĄĀČŅÖāīņ HLPT^bfjnrvzŽ’–˜®°ģšōųüž ,<>FJX^lx|~Ž &*6:FJVZfj|€ˆŒ”˜ ¤¬°ø¼ÄČŠŌÜąčģōų BL$ ī Ōhlä "&*,0vz|€„†ŠŽ”˜šž nœžŽęī "24DHLP^b€‚Ŗ°²ĘŹĪŅāģō  P`xŠ¢¦Ŗę  $.>Tj„š     ¢ R ‚ Ę Ų Ž ź ņ ś  " 4 8 < @ R V Z ^ b f j n r v z ~ ‚ „ œ   ¤ ¦ ° ² Ą Ę Č Ö Ų ź ģ ś    " $ BńĀ‚ÄBź €ĄjŃź €ˆ  Źźź €ˆ pŹ@śĀĀ :Ā`<Š©nąn‰I’‚H pČ <ź Įj %B’Ź‚€ ˆ  Źź €ź ÅŃjĄŖ "ŃEe€ą2ˆ Ź@ś€ ą:ą< pąn      ź   ą € Ąj ĄŖAˆ pŹČ Ā :Ā`@BDFHJLNPTXZ`rvz~Œž ø¼ĄÄČĢŠŌŲŽź*,<@^`lnœžŽęī "24DHLP^b€‚Ŗ°²ĘŹĪŅāģō  P`xŠ¢¦Ŗę  $.>Tj„š     ¢ R ‚ Ę Ų Ž ź ņ ś  " 4 8 < @ R V Z ^ b f j n r v z ~ ‚ „ œ   ¤ ¦ ° ² Ą Ę Č Ö Ų ź ģ ś    " $ B9      * $DAY location * * NOTE; location IS IN $LOD FORMAT * DMAC .L $DAY .P .L $BNDAT #$DATE,%P ENDM * * * $PGMDT location * * THIS MACRO WILL RETURN THE LINK DATE IN THE SPECIFIED location * FOR DISPLAY PURPOSES. NOTICE THAT location MUST BE IN $LOD * FORMAT. * * DMAC .L $PGMDT .LOC .L ****** $MOVE =#$LNKDT,%LOC,=8 MOVE THE DATE OF THE PROGRAM OVER $LOD R1,=#$LNKDT $LOD R2,%LOC $LOD R3,=8 BL @$$MOVE  ENDM * * * IF $$FIO * * GENERAL I/O TUP, CALL AND TEST * DMAC $IO .F,.E LI R2,.F BL @$$IO $TEST .E ENDM * * GENERAL DCB MODIFICATION MACRO * * THIS MACRO ENABLES THE USER TO CHANGE THE CONTENTS OF THE DCB. * * THE 1ST PARAMETER IS DCB NAM, IN LOD FORMAT, IT IS PLACE IN R1 * THE 2ND PARAMETER IS BUFFER ADDRESS, IN LOD FORMAT, IT IS PLACED IN R2 * THE 3RD PARAMETER IS LENGTH, IN LOD FORMAT, IT IS PLACED IN R2 * THE 4TH PARAMETER IS READ-WRITE POINTER, IN LOD FORMAT, IT IS PLACED IN R2 * AND TWO WORDS POINTED TO BY THAT ADDRESS ARE MOVED TO THE DCB * THE 5TH PARAMETER IS FILE INDEX NUMBER, IN LOD FORMAT * THE 6TH PARAMETER IS TERMINAL ID, IN LOD FORMAT * THE 7TH PARAMETER IS FILE DESCRIPTOR POINTER, IN LOD FORMAT * THE 8TH PARAMETER IS REQUIRED FLAG, IN LOD FORMAT * THE 9TH PARAMETER IS OPCODE, IN LOD FORMAT * THE 10TH PARAMETER IS FUNCTION CODE, IN LOD FORMAT * * EXAMPLE: $DCBCG =#DCB,:BUF,=#512,PTR,=#5,#MYTID,=#$NAME *  DMAC .L $DCBCG .DCB,.BF,.LN,.RW,.FI,.RQ,.OP,.FN $LOD R1,%DCB IF '.BF'-' ' ELSE $LOD R2,%BF MOV R2,@$DCBBF(R1) ENDI IF '.LN'-' ' ELSE $LOD R2,%LN MOV R2,@$DCBLN(R1) ENDI IF '.RW'-' ' ELSE $LOD R2,%RW MOV *R2+,@$DCBRW(R1) MOV *R2,@$DCBRW+2(R1) ENDI IF '.FI'-' ' ELSE $LOD R2,%FI SWPB R2 MOVB * * LAST CHANGED 16 FEB 83 WAL * UNL IF $$LIST LIST TITL 'OMNINET SYSTEM MACRO FILE - 30 OCT 80' PAGE ENDI *********************************************************************** * * * ****** * * ****** * * * ****** * * * * * * * * ** ** * * * * * * * * * * * * * * * * R2,@$DCBFI(R1) ENDI ENDM ENDI END $$FIO * * SUBROUTINE LINKAGE MACROS * * * * DATA DECLARATION * DMAC $DCL .VN,.VS=1 .VN EQU $DS $DS SETV $DS+.VS+.VS ENDM * * ENTRY POINT * DMAC .L $ENTRY .IP .L DATA $DS $LP %IP ENDM * * CALL SUBROUTINE * * 15481DPG ADD .BK (MEMORY BANK PARAM) DMAC .L $CALL .S,.IP,.OP,.BK .L IF '.BK'-' ' MOV @$CALSB,$ * * * ****** * ****** * * * ******** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ****** * ****** * * * * ****** * * * * (COMMON) * *********************************************************************RET ELSE $LOD R0,%BK OV @$BCALS,$RET ENDI BL *$RET DATA .S IF '.IP'-' ' ELSE $LPX %IP ENDI DATA 0 IF '.OP'-' ' ELSE $LP %OP ENDI ENDM * * RETURN FROM SUBROUTINE * DMAC .L $RETRN .OP .L MOV @$RETSB,$RET BL *$RET IF '.OP'-' ' ELSE $LPX %OP ENDI DATA 0 ENDM * * SOURCE PA** * * SYSTEM MACRO FILE * * 14.02.81 - $DIRFN CRO CHANGED TO SET BIT PROPERLY * WHEN .P * * CLEAR A STRING AT .STR TO A VALUE .VAL FOR .CNT BYTES * DMAC .L $CLEAR .S,.V,.C .L $LOD R2,%S $LOD R1,%V $LOD R3,%C BL @$$CLER ENDM * * MOVE .CNT BYTES FROM .FROM TO .TO * DMAC .L $MOVE .F,.T,.C .L $LOD R1,%F $LOD R2,%T $LOD R3,%C BL @$$MOVE ENDM * * * CO 1 $$DDA SETV 1 $$TID SETV 1 $$OM2 SETV 1 $$ SETV 0 $$.P2 SETV 0 $$.P3 SETV 0 $$.P4 SETV 0 $$.P5 SETV 0 $$.P6 SETV 0 $$.P7 SETV 0 $$.P8 SETV 0 $$.P9 SETV 0 $$.P0 SETV 0 ENDM * * SUBROUTINE DECLARATION * DMAC $SUBR $DS SETV 32 ENDM * * GENERATE BLOCK OFFSETS * DMAC .L $BLKDF .S .L $DU SETV .S ENDM DMAC $OFFDF .L,.S .L EQU $DU $DU SETV $DU+.S ENDM * * MPARE TWO STRINGS, .P1,.P2 FOR .CNT BYTES * DMAC .L $COMP .P1,.P2,.CNT .L $LOD R1,%P1 $LOD R2,%P2 $LOD R3,%CNT BL @$$COMP ENDM * * * TIME MACRO TO RETURN THE CLOCK TIME * * $TIME location * * NOTE: location IS IN $LOD FORMAT * DMAC .L $TIME .P .L $LOD R1,=#$CLOCK $LOD R2,%P $LOD R3,=8 BL @$$MOVE ENDM * * * DAY MACRO TO RETURN THE ASCII DATE FROM THE LOW CORE SYSTEM CELLS * END OF FILE LIST * 9     RAMETER LIST * DMAC $LPX .P0,.P1,.P2,.P3,.,.P5,.P6,.P7 $PG %P0 $PG %P1 $PG %P2 $PG %P3 $PG %P4 $PG %P5 $PG %P6 $PG %P7 ENDM * DMAC $PG .P,.I IF '.P'-' '+'.I'-' ' ELSE IF '.I'-' ' $DU SETV 0 ELSE $DU SETV .I*256 ENDI IF '.P' ENDI IF $HASH ELSE $DU SETV $DU+>8000 ENDI  $RUN .TCB .L CLR @$TCRDY(.TCB) ENDM * GET/FREE * DMAC .L $GET .RCB,.RES .L $CALL $$GET,(%RCB),(%RES) ENDM DMAC .L $FREE .RES .L $CALL $$FREE,(%RES) ENDM IF $$APP * * KEYIN/DISPLAY INITIALIZATION * * DMAC *.L $DKINI *.L * BL @$DKINX * ENDM * * DISPLAY STRING * DMAC .L $DSPLY .P .L $LOD R0,%P BLWP @$DSPLX ENDM * * KEYIN STRING - MAP LOIF $EQUAL $DU SETV $DU+>2000 ENDI F $COLON ELSE $DU SETV $DU+>1000 ENDI IF '.I'-' ' IF '.P' ENDI IF $HASH $DU SETV $DU+>4000 ELSE IF $EQUAL $DU SETV DU+>4000 ENDI ENDI ELSE IF '.P' ENDI ENDI IF $HASH ELSE IF $EQUAL $DU SETV $DU+.P ELSE $DU SETV $DU+>0A00 IF .P/16 $DU SETV $WER TO UPPER CASE * DMAC .L $KEYIN .P, .L $LOD R0,%M $LOD R1,%P BLWP @$KEYIX ENDM * * KEYIN STRING - NORMAL * DMAC .L $KEYNL .P,.M .L $LOD R0,%M $LOD R1,%P BLWP @$KYNL1 ENDM * * SPECIAL KEYIN WITH CONTROL STRING * DMAC .L $GTFLD .P,.M,.C .L $LOD R0,%M $LOD R1,%P $LOD R2,%C BLWP @$GTFLX ENDM * * GET CHARACTER FROM DISPLAY BUFFER * * DU+.P $DU SETV $DU+.P ELSE $DU SETV $DU+.P ENDI ENDI ENDI DATA $DU IF $HASH DATA .P ENDI ENDI ENDM * * GENERATE PARAMETER LIST * DMAC $LP .P0,.P1,.P2,.P3,.P4,.P5,.P6,.P7 $OFFGN .P0 $OFFGN .P1 $OFFGN .P2 $OFFGN .P3 $OFFGN .P4 $OFFGN .P5 $OFFGN .P6 $OFFGN .P7 ENDM DMAC $OFFGN .O IF '.O'-' ' ELSDMAC *.L $GTDSP *.L * BLWP @$GTDSX * ENDM * * GET CHARACTER FROM KEYBOARD * DMAC .L $GTCHR .L BLWP @$GTCHX ENDM * * TEST FOR KEYBOARD CHARACTER PRESENT * DMAC .L $TSTCH .L BL @$TSCHR ENDM * * DISPLAY A CHARACTER ON CRT * DMAC .L $PTCHR .CHR .L IF ' '-'.CHR' ELSE $LOD R0,%CHR ****** SWPB R0 ***** REMOVED BY POPULAR DEMAND **** ENDI BLWP @$PTCE IF .O/16 DATA .O+.O ELSE DATA .O ENDI ENDI ENDM * * LOAD REGISTER WITH BASED ADDRESS * THE 1ST PARAMETER IS THE RESULT REGISTER - IT WILL CONTAIN AN ADDRESS * THE 2ND PARAMETER IS THE NAME OF A VARIABLE OR REGISTER * IT MAY BE PRECEDED BY A SPECIAL CHARACTER WHICH INDICATES: * NULL =CONTS OF : REG, OFFSET($BASE), OFFSET(SPEC'D BASE) * = =ADR OF : OFFSET+$BASE, OFFSET+SPEC'D BASE * # =CONTS OF : LOCATIOHX ENDM * * INITIALIZE THE CHARACTER PRINTER * DMAC *.L $CPINI *.L * REF $PINIT * BL @$PINIT * ENDM * * PRINT A CHARACTER * * DMAC *.L $PRTCH .CHR *.L * REF $PRCHR * IF ' '-'.CHR' * BLWP @$PRCHR * ELSE * $LOD R0,%CHR * BLWP @$PRCHR * ENDI * ENDM ENDI ENDIF FOR $$APP * * START DEBUG * DMAC .L $DEBUG .L BL @$DEBUX ENDM * * EN<(OPTIONAL BASE)> * =# =ADR OF : LOCATI<+OPTIONAL BASE> * : =CONTS OF CONTS OF: REG, OFFSET($BASE), OFFSET(SPEC'D BASE) * :# =CONTS OF CONTS OF: LOCATION<(OPTIONAL BASE)> * THE 3RD PARAMETER IS THE BASE REGISTER TO USE WITH A LABEL * * EXAMPLES: $LOD R1,DCB MOV DCB,R1 OR MOV @DCB($BASE),R1 * $LOD R1,DCB,R5 MOV @DCB(R5),R1 * $LOD R1,=DCB LI R1,DCB * $LOD R1,=#DCB LI R1,DCB * XEC CALL MACROS * ADDED MEM BANK PARAM 100481DPG ****** $CRTSK .STRTAD,.PRIORT,.TCBADR,.TSKNUM,.ABTADR,.PLIST,.MBANK DMAC .L $CRTSK .S,.P=(=2),.T,.N,.A=(=0),.X=(=#$ZERO),.M=(=0) .L $CALL $CRTS$,(%S,%P,%T,%N,%A,%X,%M) ENDM * ****** KILL TASK WITH TCB .T AND RETURN DMAC .L $KTSK .T .L IF '.T'-' ' $CALL $KTSK$,(#$CTCB) ELSE $CALL $KTSK$,(%T) ENDI ENDM * ****** $ENQUE .QCBAD $LOD R1,=#DCB,R5 LI R1,DCB & A R5,R1 * $LOD R1,:DCB MOV *DCB,R1 OR MOV @DCB($BASE)&MOV *R1,R1 * $LOD R1,#DCB MOV @DCB,R1 * $LOD R1,:#DCB MOV @DCB,R1 & MOV *R1,R1 * $LOD R1,:#DCB,R5 MOV @DCB(R5),R1 & MOV *R1,R1 DMAC .L $LOD .R,.N,.B IF '.N'-' ' ELSE IF $NULL IF .N/16 IF '.B'-' ' IF .R-.N IF '.L'-' ' ELSE .L ENDI R,.ADELAD,.PRIORT DMAC .L $ENQUE .Q,.A,.P .L $CALL $ENQ,(%Q,%A,%P) ENDM * ****** $DEQUE .QCBADR,.QELAD DMAC .L $DEQUE .Q,.D .L $CALL $DEQ,(%Q,%D) ENDM * ****** $SRCHQ .R1QAD,.R2KEY,.R3OFF,.QADDR DMAC .L $SRCHQ .Q,.K,.O,.A .L $CALL $SRCQ$,(%Q,%K,%O),(.A) ENDM * * DMAC *.L $WAIT .WCB *.L * $CALL $WAIT$,(%WCB) * ENDM * * DMAC *.L $POST .WCB *.L * $CALL $POST$,(%WCB) * ENDM * *  ELSE .L MOV .N,.R ENDI ELSE .L MOV @.N($BASE),.R ENDI ELSE .L MOV @.N($BASE),.R ENDI ENDI IF $EQUAL IF $HASH .L LI .R,.N IF '.B'-' ' ELSE A .B,.R ENDI ELSE .L LI .R,.N ENDI ENDI IF $COLON IF $HASH IF '.B'-' ' .L MOV @.N,.R ELSE MOV @.N(.B),.R ENDI ELSE IF  TIMER FUNCTION CALL MACROS * ****** $STTMR .NUMBR,.UNIT,.BADR,.EXADDR DMAC .L $STTMR .N,.U,.T,.E .L $LOD R0,%N $LOD R1,%U $LOD R2,%T $LOD R3,%E BLWP @$$STTM ENDM * DMAC .L $CLTMR .TCB .L $LOD R1,%TCB BLWP @$$CLTM ENDM * IF $$FIO IF $$LIST PAGE ENDI ******************************** * * MULTIPLE VALUE DCB STATUS TEST * CHECK UP TO 5 ERROR CONDITIONS * * THE 1ST P .N/16 .L MOV *.N,.R ELSE MOV @.N($BASE),.R ENDI ENDI MOV *.R,.R ENDI IF $HASH IF $COLON ELSE IF $EQUAL ELSE IF B'-' ' MOV @.N,.R ELSE .L MOV @.N(.B),.R ENDI ENDI ENDI ENDI ENDI ENDM * * SUSPEND TASK * DMAC .L $BLOCK .L BLWP @$BLOKT ENDM * * SET TASK READY TO RUN * DMAC .L :     ****************** FILE PASSWORD $Z SETV $ TT '.FPW' $X SETV $-$Z $X SETV $FDFAC-$FDFPW-$X IF $X ELSE BYTE ' '!$X ENDI ********************** FILE ACCESS REQUESTED IF '.FAC'-' ' BYTE 0 ELSE BYTE .FAC ENDI ENDI ENDM IF $$LIST PAGE ENDI IF $$LIST PAGE ENDI * * THE FOLLOWING MACROS PERFORM SETUP OF DCB'S FOR I/O FUNCTIONS, * CALL THE LE INDEX NUMBER * TERMINAL * (NAMPTR,PACKNAM,DIRNAM,DIRPASS,FILNAM,FILPAS) * REQUIRED * OPCODE * FUNCTION * IF A NAME POINTER IS DEFINED, A NAME SPACE WILL BE GENERATED * WITH THE NAME FORMATTED DMAC .L $DCB .BF=0,.LN=0,.FI=>FF,.RQ=0,.OP=$DIROP,.FN=$FNDIR EVEN .L $Z SETV $ DATA 0 DATA .LN DATRAFFIC CONTROLLER, AND TEST SUBSEQUENT STATUS CONDITIONS *THEY ALL TAKE ESSENTIALLY THREE PARAMETERS * THE 1ST PARAMETER IS THE DCB NAME, IN LOD FORMAT, IT GOES INTO R1 * THIS MAY INCLUDE CHANGES TO THE CONTENTS OF THE DCB IN THE FORMAT * REQUIRED BY $DCBCG * THE 2ND PARAMETER IS THE ERROR PROCESSING, IN THE FORMAT REQUIRED BY * $TEST * * EXAMPLE: $OPEN (=#DCB,=#BUF1,=#512),(($STOK,GDOPN),($STNFD,NXOPN)) * $READ (=#DCB),($STOK,GDREAD) * $TRUNR ($R5,,,(COUNT,@)) TA 0,0 DATA 0 BYTE .FI BYTE 0 BYTE .RQ BYTE .OP BYTE .FN BYTE 0 DATA 0 EVEN $X SETV $ IF '.BF'-'0' ELSE RORG $Z $NAME $X,.BF ENDI ENDM * * THIS MACRO SETS A DCB NAME POINTER AND FORMATS THE VARIOUS PARTS OF A FILE * DESCRIPTOR * * THE 1ST PARAMETER IS THE OFFSET FROM THE CURRENT LOC TO THE NEXT AVAILABLE * LOCATION IN MEMORY. IF IT IS SUPPLIED, THE LABEL FOR TH SET READ-WRITE POINTER * $WRITE ,($STOK,WRT) USE REGISTER 1 * I-O MACRO NAMES ARE: $OPEN OPEN EXISTING FILE * $CREAT OPEN EXISTING OR CREATE NEW * $CLOSE * $DELET (DELETE FILE) * $RENAM * $CLOSP CLOSE & SUBMIT TO SPOOLER * $READ RE FILE DESCRIPTOR WILL * BE SET INTO MEMORY AT CURRENT LOCATION AND THE ADDRESS POINTER WILL BE * BUMPED UP TO THE NEXT MEMORY ADDRESS BEFORE THE FILE DESCRIPTOR IS EXPANDED * * IF NO NAMES ARE SUPPLIED, ONLY .PTR, NO EXPANSION IS DONE * * THE 2ND PARAMETER IS THE LABEL FOR THE FILE DESCRIPTOR * THE 3RD PARAMETER IS THE PACK NAME * THE 4TH PARAMETER IS THE DIRECTORY NAME * THE 5TH PARAMETER IS THE DIRECTORY PASSWORD * THE 6TH PARAMETER IS THE FILE NAME * THE 7TH PARAMETER IS THE FILE TYPE * THE 8TH PARAMETEAD SEQUENTIAL * $WRITE WRITE SEQUENTIAL * $DEL DELETE AT CURRENT POSITION * $IWRIT INSERT WRITE AT CURRENT PSN * $TRUNC TRUNCATE AT CURRENT POSITION * $READR READ RANDOM * $WRTR WRITE RANDOM * $DELR DELETE RANDOM * ER IS THE FILE PASSWORD * THE 9TH PARAMETER IS THE REQUIRED FIACCESS * THE 10TH PARAMETER IS THE SHARED/EXCLUSIVE SETTING * THE 11TH PARAMETER IS THE REQUIRED DIRECTORY ACCESS * * * UNSPECIFIED FIELDS ARE SET TO BLANKS * DMAC $NAME .X,.PTR,.PN,.DN,.DPW,.FN,.T,.FPW,.FAC,.SHR,.DAC IF '.X'-' ' EVEN ELSE DATA .PTR RORG .X ENDI $Y SETV '.PN'-' ' $Y SETV $Y+'.DN'-' ' $Y SETV $Y+'.DPW'-' ' $Y SETV $Y+'.FN'-' ' $Y  $IWRTR INSERT WRITE RANDOM * $TRUNR TRUNCATE RANDOM * $POSIT POSITION * $WRTEF WRITE AT END OF FILE * $PSNEF POSITION TO END OF FILE * $LOAD LOAD PROG OR OVERLAY * $EXIT TERMINATE PROCESS ???? * $INUSE GET  SETV $Y+'.T'-' ' $Y SETV $Y+'.FPW'-' ' $Y SETV $Y+'.DAC'-' ' $Y SETV $Y+'.FAC'-' ' $Y SETV $Y+'.SHR'-' ' IF $Y ELSE ********************** PACKNAME SETUP $Z SETV $ .PTR TEXT '.PN' $X SETV $-$Z $X SETV $FDDIR-$FDPID-$X IF $X ELSE BYTE ' '!$X ENDI ********************** DIRECTORY NAME SETUP $Z SETV $ TEXT '.DN' $X SETV $-$Z $X SETV $FDDPW-$FDDIR-$X IF FUT NAME IN USE * $ASGN ASSIGN NAME TO FIN * $FSPEC FORMAT NAME AND ASSIGN TO FIN ***************************************************************************** * SET FLAG AND FIN * DMAC $SF .C,.F IF '.C'-' ' LI R2,>0200 ELSE IF '.C'-'C' $LOD R2,%F AI R2,>0100 ELSE IF '.F'-' ' CLR R2 ELSE $LOD R2,%F  $X ELSE BYTE ' '!$X ENDI ********************** DIRECTORY PASSWORD SETUP $Z SETV $ TEXT '.DPW' $X SETV $-$Z $X SETV $FDDAC-$FDDPW-$X IF $X ELSE BYTE ' '!$X ENDI ********************* DIRECTORY REQUIRED ACCESS IF '.DAC'-' ' BYTE 0 ELSE BYTE .DAC ENDI ********************* FILENAME SETUP $Z SETV $ TEXT '.FN' $X SETV $-$Z $X SETV $FDTYP-$FDFIARAMETER IS THE DEFAULT ERROR ADDRESS * THE 2ND AND 3RD, 4TH D 5TH, ETC. ARE ERROR CONDITIONS IN THE FORM: * 'ERROR CONDITION, ERROR ADDRESS' AS REQUIRED BY $$TEST. * * EXAMPLE: $TEST BAD,NFD,OPNEXT,OK,OPGOOD * DMAC .L $TEST .A,.V1,.X1,.V2,.X2,.V3,.X3,.V4,.X4,.V5,.X5 .L BL @$$TST $$TEST .V1,.X1 $$TEST .V2,.X2 $$TEST .V3,.X3 $$TEST .V4,.X4 $$TEST .V5,.X5 DATA .A,0 ENDM DMAC $$TEST .V,.A IF '.V'-' ' L-$X IF $X ELSE BYTE ' '!$X ENDI ********************* TYPE SETUP IF '.T'-' ' BYTE $FTTXT ELSE BYTE $FT.T ENDI ******************** SHARED ACCESS FLAG SETUP IF '.SHR'-' ' $Z SETV 1 EXCLUSIVE ELSE $Z SETV 2 SHARED ENDI IF '.SHR'-'SCRATCH' $Z SETV 3 SCRATCH FILE ONLY IF 'SCRATCH' SPECFD ENDI BYTE $Z *** ELSE DATA $ST.V,.A ENDI END IF $$LIST PAGE ENDI * * THIS MACRO CREATES A DCB DATA AREA WITH PRESET DEFAULT OR SPECIFIED VALUES. * IT WILL ALSO CREATE A FORMATTED NAME * * THE PARAMETERS ARE ALL TAKEN AS VALUES, NO REGISTERS OR BASED LABELS. * THE DCB NAME IS IN THE LABEL FIELD, UNSET PARAMETERS ALL HAVE DEFAULT VALUES * THE ORDER OF PARAMETERS IS: BUFFER ADDRESS * BUFFER LENGTH * FI:      ENDI MOV R2,@$DCBRW+2(R1) IF '.C'Z' CLR R2 ELSE SETO R2 ENDI ENDI ENDI MOV R2,@$DCBLN(R1) ENDM * * FILE IN USE * DMAC .L $INUSE .D,.E .L $DCBCG %D $IO (256*$FLFIU+$FNMSC),(%E) ENDM * * FILE SPECIFICATION * DMAC .L $FSPEC .D,.E,.C,.P .L $DCBCG %D $SF .C IF '.P'-' ' MOV @$CMPTR,@$DCBRW(R1) ELSE $LOD R2,%P MOV IO),(%E) ENDM * * WRITE AT CURRENT POSITION * DMAC .L $WRITE .D,.E,.A .L $DCBCG %D IF '.A'-' ' LI R2,1 ELSE $LOD R2,.A ENDI MOV R2,@$DCBSS(R1) $IO (256*$IOWRS+$FNFIO),(%E) ENDM * * INSERT WRITE AT CURRENT POSITION * DMAC .L $IWRIT .D,.E,.A .L $DCBCG %D IF '.A'-' ' LI R2,1 ELSE $LOD R2,.A ENDI MOV R2,@$DCBSS(R1) $IO (256*$IOIC R2,@$DCBRW(R1) ENDI IO (256*$FLSPC+$SC),(%E) IF '.P'-' ' A @$DCBSS(R1),@$CMPTR ENDI ENDM * * FSOPT MACRO * USED WITH COMMAND LINE TO BRANCH IF COMMAND LINE PTR POINTS TO SEMICOLON * DMAC .L $FSOPT .A .L MOV @$CMPTR,R1 LI R0,>3B00 CB *R1+,R0 JNE $+6 BL @.A ENDM * * THIS MACRO IS USED TO SET THE TIME AT A SPECIFIC DATA TERMINAL * DMAC .L $SETTM .D,.E .L $DCP+$FNFIO),(%E) ENDM * * TRUNCATE FROM CURRENT POSON * DMAC .L $TRUNC .D,.E .L $DCBCG %D $IO (256*$IOTCP+$FNFIO),(%E) ENDM IF $$LIST PAGE ENDI * * READ SPECIFIED POSITION * DMAC .L $READR .D,.E .L $DCBCG %D $IO (256*$IORDR+$FNFIO),(%E) ENDM * * WRITE SPECIFIED POSITION * DMAC .L $WRITR .D,.E,.A .L $DCBCG %D IF '.A'-' ' LI R2,1 ELSE $LOD R2,.A BCG %D $IO (256*$FLSET+$FNMSC),(%E) ENDM * THIS MACRO WILL GET THE TIME INTO A SPECIFIC BUFFER * DMAC .L $GETTM .D,.E .L $DCBCG %D WAL150382 $IO (256*$FLGET+$FNMSC),(%E) WAL150382 ENDM * * ASSIGN * INITIALIZATION PARAMETER .FLAG CONSISTS OF THE FLAG Z, ZERO OR C, COPY * $ASGN .DCB,.ERROR,.CONDITION DMAC .L $ASGN .D,.E,.C .L $DCBCG %D $SF ENDI MOV R2,@$DCBSS(R1) $IO (256*$IOR+$FNFIO),(%E) ENDM * * DELETE FROM SPECIFIED POSITION * DMAC .L $DELR .D,.E .L $DCBCG %D $IO (256*$IODSP+$FNFIO),(%E) ENDM * * INSERT WRITE AT SPECIFIED POSITION * DMAC .L $IWRTR .D,.E,.A .L $DCBCG %D IF '.A'-' ' LI R2,1 ELSE $LOD R2,.A ENDI MOV R2,@$DCBSS(R1) $IO (256*$IOISP+$FNFIO),(%E) ENDM * * TRUNCATE FROM SPE .C $IO (256*$FLAGN+$FNMSC),(%E) ENDM * CREATE * DMAC .L $CREAT .D,.E .L $DCBCG %D $IO (256*$DIRCR+$FNDIR),(%E) ENDM * * OPEN * DMAC .L $OPEN .D,.E .L $DCBCG %D $IO (256*$DIROP+$FNDIR),(%E) ENDM * * CTEXT * DMAC .L $CTEXT .D,.E .L $DCBCG %D $IO (256*$DIRCW+$FNDIR),(%E) ENDM * * CLOSE * DMAC .L $CLOSE .D,.E .L $DCBCG %D $IO (256*$DIRCL+$FNDIR),(%E) ENCIFIED POSITION * DMAC .L $TRUNR .D,.E .L DCBCG %D $IO (256*$IOTSP+$FNFIO),(%E) ENDM * * POSITION TO SPECIFIED POSITION * DMAC .L $POSIT .D,.E .L $DCBCG %D $IO (256*$IOSTP+$FNFIO),(%E) ENDM * * WRITE TO END OF FILE * DMAC .L $WRTEF .D,.E,.A .L $DCBCG %D IF '.A'-' ' LI R2,1 ELSE $LOD R2,.A ENDI MOV R2,@$DCBSS(R1) $IO (256*$IOAPP+$FNFIO),(%E) ENDM *DM * * CLOSE AND SUBMIT FOR SPOOLING * DMAC .L CLOSP .D,.E .L $DCBCG %D $IO (256*$DIRSS+$FNDIR),(%E) ENDM * * DELETE FROM DIRECTORY * DMAC .L $DELET .D,.E .L $DCBCG %D $IO (256*$DIRDE+$FNDIR),(%E) ENDM * * UPDATE FILE WITHOUT CLOSING IT DPG201282 * DMAC .L $UPDAT .D,.E .L $DCBCG %D $IO (256*$DIRUP+$FNDIR),(%E) ENDM * * RENAME FILE * DMAC .L $RENAM .D,.E .L * POSITION FILE TO END * DMAC .L $PSNEF .D,.E.L $DCBCG %D $IO (256*$IOPSE+$FNFIO),(%E) ENDM * * RETURN EOF VALUE TO A PROGRAM * DMAC .L $EOFPT .D,.E .L $DCBCG %D $IO (256*$IOSTE+$FNFIO),(%E) ENDM * * LOAD, RETURN * ADD MEMORY BANK PARAM 100481DPG DMAC .L $LOAD .D,.E,.R,.S,.A,.B .L $DCBCG %D $X SETV 0 IF '.R'-'Y' $X SETV $X+>4000 ENDI I $DCBCG %D $IO (256*$DIRNM+$FNDIR),(%E) NDM * * LOCK A FILE RECORD, NOTE THAT ZERO LENGTH INDICATES FULL FILE LOCK * DMAC .L $RLOCK .D,.E .L $DCBCG %D $IO (256*$DIRLK+$FNDIR),(%E) ENDM * * UNLOCK A FILE RECORD * DMAC .L $RUNLK .D,.E .L $DCBCG %D $IO (256*$DIRUL+$FNDIR),(%E) ENDM * * RETURN NUMBER OF FREE BLOCKS (ALUS) ON DISK DPG201282 * DMAC .L $SPACE .D,.E .L $DCBCG %D F '.S'-'Y' $X SETV $X+>8000 ENDI '.A'-'N' $X SETV $X+>2000 ENDI IF '.A'-'S' $X SETV $X+>3000 ENDI IF '.B'-' ' MOVB @$CBANK,R2 SRL R2,8 ELSE $LOD R2,%B ENDI AI R2,$X MOV R2,@$DCBSS(R1) $IO (256*$PROLD+$FNPRO),(%E) ENDM * * SEND MESSAGE (REQUEST) TO SPOOLER * DMAC .L $SPLRQ .D,.E,.A .L $DCBCG %D IF '.A'-' '  $IO (256*$DIRSP+$FNDIR),(%E) ENDM * * READ CURRENT POSITION * DMAC .L $READ .D,.E .L $DCBCG %D $IO (256*$IORDS+$FNFIO),(%E) ENDM * * READ CURRENT POSITION INTO SPECIFIED BUFFER * * DMAC *.L $RDSBF .D,.E *.L $DCBCG %D * $IO (256*$IORSB+$FNFIO),(%E) * ENDM * * READ PASSWORD * DMAC .L $RDPSW .D,.E,.N,.REP=1 .L $DCBCG %D IF '.N'-' ' ELSE $LOD R2,%N MOV R2,@$DCBRW(R1) ENDI ELSE $LOD R2,%A MOVB R2,@BID(R1) ENDI $IO (256*$DBSPL+$FNTRX),(%E) ENDM * * EXIT * DMAC .L $EXIT .D .L $DCBCG %D LI R2,256*$PROEX+$FNPRO BL @$$IO * MOVB R2,@$DCBOP(R1) * SWPB R2 * MOVB R2,@$DCBFN(R1) * $CALL $UTTC,R1 ENDM ENDI ENDIF FOR $$FIO SECTION * IF $$DDA IF $$LIST PAGE ENDI * * DIRECT DISK ACCESS MACROS * LI R2,16*.REP MOV R2,@$DCBLN(R1) $IO (256*$IORPW+$FNFIO),(%E) ENDM * * WRITE PASSWORD * DMAC .L $WTPSW .D,.E,.N,.REP=1 .L $DCBCG %D IF '.N'-' ' ELSE $LOD R2,%N MOV R2,@$DCBRW(R1) ENDI LI R2,16*.REP MOV R2,@$DCBLN(R1) $IO (256*$IOWPW+$FNFIO),(%E) ENDM * * DELETE FROM CURRENT POSITION * DMAC .L $DEL .D,.E .L $DCBCG %D $IO (256*$IODCP+$FNF;      ENDI IF '.P1'-'LT' JGT $++2 JEQ $+.L1 ENDI ENDM * * * MISC MACROS THAT COULD COME IN HANDY SOME TIME * * * * JGE - JUMP IF GREATER THAN OR EQUAL TO... * DMAC .L JGE .LOC .L JGT .LOC JEQ .LOC ENDM * * * JEL JUMP IF LESS THAN OR EQUAL TO... * DMAC .L JEL .LOC .L JLT .LOC JEQ .LOC ENDM * * * * END OF MACRO FILE LIST * ,$ABSRD,(%PHY) WAL150382 ENDM * DM .L $DSKWR .DCB,.ALU,.OFST,.E,.P,.PHY WAL150382 .L $DIRFN (%DCB),(%ALU),(%OFST),(%E),(%P),$ABSWR,(%PHY) WAL150382 ENDM * DMAC .L $DSKRS .DCB,.ALU,.OFST,.E,.P .L $DIRFN (%DCB),(%ALU),(%OFST),(%E),(%P),$ABSRS ENDM * DMAC .L $DSKFM .DCB,.ALU,.OFST,.E,.P,.PHY WAL150382 .L $DIRFN (%DCB),(%ALU),%OFST,(%E),(%P),$ABSFM,(%PHY) WAL150382 ENDM * DMAC .L $DSKCS .DCB,.ALU,.OFST,.E,.P,.PHY WAL150382 .L $DIRFN (%DCB),(%ALU),(%OFST),(%E),(%P),$ABSCS,(%PHY) WAL150382 ENDM * DMAC .L $DSKST .DCB,.ALU,.OFST,.E,.P .L $DIRFN (%DCB),%ALU,%OFST,(%E)%P),$ABSST,,$DPTSZ ENDM * DMAC .L $DSKVL .DCB,.ALU,.OFST,.E,.P .L $DIRFN (%DCB),%ALU,%OFST,(%E),(%P),$ABSVL,,$DPTSZ ENDM * DMAC .L $DSKWC .DCB,.ALU,.OFST,.E,.P,.PHY WAL150382 .L $DIRFN (%DCB),(%ALU),(%OFST),(%E),(%P),$ABSWC,(%PHY) WAL150382 ENDM * DMAC .L $DSKUP .DCB,.ALU,.OFST,.E,.P .L $DIRFN (%DCB),%ALU,%OFST,(%E),(%P),$ABSUP,,$DPTSZ ENDM * * ENDI END FOR $$DDA * IF $$LIST PAGE ENDI * * * CONVERT ASCII DECIMAL AT .PTR TO 16 BIT BINARY, * RETURN IN R2 * DMAC .L $GTNUM .PTR .L $LOD R1,%PTR BLWP @$$GTNM ENDM * * * CONVERT 16 BIT BINARY NUMBER IN R2 TO ASCII AT .PTR, USING THE * LEAST SIGNIFICANT .CNT BYTES (I.E. LEFT TRUNCATION) * DMAC .L $CNVDC .PTR,.CNT,.VAL .L $LOD R2,%VAL $LOD R1,%PTR $LOD R3,%CNT BLWP @$$CNVD ENDM * * * CONVERT STANDARD DATE STRING AT .PTR TO PACKED FORMAT IN R2 * RETURNING TO .ERR IF IMPROPER FORMAT * DMAC .L $DTBIN .PTR,.ERR .L $LOD R1,%PTR BLWP  LIST * * LAST CHANGED 08 JUN 83 DPG * UNL IF $$LIST LIST PAGE TITL 'OMNINET SYSTEM DEFINITIONS' ENDI **************************************************************** * * * ***** * * ****** ***** ****** ****** * * * * * * * * * * * * * * * * * * * * * * * * ****** *  @$$DTBN IF '.ERR'-' ' DATA 0 ELSE DATA .ERR ENDI ENDM * * CONVERT CURRENT DATE IN PACKED BINARY IN R2 TO ASCII * AT R1 LOCATION * DMAC .L $BNDAT .D,.PTR .L $LOD R2,%D $LOD R1,%PTR BLWP @$$BNDT ENDM * * * COMPUTE PID CHECKSUM STARTING AT .PTR * RETURN CHECKSUM IN R2 * DMAC .L $CMPCS .PTR .L $LOD R1,%PTR BL @$$CMCK ENDM * * * COMPUTE HASH ADDR ****** * * **** **** * * * * * * * * * * * * * * * * * * * * * ****** * ****** ***** ****** * * * * * (COMMON) * **************************************************************** * * REGISTER EQUATES * $R0 EQU R0 $R1 EQU R1 $R2 EQU RESS FOR FILENAME BEGINNING AT .PTR, * WHERE .MOD IS THIRECTORY MODULUS (LENGTH IN SECTORS), * AND .SPA IS SECTORS/ALU FOR THE DEVICE, * RETURNING RELATIVE ALU IN R1, SECTOR OFFSET IN R2 * DMAC .L $HASHN .PTR,.MOD,.SPA .L $LOD R1,%PTR $LOD R2,%MOD $LOD R3,%SPA BL @$$HASH ENDM * * * BRANCH TO SYSTEM ERROR ON PARTICULAR STATUS FLAGS * DMAC .L $SYSER .P1,.P2 .L IF '.P1'-' ' * IF '.P2'-' ' B DMAC .L $DIRFN .DCB,.ALU,.OFST,.P,.OP,.PHY,.LEN $DCBCG %DCB IF '.LEN'-' ' IF '.ALU'-' ' ELSE $LOD R2,%ALU MOV R2,@$DCBRW+2(R1) ENDI IF '.OFST'-' ' ELSE $LOD R2,%OFST MOV R2,@$DCBRW(R1) ENDI ELSE LI R2,.LEN MOV R2,@$DCBLN(R1) ENDI IF '.P'-' ' $X SETV 0 WAL150382 ELSE $LWP @$$SYSR ELSE $SMAC .P2,6 BP @$$SYSR ENDI * ELSE * IF '.P2'-' ' $SMAC .P1,6 BLWP @$$SYSR ELSE $SMAC .P1,8 $SMAC .P2,6 BLWP @$$SYSR ENDI * ENDI ENDM * * DMAC $SMAC .P1,.L1 IF '.P1'-'EQ' JNE $+.L1 ENDI IF '.P1'-'NE' JEQ $+.L1 ENDI IF '.P1'-'GT' JLT $+.L1+2 JEQ $+.L1 X SETV >8000 WAL150382 ENDI IF '.PHY'-' ' WAL150382 ELSE $X SETV $X+>100 WAL150382 ENDI $IO (256*.OP+$FNABS+$X),(%E) WAL150382 ENDM * DMAC .L $DSKRD .DCB,.ALU,.OFST,.E,.P,.PHY WAL150382 .L $DIRFN (%DCB),(%ALU),(%OFST),(%E),(%P);     2 $R3 EQU R3 $R4 EQU R4 $R5 EQU R5 6 EQU R6 $R7 EQU R7 $R8 EQU R8 $R9 EQU R9 $BASE EQU R10 $RET EQU R11 $RCRU EQU R12 $RWP EQU R13 $RPC EQU R14 $RST EQU R15 * * SYSTEM DATA AND ADDRESS DEFINTIONS * $BLKDF >100 COMMON SECTION BETWEEN DDS AND UT LOS $OFFDF $DDPRG,6 NAME BEING PASSED $OFFDF $FUT0,>4E **$FUTSZ SIGN-ON FILE USE ENTRY PASSED $PASS EQU >FF00 FG,2 IF ZERO, IS FIRST TIME THROUGH COMHAN. $OFFDF $CKDSK,2 TEMPORARY - DJ SHOULD VALIDATE DISKETTES $OFFDF $LDERR,2 MSB=STATUS OF LOAD, LSB=STATUS OF CLOSE(S) $OFFDF $CURCL,2 CURRENT CURSOR COLUMN $OFFDF $CURLN,2 CURRENT CURSOR LINE $OFFDF $PRGSV,2 PREVIOUS PROGRAM BASE (SAVED BY DEBUG) * * $CALL SUBROUTINE VECTORS * $OFFDF $CALSB,2 CALL SUBROUTINE $OFFDF $RETSB,2  PASS AREA FOR LOS1 - PATHING RPG161280 FFDF $DWPPC,4 DDSLOS CONTROL BLOCK $OFFDF $DSTRT,0 START OF DDS LOS SYSTEM DEFINITIONS $BLKDF 512+4 $OFFDF $MASKS,0 * * MISCELLANEOUS CONSTANTS AVAILABLE TO ALL ROUTINES IN MEMORY * $OFFDF $ZERO,2 $OFFDF $C2P0,2 $K1 EQU $C2P0 $OFFDF $C2P1,2 $K2 EQU $C2P1 $OFFDF $C2P2,2 $K4 EQU $C2P2 $OFFDF $C2P3,2 $K8 EQU $C2P3 $OFFDF $C RETURN FROM SYSTEM CALL $OFFDF $CRTS$,2 CREATE TASK $OFFDF $KTSK$,2 KILL TASK $OFFDF $RCV,2 BUS RECEIVE $OFFDF $ENQ,2 ENQUEUE $OFFDF $DEQ,2 DEQUEUE $OFFDF $SRCQ$,2 SEARCH A QUEUE $OFFDF $BCALS,2 CALL SUBROUTINE W/MEM BANK CHANGE DPG090681 $OFFDF $GETKY,2 SUBR ENTRY POINT FOR KEYIN FUNC DPG170682 $OFFDF $$GET,2 GET SYSTEM RESOU2P4,2 $K16 EQU $C2P4 $H10 EQU $C2P4 $OFFD $C2P5,2 $K32 EQU $C2P5 $H20 EQU $C2P5 $OFFDF $C2P6,2 $K64 EQU $C2P6 $H40 EQU $C2P6 $OFFDF $C2P7,2 $K128 EQU $C2P7 $H80 EQU $C2P7 $OFFDF $C2P8,2 $K256 EQU $C2P8 $H100 EQU $C2P8 $OFFDF $C2P9,2 $K512 EQU $C2P9 $H200 EQU $C2P9 $OFFDF $C2P10,2 $K1024 EQU $C2P10 $H400 EQU $C2P10 $OFFDF $C2P11,2 $K2048 EQU $C2P11 $H800 EQU $C2P11 RCE $OFFDF $$FREE,2 RELEASE SYSTEM RESOE $OFFDF $UTTC,2 APPLICATION ENTRANCE TO USER TERMINAL T.C. $OFFDF $DTLOC,2 T.C. ENTRANCE TO DATA TERMINAL T.C. $OFFDF $DISK,2 DISK DRIVER $OFFDF $FLSYS,2 FILE SYSTEM $OFFDF $TRANS,2 BUS TRANSMIT $OFFDF $DBTR,2 DATA BLOCK TRANSMIT/RECEIVE 230381WAL $OFFDF $MISC,2 MISCELLANEOUS FUNCTIONS * * BL - SUBROUTI $OFFDF $C2P12,2 $K4096 EQU $C2P12 $H1000 EQU $C2P $OFFDF $C2P13,2 $K8192 EQU $C2P13 $H2000 EQU $C2P13 $OFFDF $C2P14,2 $H4000 EQU $C2P14 $OFFDF $C2P15,2 $H8000 EQU $C2P15 * * USEFUL CONSTANTS * $OFFDF $K3,2 $OFFDF $K5,2 $OFFDF $K7,2 $OFFDF $K9,2 $OFFDF $K10,2 $OFFDF $HFFFF,2 PAGE * * GLOBAL DATA * $OFFDF $CTCB,2 CURRENTLY ACTIVE TCB POINTER $OFFDF $TCBQ,2 NE VECTORS * $OFFDF $DRCHK,4 SPOOLEDRIVER CHECK FLAGS ROUTINE 230381WAL $OFFDF $TERMI,4 TERMINATE REQUEST TO UT $OFFDF $$CLER,4 CLEAR BUFFER TO CONSTANT $OFFDF $$MOVE,4 MOVE STRING OF BYTES $OFFDF $$COMP,4 COMPARE TWO BYTE STRINGS $OFFDF $$HASH,4 HASH FILENAME $OFFDF $$CMCK,4 COMPUTE PID CHECKSUM $OFFDF $$TST,4 TEST STATUS OF IN R1 $OFFDF $$IO,4  POINTER TO HEAD OF TCB QUEUE $OFFDF $SYSBF,2 POINTER TO QUEUE OF SYSTEM BUFFERS $OFFDF $DPT,2 $OFFDF $DPTND,2 $OFFDF $DATE,2 CURRENT DATE IN OMNIDATA FORMAT $OFFDF $SBFLN,2 NO. OF BYTES IN A SYSTEM BUFFER $OFFDF $DFALC,2 DEFAULT NUMBER OF ALU'S TO ALLOCATE TO NEW FI $OFFDF $PROGS,2 PROGRAM LOAD ADDRESS $OFFDF $CHNFL,2 IF NON-ZERO, COMMAND CHAINING IN PROGRESS $OFFDF $CHNPT, CALL TRAFFIC CONTROLLER WITH R1 $OFF $DEBUX,4 DEBUGGER ENTRANCE $OFFDF $BCHST,4 BANK POP, THEN CHANGE STATE WAL171081 $OFFDF $DBGKY,4 DEBUGGER KEY ENTRY $OFFDF $TSCHR,4 KEYBOARD CHARACTER READY TEST $OFFDF $ERMSG,4 DISPLAY ERROR MESSAGE ON OMNIFILE WAL091282 $OFFDF $DRVXT,4 DRIVER EXIT ROUTINE * * BLWP - SUBROUTINE VECTORS * $OFFDF $$DTBN,4 CONVERT DA4 RWP FOR CHAIN FILE IF CHAINING $OFFDF $HN,2 CHAINING SHOULD BE ABORTED BEFORE NEXT COMMAD $OFFDF $TID,1 TERMINAL ID (OBTAINED FROM BUS) $OFFDF $DTTID,1 DATA TERMINAL ID OF DT CONTROLLING UT $OFFDF $LGDON,2 TERMINAL HAS BEEN LOGGED ON $OFFDF $CLOCK,9 TIME OF DAY HH:MM:SS $CL8MS EQU $CLOCK+8 8.333 MSEC VALUE -ROLLOVER AT 120D DPG060981 $OFFDF $MXDAX,12 NUMBER OF DAYS TE TO OMNIDATA PACKED BINARY $OFFDF $$GTNM,4 CONVERT ASCII NUMBER TO 16 BIT BINARY $OFFDF $$SYSR,4 BRANCH TO SYSTEM ERROR ROUTINE $OFFDF $$CNVD,4 CONVERT 16 BIT BINARY TO ASCII $OFFDF $$STTM,4 SET TIMER $OFFDF $$CLTM,4 CLEAR TIMER $OFFDF $BLOKT,4 SUSPEND TASK $OFFDF $$BNDT,4 CONVERT BINARY DATE TO ASCII $OFFDF $DSPLX,4 DISPLAY STRING $OFFDF $KEYIX,4 IN EACH MONTH DPG060981 $MXDAY EQU $MXDAX-1 DPG060981 $OFFDF $TMPSB,1 DO NOT REF - TEMP SYSTEM BANK BYTE DMT161181 $OFFDF $SYSBK,1 NEW LOC FOR SYSTEM BANK # DMT161181 $OFFDF $USRBK,1 USER BANK #'S DMT161181 $OFFDF $BKALL,2 ALLOCATED MEMORY BANKS DMT161181 $OFFDF $NOBKS,2 NUMBER OF MEMORY BANKS WAL1512 KEYIN STRING $OFFDF $GTCHX,4 INPCHARACTER FROM KEYBOARD $OFFDF $PTCHX,4 OUTPUT CHARACTER TO STRING $OFFDF $CHGST,4 CHANGE STATE WITHOUT BLOCK $OFFDF $GTFLX,4 SPECIAL KEYIN WITH CONTROL LIST WAL111281 $OFFDF $KYNL1,4 KEYIN, LOWER CASE NOT MAPPED $OFFDF $GTDSX,4 GET CHARCTER FROM DISPLAY BUFFER * * COMMAND LINE DATA * $OFFDF $CMPTR,2 COMMAND LINE POINTER 81 $OFFDF $CURON,2 CURSOR ON (LEAVE ON IF N ZERO) WAL270182 $OFFDF $KBMOD,2 KEYBOARD MODE (SHIFT INVERT, ETC) WAL111281 $OFFDF $DPRLN,2 NUMBER OF PROTECTED LINES AT TOP OF DISPLAY $OFFDF $NJOB,2 NUMBER OF ACTIVE JOBS $OFFDF $OFBAS,2 DEBUGGER RELATIVE BASE ADDRESS $OFFDF $OFSTS,16 DEBUGGER MODULE OFFSETS $OFFDF $KTCB,2 TCB BUFFER ADDRESS FOR KILLED JOB $OFFDF $FCH<     3 $OFFDF $Z80IP,4 PAGE/OFFSET OF PARAM TAE FROM Z80 DPG080683 $OFFDF $FU$C4,6 UNUSED - FUTURE VARIABLE SPACE WAL150382 $OFFDF $RTWPB,4 RTWP WITH BANK POP (BRANCH) WAL150382 * * MORE BLWP VECTORS * $OFFDF $USART,4 INITIALIYE USART CB DMT210182 $OFFDF $UTXEN,4 USART TRANSMIT ENABLE JDT230282 $OFFDF $UIDLE,4 USART IDLE SUBR JDT2302CH BUFFERS 260281WAL $OFFDF $NODOT,2 FLAG FOR NO DOTS (INSERT SPACES) WAL040583 $OFFDF $TIMSL,2 TIME-SLICE COUNTER 260281WAL $OFFDF $TPTAB,2 TYPE TABLE ADDRESS POINTER $OFFDF $OPNDF,2 POINTER TO DEFAULT TABLE FOR OPEN FILES $OFFDF $PRGDF,2 POINTER TO PROGRAM PATH TABLE $OFFDF $PRTCB,2 TCB OF TASK USING LOCAL PRINTER $OFFDF $MXMEM,2 ;LWA+1 OF TH82 $OFFDF $BREQ,4 ALLOCATE MEMORY BANKN REQUEST DMT161181 $OFFDF $BRET,4 RELEASE MEMORY BANK ALLOCATED DMT161181 $OFFDF $BMOVE,4 UPPER BANK TO UPPER BANK MEMORY MOVEDPG200681 $OFFDF $BKCHG,4 CHANGE MEMORY BANK DPG090681 $OFFDF $BKIEX,4 EXECUTE INSTR ON ALT MEM BANK DPG090681 $OFFDF $BPUSH,4 CHNG BANK & PUSH CURRENT ON STACK DPG090681 $OFFDF $BPOP,4 IS SYSTEM $OFFDF $SPLFG,2 SPOOLER STATUSLAG (IDLE, ETC) 230381WAL $OFFDF $DRVFG,2 DRIVER STATUS/COMMAND FLAG 230381WAL $OFFDF $DRRWP,4 DRIVER POSITION FOR RESTART 230381WAL $OFFDF $CBANK,1 CURRENT MEMORY BANK DPG090681 $OFFDF $MXBNK,1 MAXIMUM MEMORY BANK NUMBER DPG090681 $OFFDF $DSPTB,2 ADDR OF DISPLAY TBL OF LINE PTRS 290481DPG $OFFDF $DK POP BANK STACK & RET TO PREVIOS BANKDPG090681 * TCB OFFSET DEFINITIONS * $BLKDF 0 $OFFDF $TCNXT,2 LINK TO NEXT TASK $OFFDF $TCRDY,2 TASK READY INDICATOR $OFFDF $TCNUM,2 TASK NUMBER $OFFDF $TCCWP,2 ADDR OF CURRENT REGISTERS $OFFDF $TCPC,2 CURRENT PC $OFFDF $TCST,2 CURRENT STATUS REGISTER $OFFDF $TCCSP,2 STACK POINTER $OFFDF RTY,2 DISK ACCESS RETRYS 290481DPG $OFFDF $BLNKC,1 DISPLAY LINE BLANKING CHAR 290481DPG $OFFDF $MXLOD,1 MAX # OF SYSTEM ALLOCATED TCB DPG090681 $OFFDF $WNTBL,4 SCREEN WINDOWING INHIBIT TABLE WAL081081 $OFFDF $SCROF,2 SCREEN WINDOWING POSITION WAL081081 $OFFDF $TCHPC,2 TIMER CHIP CONTSTANT (OMNI2) 070581DPG $OFFDF $DRVLD,2 DRIVER LO$TCWTQ,2 WAIT QUEUE LINK WORD $OFFDF $BBK,1 MEMORY BANK ALLOCATED TO TASK $OFFDF $TCFRE,1 1 UNUSED BYTE JDT120282 $OFFDF $TCRMD,2 IO VECTOR (0=LOCAL) JDT120282 $OFFDF $TCSZ,2 SIZE OF TCB WAL171281 $OFFDF $TCTMR,2 TIMER COUNTER $OFFDF $TCTMQ,2 TIMER QUEUE LINK $OFFDF $TCTMX,2 TIMER EXECUTAD ADR $OFFDF $KBDBG,2 DISPLAYEBUG FLAG $OFFDF $NXTLD,2 ADDRESS AT END OF LAST LOAD (USED FOR NEXT) $OFFDF $FTPTR,2 FILE USE TABLE ADDRESS POINTER $OFFDF $STOPS,1 STOP STATUS $OFFDF $STOPF,1 STOP FLAG $OFFDF $LNKDT,10 LINK DATE FROM LOADED PROGRAM $OFFDF $MXDRV,2 MAXIMUM DRIVE NO. ON SYSTEM (1-N) $OFFDF $TTYPE,2 TERMINAL TYPE (-1=USER TERMINAL, ELSE DT) ION ADDRESS $OFFDF $TCWPX,2 WP FOR EXIT $OFFDF $TCPCX,2 PC FOR EXIT $OFFDF $TCSTK,352 STACK BASE WAL171281 $TCSIZ SETV $DU TCB SIZE 384(>180) MINIVORE DEFAULT WAL150382 * * GLOBAL DISKETTE CONFIGURATION CONSTANTS * $SPA EQU 6 SECTORS/ALU $BPS EQU 256 BYTES/SECTOR * * GLOBAL SCREEN CONFIGURATION CONSTANTS * $CHPLN EQU 255 CHARACTERS PER L $OFFDF $ERPTR,2 POINTER TO ERROR STATUS BUFFE $OFFDF $SCRLM,1 SCREEN WINDOWING LEFT MARGIN $OFFDF $SCRRM,1 SCREEN WINDOWING RIGHT MARGIN $OFFDF $CHRMO,2 DISPLAY CHARACTER MODE $OFFDF $TSOFF,2 TIME-SLICE CONTROL (0=ENABLED) DPG200681 $OFFDF $USRTN,4 USART PARAMETER TABLES DMT161281 $OFFDF $RTCB1,2 REMOTE TCB #1 JDT120282 $OFFDF $RTCB2,INE $SCRWD EQU 80 CHARACTERS PER LINE ONCREEN $NLINS EQU 24 LINES PER SCREEN * * TIMER UNITS DEFINITIONS * $8MSEC EQU 0 $SECND EQU 1 $MINUT EQU 2 $HOUR EQU 3 * * INTERRUPT LEVELS * $INTOF EQU 4 INTERRUPT OFF LEVEL FOR MOST THINGS * * CHARACTER EQUATES * $CRETX EQU 3 3 END-OF-TEXT $CRBEL EQU 7 7 BELL $CRBSP EQU 8 8 BACKSPACE $CRLF EQU 10 12 A 2 REMOTE TCB #2 JDT120282 $OFFDF $RSTRT,2 BASIC RESTART PC VECTOR JDT120282 $OFFDF $TRDFG,2 FLAG FOR TRD TYPE PRINTER WAL150282 $OFFDF $PPROT,2 POINTER TO PRINTER PROCESS TABLE WAL150282 $OFFDF $PMAPT,2 POINTER TO PRINTER MAPPING TABLE WAL150282 $OFFDF $POVRT,2 POINTER TO PRINTER OVERSTRIKE TABLE WAL150282 $OFFDF $ENDOS,2 POINTE TO END O $OFFDF $CMDLN,258 COMMAND LINE BUFFER $CMLNL EQU 257 ***** * * MORE GLOBAL DATA * ***** $OFFDF $OSLD,8 OPERATING SYSTEM LINK DATE (DD.MM.YY) $OFFDF $LKNAM,6 NAME OF LINKED PROGRAM $OFFDF $UPCLK,1 UT DUMMY JOB FLAG FROM EXEC TO GET TIME $OFFDF $LANG,1 LANGUAGE OF SYSTEM (0=USA) $OFFDF $ATRB,2 ATTRIBUTE BUFFER POINTER $OFFDF $TIM,2 LOWER ORDER TIME SINCE IPL $OFFDF $TIM1,F PRINTER TABLES WAL150282 * (ALSO END OF O/S) WAL150282 $OFFDF $EEOL,2 FLAG FOR AUTO ERASE TO END OF LINE WAL250382 $OFFDF $ATRIB,2 FLAG TO TURN OFF INTLGNT ATTR HANDL DPG030682 $OFFDF $80COL,2 FLAG TO FORCE 80 COLUMN DISPLAY DPG030682 $OFFDF $KBLCK,2 KEYBOARD LOCK FLAG TS 210582 $OFFDF $Z80OP,4 PAGE/OFFSET OF PARAM TABLE TO Z80 DPG080682 MIDDLE ORDER TIME SINCE IPL $OFFDF $TIM2 UPPER ORDER TIME SINCE IPL $OFFDF $SYSTM,1 SYSTEM NAME (0 - OMNIVORE, 1 - OMNI-2) $OFFDF $FDOUT,1 DISABLE FLOPPY DISKS (NON-ZERO = TRUE) $OFFDF $NMITC,2 # OF ITC TASKS FOR DT $OFFDF $ERTCB,2 TCB ADDR OF TASK USING ERROR LINE WAL260882 $OFFDF $BUSBC,2 # OF B INPUT BUFFERS 030281WAL $OFFDF $NMBFS,2 # OF SCRAT<      ROLL SCREEN (LINE FEED) $CRCR EQU 11 15 B CARRIAGE RETURN $CREOL EQU 12 C END OF LINE (CR/LF) $CRCPS EQU 13 D CURSOR POSITION (HOR, VERT) $CRMPS EQU 15 E MESSAGE POSITION $CRUP EQU 16 F MOVE CURSOR UP $CRCRS EQU 30 1E RESTORE CURSOR $CRTOF EQU 12 C TOP OF FORM $CRBUL EQU 244 F4 BEGIN UNDERLINE $CREUL EQU 240 F0 END UNDERLINE $CRCON EQU >19 $ABSRD EQU 2 READ $ABSWR EQU 4 WRITE $ABSWC EQU 6 WRITE COMPARE $ABSFM EQU 8 FORMAT SECTORS $ABSCS EQU 10 CHECKSUM $ABSST EQU 14 DRIVE STATUS $ABSVL EQU 16 VALIDATE PID $ABSUP EQU 18 UPDATE * * * DISK OPERATIONS * $FNDSK EQU 4 FUNCTION CODE $DSKDM EQU 0 LOGICALLY DISMOUNT A DISK $DSKMT EQU  19 CURSOR ON $CRCOF EQU >1A 1A URSOR OFF $CRSPC EQU >20 20 SPACE $CREEL EQU >1D 1D ERASE TO END OF LINE $CREES EQU >1C 1C ERASE TO END OF SCREEN IF $$DEV PAGE * * * CRU BASE ADDRESS DEFINITIONS * $CRUCR EQU >02E0 CRT $CRUKB EQU >0260 KEYBOARD $CRUPR EQU >0000 PRINTER $CRUDF EQU >0040 I DFUE $CRUMF EQU >00A0 MINIFLOPP 1 LOGICALLY MOUNT A DISK * * * OGRAM INITIATION/TERMINATION * $FNPRO EQU 3 LOAD/TERMINATE FUNCTION CODE $PROLD EQU 1 LOAD PROGRAM $PROLO EQU 2 LOAD PROGRAM OVERLAY $PROEX EQU 3 TERMINATE (EXIT) PROGRAM * * * MISCELLANEOUS FUNCTIONS * $FNMSC EQU 6 FUNCTION CODE $FLSPC EQU 0 FILE SPEC $FLAGN EQU 1 FILE ASSIGN (SET NAME) $FLFIU Y $CRUFD EQU >00A0 STANDARD FLOPPY $CRUDEQU >00C0 DMA CHANNEL ENDI IF $$APP * * * DIRECTORY OPERATIONS CODE DEFINITIONS * * * NOTE - THE CLOSE ALL FUNCTIONS MUST BE CONTIGUOUS BECAUSE THE FILSYS * CODE EXPECTS THIS... * $FNDIR EQU 1 DIRECTORY FUNCTION CODE $DIROP EQU 1 OPEN FILE (USING PATHING) $DIRCR EQU 2 CREATE FILE $DIRCL EQU 3 CLOSE FILE $DIRDEEQU 2 FILE IN USE (RETURN NAME) $FOK EQU 3 GENERAL SYSTEM LOCK $FLNLK EQU 4 GENERAL SYSTEM UNLOCK $FLSET EQU 5 SET THE TIME / DATE IN DATA TERMINAL $FLGET EQU 6 RETURN TIME / DATE FROM DATA TERMINAL * * DATA BLOCK TRANSMIT/RECEIVE * $FNTRX EQU 7 FUNCTION CODE $DBSPL EQU 0 SEND SPOOLER FUNCTION WAL091282 $DBTRN EQU 1  EQU 4 DELETE FILE $DIRNM EQU 5 RENAME FILE $DIRCT EQU 6 CLOSE ALL FILES FOR TID $DIRCD EQU 7 CLOSE ALL FILES FOR DRIVE NUMBER $DIRPK EQU 8 CHECK FOR GIVEN PACKNAME ON THIS DT $DIRCW EQU 9 CLOSE FILE WITH PAGE COUNT REWRITE $DIRDF EQU 10 OPEN WITHOUT USING PATHING $DIRCA EQU 11 CREATE WITH PRE-ALLOCATION $DIRTM EQU 12  TRANSMIT DATA BLOCK $DBRCV EQU 2 RECEE DATA BLOCK * * * STATUS RETURN DEFINITIONS *STOK EQU 0 PERFECT COMPLETION $STBSY EQU -1 OPERATION IN PROGRESS $STEOF EQU 1 END-OF-FILE REACHED $STPAR EQU 2 PARAMETER ERROR $STHDW EQU 3 UNRECOVERABLE HARDWARE ERROR $STLOK EQU 4 FILE IS LOCKED $STSSX EQU 5 DISK IS FULL $STNFD EQU 6  TERMINATE OPEN FILE ON BAD CLOSE $DIRLK U 13 ;LOCK A FILE RECORD MDP211081 $DIRUL EQU 14 ;UNLOCK A FILE RECORD MDP211081 $DIRSS EQU 15 CLOSE & SUBMIT TO SPOOLER WAL270182 $DIRGT EQU 16 ;GET CURRENT LOCK POSITION MDP120582 $DIRUS EQU 17 ;GET NUMBER OF USERS OF FILE MDP120582 $DIRMS EQU 18 ;SWITCH MODE OF FILE ACCESS MDP1205 FILE NOT FOUND $STPRO EQU 7 DESIRED/REQUIRED ACCESSES NOT AVAILABLE $STLIM EQU 8 LIMITS EXCEEDED $STTMF EQU 9 TOO MANY FILES OPEN $STBAD EQU 10 UNSPECIFIED FAILURE $STFAC EQU 11 FILE ALREADY EXISTS $STDSK EQU 12 REQUIRED PACK NOT ON-LINE $STBUS EQU 13 NETWORK COMMUNICATIONS FAILURE $STPW EQU 14 INCORRECT PASSWORD $STDOL EQU 182 $DIRRD EQU 19 ;READ DIRECTORY ENTRY MDP20582 $DIRWR EQU 20 ;WRITE DIRECTORY ENTRY (PARTIAL) MDP120582 $DIRSP EQU 21 ;RETURN NUMBER OF FREE BLOCKS ON DISKDPG201282 $DIRUP EQU 22 ;UPDATE FILE INFO W/OUT CLOSING FILE DPG201282 * * * FILE I/O OPERATIONS * $FNFIO EQU 2 FILE I/O FUNCTION CODE $IORDS EQU 0 READ SEQUENTIAL $IODCP EQU 1 DELETE FROM5 DISK UNIT OFF-LINE $STDTO EQU 16 DATA TERMINAL NOT RESPONDING $STFUL EQU 17 DATA TERMINAL FCB SPACE FULL $STFIU EQU 18 STATUS FUT IN USE $STILL EQU 19 ILLEGAL OPERATION CODE $STNDR EQU 20 DIRECTORY NOT FOUND $STFNO EQU 21 FILE NOT OPEN $STBFB EQU 22 BAD FIB ENCOUNTERED ON FILE OPEN $STPTR EQU 23 PARTIAL READ ACCOMPLISHED $S CURRENT POSITION. $IOTCP EQU 2 TRUNCA FROM CURRENT POSITION. $IOWRS EQU 3 WRITE SEQUENTIAL $IOICP EQU 4 INSERT AT CURRENT POSITION. $IOSTE EQU 5 RETURN EOF VALUE FOR FILE. $IORPW EQU 7 READ PASSWORD $IORDR EQU 8 READ RANDOM $IODSP EQU 9 DELETE FROM SPECIFIED POSITION. $IOTSP EQU 10 TRUNCATE FROM SPECIFIED POSITION. $IOWRR EQU 11 TFIC EQU 24 FILE INDEX COPY SPECIFIED TOSPEC $STBTL EQU 25 IMPROPER INSERT SPEC FOR FILE TYPE $STFIN EQU 26 IMPROPER FIN NUMBER $STENQ EQU 27 NET COMM: MAX ENQS ,NO ACKS RX'D $STNTX EQU 28 NET COMM: TRANSMIT FAILURE $STTXM EQU 29 NET COMM: TX RETRIES EXCEEDED, NO ACKS RX'D $STEXC EQU 30 ACCESS DENIED - FILE OPEN EXCLUSIVE $STSHR EQU 31 EXCLUS WRITE RANDOM $IOISP EQU 12 INSERT AT SPECIFIED POSITION. $IOSTP EQU 14 SET READ/WRITE POINTER $IOWPW EQU 15 WRITE PASSWORD $IORSB EQU 16 READ INTO SPECIFIED BUFFER $IOAPP EQU 19 APPEND TO END OF FILE. $IOPSE EQU 22 POSITION TO END OF FILE. * * ABSOLUTE DISK ACCESS OP CODES * $FNABS EQU 5 FUNCTION CODE $ABSRS EQU 0 RESTORE=      START OF ITC TASKS (FOR BRACKETING ONLY) $TITC1 EQ >20 ITC TASK 1 $TITCX EQU >3F MAX ITC TASK NUMBER (FOR BRACKETING ONLY) ************** $TSPL EQU >40 START OF SPOOLER TASKS $TSPLX EQU >4F MAX SPOOLER TASK NUMBER ************** $TSPAR EQU >50 START OF SYSTEM SPARES $TSPND EQU >5F MAX NUMBER OF SYSTEM SPARES ************** $TUSER EQU >60 START OF FIRST USER NOT IN QUEUE (SPOOLER) 230381WAL $STNSQ EQU 46 ILLEGAL QUEUE (SPOOLER) 230381WAL $STEAL EQU 47 ENTRY ALREADY ALTERED (SPOOLER) 23381WAL $STDRA EQU 48 DRIVER CURRENTLY ACTIVE (SPOOLER) 230381WAL $STNDA EQU 49 NO DRIVER ACTIVE (SPOOLER) 230381WAL $STSPI EQU 50 SPOOLER IN IDLE, REQUEST IGNORED 230381WAL $STRDL EQU 51 ;RELEASING ALU ALREADY RELEASTASK $TUSRX EQU >FF END OF USER TASK AA ************** $LOCAL EQU 0 LOCAL IO JDT120282 $REMT1 EQU 1 REMOTE 1 IO " $REMT2 EQU 2 REMOTE 2 IO " ENDI IF $$TYP PAGE * * * FILE TYPE DEFINITIONS * $FTOBJ EQU 1 OMNIDATA OBJECT FILE $FTOVL EQU 2 OMNIDATA OBJECT PROGRAM OVERLAYED $STLTL EQU 52 LINE TOO LONG (TEXT FI 020481JDT $STLOV EQU 53 LINE OVER FLOW (LINE NO. .GT. 256) 020481JDT $STPOV EQU 54 PAGE OVER FLOW (PAGE NO. .GT. 256) 020481JDT $STRNA EQU 55 RECORD NOT AVAILABLE (NON EXISTANT) 020481JDT $STWPR EQU 56 DISK IS WRITE PROTECTED 050581DPG $STNEX EQU 57 CANNOT ALLOCATE NEW ALU FOR FILE 030881DPG $STIDO EQU 58  $FTDDS EQU 3 DDS OBJECT FILE $FTTXEQU 4 PROGRAM SOURCE FILE $FTWPX EQU 5 WORD PROCESSING TEXT FILE $FTIDX EQU 6 INDEX $FTSCR EQU 7 SCRATCH $FTCON EQU 8 CONFIGURATION INFORMATION $FTDIR EQU 9 DIRECTORY $FTPRM EQU 10 PROM PROGRAM OBJECT $FTNST EQU 11 NON-STANDARD $FTSEL EQU 12 SELECTION $FTREL E ILLEGAL DEVICE OPERATION 030881DPG $STFMT U 59 ;BAD FORMAT FOR LOADER FILE MDP141081 $STMLT EQU 60 ;MULTI USER REQD FOR SHARED FILE MDP201081 * * DATA CONTROL BLOCK. * $DCBBF EQU 0 BUFFER ADDRESS. $DCBLN EQU 2 TRANSFER LENGTH. $DCBRW EQU 4 FILE READ/WRITE POINTER. $DCBFC EQU 8 UFCB ADDRESS. $DCBFI EQU 10 FILE INDEX NUMBER. QU 13 RELOCATABLE OBJECT $FTCHN EQU 14 COMMAND CHAINING $FTSYS EQU 15 SYSTEM FILE $FTSYM EQU 16 SYMBOL TABLE $FTABS EQU 17 ABSOLUTE FORMAT FILE $FTBAS EQU 18 BASIC SOURCE FILE $FTBOB EQU 19 BASIC OBJECT FILE $FTCBL EQU 20 COBOL SOURCE FILE $FTCOB EQU 21 COBOL OBJECT FILE $FTDMP EQU 22 DUMP FILE $FTQUE E$DCBID EQU 11 TERMINAL ID. $DCBSQ EQU 12 SEQUENCE #. 270181WAL $DCBOP EQU 13 OP CODE. $DCBFN EQU 14 FUNCTION CODE. $DCBST EQU 15 PRIMARY STATUS. $DCBSS EQU 16 SECONDARY STATUS. $DCBSZ EQU 18 SIZE OF DCB AREA $DCBBK EQU 18 BANK WHERE DATA IS AT JDT091081 * * FIN ASSIGNMENTS * $FUSR EQU 0 QU 23 QUEUE FILE $FTCMD EQU 24 COMMAND HANDLER COMMAND FILE $FTDAT EQU 25 DATA FILE $FTHLP EQU 26 HELP FILE $FTLIB EQU 27 LIBRARY FILE $FTPOI EQU 28 POINTER FILE $FTDEM EQU 29 DEMO FILE $FTOLD EQU 30 BACKUP FILE $FTNEW EQU 31 TEST FILE $FTLOG EQU 32 SPOOLER LOG FILE $FTSRC EQU 33 PR USER DIRECTORY $FCMD EQU 2 CMAND FILE $FSCR EQU 3 SCRATCH FIN $FCHN EQU 4 CHAIN FILE $FIN1 EQU 5 INPUT 1 $FIN2 EQU 6 INPUT 2 $FOT1 EQU 7 OUTPUT 1 $FOT2 EQU 8 OUTPUT 2 $FOT3 EQU 9 OUTPUT 3 $FKBD EQU 13 FOR USE BY KEYBOARD FILE DPG010283 $FSPLD EQU 14 FOR USE BY SPOOLOGRAM COURCE FILE $FTASM EQU 34 PROGRAMSSEMBLY OUTPUT $FTLNK EQU 35 PROGRAM LINK CONTROL FILE $FTDEV EQU 36 SPECIAL DEVICE, FILE NAME INDICATES DPG030682 ENDI * IF $$PRM * * * PERMISSION BIT VALUE * * $PMDEL EQU >80 D - DELETE RECORDS, FILE, TRUNCATE WAL280183 $PMIN EQU >40 I - INSERT RECORDS WAL280183 $PMWR EQU >20 W - WRITE (OVERWRITE) ER DRIVERS WAL050483 $FSPLQ EQU 15 SPOOLER QUEUE FILE WAL110483 $FSPLC EQU 16 SPOOLER CONFIG FILE WAL110483 $FSPLS EQU 17 SPOOLER SCRATCH FILE WAL110483 ENDI IF $$TID * * * STANDARD TASK ID DEFINITIONS * * >00 THRU >1A SPECIAL SYSTEM FUNCTIONS * >20 THRU >3F ITC TASK SECTION * >40 THRU >4F SPOOLER TASK SECTION * >50 THRU >5F SYSTEM SPARES * >60 THRU >FF USER TASKS (APIVE ACCESS DENIED - SHARED IN EFFECT $STNSP EQU 32 NO SPOOL FILES AVAILABLE $STPOS EQU 33 BAD FILE POSITION (BEYOND END OF FILE) $STDKE EQU 34 DISK ERROR DPG070782 $STTMO EQU 35 BUSDRV - TIME OUT SIGNAL $STFMX EQU 36 OMNI 2 - OUT OF FIB SPACE FOR FILE $STDFL EQU 37 FILSYS - DIRECTORY IS FULL, CAN'T CREATE FILE $STNDV EQU 38 NO SUCH SPOOLER PLICATIONS) * $TDJ EQU 1 DUMMY JOBTLD EQU 2 LOADER TASK IN ATC $TCH EQU 3 COMMAND HANDLER $TRDS EQU 4 REMOTE DISPLAY INTERFACE $TCLK EQU 5 REAL TIME CLOCK TASK (NOW IN COMHAN) $TKBFL EQU 6 KEYBOARD FILE TASK ************** $TRM1 EQU >11 REMOTE TASK NUMBER 1 $TRM2 EQU >12 REMOTE TASK NUMBER 2 ************** $TITC EQU >20 DEVICE AVAILABLE 050381WAL $STBDR EQU 39 BAD SPOOLER DRIVER 050381WAL $STBCF EQU 40 BAD SPOOLER CONTROL FILE 050381WAL $STNPT EQU 41 TOO MANY PRINT FILES SPECIFIED $STPIN EQU 42 PRINTER INTERFACE ERROR $STCND EQU 43 CAN'T DO REQUEST (SPOOLER) 230381WAL $STQFF EQU 44 SPOOLER QUEUE FULL 230381WAL $STNIQ EQU 45 =      WAL020283 $PMAP EQU >10 A - APPENDRITE AT END OF FILE) WAL020283 $PMRD EQU >08 R - READ WAL280183 $PMEX EQU >04 E - EXECUTE (PROGRAM LOAD) WAL280183 $PMSP1 EQU >02 ** SPARE 1 $PMSP2 EQU >01 ** SPARE 2 * * * PERMISSION BIT SHIFT VALUES * $PBDEL EQU 0 D BIT $PBIN EQU 1 I BIT $PBWR EQU 2 W BIT $PBAP  4 4 - PRINT FILE DISPOSITION $SXMLT EQU 5 5 - MULTI USE FILE (WITH LOCKS) $SXNUL EQU 6 ;6 - BOTTOMLESS BIT UNIT (NULL FILE) $SXMAX EQU 6 *** END OF TABLE (MODIFY FOR MORE ENTRIES) * * SYSTEM DEFINITIONS FOR $SYSTM * $SYNET EQU 0 0 - STANDARD OMNIVORE SYSTEM $SYOM2 EQU 1 1 - OMNI-2 STANDALONE X-2000 $SYDEV EQU 2 2 - SPECIAL OMNIVORE DEVELOPMENT SYSTEM $SYXO2 EQU EQU 3 A BIT $PBRD EQU 4 R BIT $PBEX EQU 5 E BIT $PBSP1 EQU 6 ** SPARE 1 $PBSP2 EQU 7 ** SPARE 2 * ENDI IF $$PID * * PID DEFINITIONS * $PIOID EQU 0 'OMNIDATA' $PICID EQU $PIOID+8 COMPANY ID $PINAM EQU $PICID+16 PACK NAME $PIPGV EQU $PINAM+12 PACKGEN VERSION WHICH MADE PACK $PICYL EQU $PIPGV+4 NUMBE 3 3 - OMNI-2 STANDALONE USING HW OM2 $SYX EQU 3 *** MAX NUMBER OF SYSTEMS DEFINED!!! *** * * FUT FORMAT - EXTENTION OF FILE DESCRIPTOR * $FTTID EQU $FDSZ TERMINAL ID $FTTSK EQU $FTTID+1 TASK NUMBER $FTFCB EQU $FTTSK+1 FCB $FTALU EQU $FTFCB+2 STARTING ALU $FTFLG EQU $FTALU+2 FLAGS (SIGN BIT FOR SPOOLED FILE) WAL150382 $FUTSZ EQU $FTFLG+2 SIZE OF FUT ENTRY R OF CYLINDERS $PIHDS EQU $PICYL+2 HEADS/CYLDER $PISPT EQU $PIHDS+1 SECTORS/TRACK $PISPA EQU $PISPT+1 SECTORS/ALU $PINDR EQU $PISPA+1 # OF DIRECTORY ALUS $PIBPS EQU $PINDR+1 BYTES/SECTOR $PIDIR EQU $PIBPS+2 DIRECTORY ALU NO. $PIAAT EQU $PIDIR+2 ALLOCATION TABLE ALU $PIDMP EQU $PIAAT+2 SYSTEM DUMP FILE ALU $PICDT EQU $PIDMP+2 CREATION DATE (PACKED) $PIFLG EQU $PICDT+2  WAL150382 * * MINIVORE FUT ENTRY DEFINITIO* $MTPID EQU 0 ;PACK NAME $MTFIL EQU $MTPID+12 ;FILENAME $MTTYP EQU $MTFIL+13 ;FILE TYPE $MTSHR EQU $MTTYP+1 ;STYLE OF ACCESS $MTTSK EQU $MTSHR+1 ;TASK NUMBER $MTSUP EQU $MTTSK+1 ;SUPPLEMENT ADDRESS $MTALU EQU $MTSUP+2 ;STARTING ALU OF FILE $MTDEV EQU $MTALU+2 ;DEVICE CONFIG TABLE ENTRY INDEX DPG180382 $MTDVF EQU $MTDEV+1  FLAGS $PINAL EQU $PIFLG+1 OF ALLOCATION TABLE ALUS $PICKS EQU $PINAL+1 CHECKSUM * $PICMT EQU $PICKS+2 COMMENT $PIBOT EQU $PICMT+79 SYS.BOOTBLOCK $PIBAD EQU $PIBOT+1 LIST OF BAD ALUS $PINBD EQU $PIBAD+114 NO. BAD ALUS * * PID LOGICAL SECTOR II * $PIDNO EQU 0 DIRECTORY NUMBER JME260482 ENDI IF $$FIB * * * FIB LAYOUT * $FBDIR EQU 0  ;DEVICE I/O FORMAT DPG180382 * $MTSIZQU $MTDVF+1 ;SIZE OF MINIVORE FUT ENTRY DPG180382 $MTFSZ EQU $MTTSK ;SIZE OF MINIVORE FILE ENTRY * * IF $$DSK * * * LOW LEVEL DISK DRIVER DEFINITIONS * DSKRS EQU 0 RESTORE DSKRD EQU 2 RED DSKWR EQU 4 WRITE DSKWC EQU 6 WRITE-COMPARE DSKFM EQU 8 FORMAT DSKCS EQU 10  DIRECTORY ENTRY POINTER $FBDCP EQU $FBDIR+4 DIRECTORY ENTRY COPY $FBPRE EQU $FBDCP+18+2 POINTER TO PREVIOUS PRIMARY $FBNXT EQU $FBPRE+2 POINTER TO NEXT PRIMARY $FBBAS EQU $FBNXT+2 SECTION BASE POINTER $FBLEN EQU $FBBAS+4 NO. BYTES USED IN SECTION $FBALU EQU $FBLEN+4 START OF ALU LIST $FBNSC EQU 256-$FBALU/4 # SECTIONS IN FIB. ENDI IF $$DIR * * DIRECTORY ENTRY LAYOUT * $FLNAM EQU  CHECKSUM DSKST EQU 14 DRIVE STATU DSKVL EQU 16 VALIDATE DSKWBT EQU 4 WRITE BIT * * * DISK PARAMETER TABLE LAYOUT * FCBHSZ EQU 24 SIZE OF FCB ENTRY $BLKDF 0 $OFFDF $DPUNT,1 LOGICAL UNIT NUMBER $OFFDF $DPFLG,1 FLAGS (AS DEFINED ABOVE) $OFFDF $DPHPC,2 HEADS/CYLINDER $OFFDF $DPSPT,2 SECTORS/TRACK $OFFDF $DPSPA,2 SEC0 FILENAME $FLTYP EQU $FLNAM+13 FILE TYPE $FNMLN EQU $FLTYP AMOUNT OF FILENAME THAT IS HASHED $FLDNO EQU $FLTYP+1 DIRECTORY NO. FILE IS SAVED IN $FLFIB EQU $FLDNO+1+1 ALU OF FIRST FIB $FLCDT EQU $FLFIB+2 CREATION DATE $FLUSE EQU $FLDT+2 DATE OF LAST USE $FLMOD EQU $FLUSE+2 DATE OF LAST MODIFICATION $FLEOF EQU $FLMOD+2 END OF FILE POINTER $FLDSZ EQU $FLEOF+4 DITORS/ALU $OFFDF $DPCYL,0 CYLINDERS/DISK (MINIVORE) DPG081082 $OFFDF $DPST,1 PRIMARY (OPERATION) STATUS $OFFDF $DPSS,1 SECONDARY (DEVICE) STATUS $OFFDF $DPPB1,2 PARTIAL BUFFER 1 POINTER $OFFDF $DPPB2,2 PARTIAL BUFFER 2 POINTER $OFFDF $DPTYP,0 DISK TYPE (MINIVORE) DPG170982 $OFFDF $DPTCB,2 TASK TCB POINTER $OFFDF $DPDRV,0 PHYSICAL DRIVRECTORY SIZE (IF $FLTYP=DIR) $FLFLG EQU $FLDSZ+2 FLAGS (1 BYTE) $DRSIZ EQU 32 SIZE OF DIRECTORY ENTRY ENDI * * FILE DESCRIPTOR FORMAT * $FDPID EQU 0 PACK ID $FDDIR EQU $FDPID+12 DIRECTORY ID $FDDPW EQU $FDDIR+13 DIRECTORY PASSWORD $FDDAC EQU $FDDPW+15 DIRECTORY REQUIRED ACCESS (0=DEFAULT) $FDFIL EQU $FDDAC+1 FILE NAME $FDTYP EQU $FDFIL+13 FILE TYPE. $FDSHR EQU $FDTYP+E NUMBER (MINIVORE) DPG170982 $OFFDF $DPCNT,2 NUMBER OF REQUESTS ON LIST $OFFDF $DPLST,2 REQUEST LIST PTR WAL250382 $OFFDF $DPELS,2 REQUEST LIST HEAD WAL250382 $OFFDF $DPBPC,2 BYTES/CYLINDER $OFFDF $DPBPT,2 BYTES/TRACK $OFFDF $DPBPS,2 BYTES/SECTOR $OFFDF $DPMXA,2 MAXIMUM ALU NUMBER $OFFDF $DPBPA,2 BYTES/ALU $OFFDF1 EXCLUSIVE/SHARED ACCESS (0=EXCLUSIVE) $FDFPW U $FDSHR+1 FILE PASSWORD $FDFAC EQU $FDFPW+15 FILE REQUIRED ACCESS (0=DEFAULT) $FDSZ EQU $FDFAC+1 SIZE OF FILE DESCRIPTOR * * ACCESS STYLE DEFINITIONS * $SXEX1 EQU 0 0 - EXCLUSIVE ACCESS $SXEXC EQU 1 1 - EXCLUSIVE ACCESS $SXSHR EQU 2 2 - SHARED ACCESS FILE $SXSCR EQU 3 3 - SCRATCH FILE (DELETE AFTER CLOSE) $SXPRT EQU >     INCLUDING HEADER $TRRLN EQU $TRLEN+2 RECEIVED NGTH $TRSTK EQU $TRRLN+2 SOURCE TASK $TRDTK EQU $TRSTK+1 DESTINATION TASK $TRTOT EQU $TRDTK+1 TIME OUT VALUE $TRRXP EQU $TRTOT+2 RX MESSAGE POINTER 270181WAL $TRTCB EQU $TRRXP+2 TCB ADDRESS $TRDID EQU $TRTCB+2 DESTINATION ID TRSTA EQU $TRDID+1 STATUS $TRCOD EQU $TRSTA+1 OP CODE $TRBNK EQU $TRCOD+1 BANK NUMBER FOR $TRMSG WAL150382 $TRRMX EQU $TRBNK+1 MAXIMUM LENGTH TO RECEIVE WAL020283 $TRBSZ EQU $TRRMX+2 HEADER LENGTH IN BYTES WAL150382 * * OMNIBUS DRIVER OPCODES * $OOTRN EQU 1 TRANSMIT $OORCV EQU 2 RECEIVE $OOTTM EQU 3 TURN AROUND TRANSMIT * * BUS MESSAGE FORMAT * $BMDID EQU 0 DESTINATION ID $BMCRL EQU $BMDID+1 CONTROL BYTE $ LIST * * LAST CHANGED 23 DEC 82 WAL * UNL $OMNI SETV 0 COMPLETE SYSTEM DEFINITIONS 0$OMNI SETV 1 SMALL SYSTEM DEFINITIONS IF $$LIST LIST IF $OMNI PAGE TITL 'OMNINET SYSTEM DEFINITIONS 2' ELSE PAGE TITL 'DDS LOS SYSTEM DEFINITIONS' ENDI ENDI ************************************************************** * BMDCP EQU $BMCRL+1 COPY OF 1ST BYTE $BMPTN EQU $BMDCP+1 PATTERN FOR VALIDATION WAL150382 $BMSID EQU $BMPTN+1 SOURCE ID $BMDTK EQU $BMSID+1 DESTINATION TASK $BMSTK EQU $BMDTK+1 SOURCE TASK $BMCOD EQU $BMSTK+1 OP CODE $BMCNT EQU $BMCOD+1 MESSAGE CONTINUATION FLAG BYTE $BMLOS EQU $BMCNT LOS VERSION $BMLEN EQU $BMCNT+2 LENGTH OF TRANSFER $BMHSZ EQU $BMLEN+2  * * ****** * * ****** ***** ****** ***** * * * * * * * * * * * * * * * * * * * * * * * * * ****** * ****** * * **** ***** * * * * * * * * * * * * * * * * * * * * * * ****** * ****** ***** * ****** * *  SIZE OF BUS MESSAGE HEADER $BMPHS EQU 4 BUS PRE-HEADER SIZE * * BUS MESSAGE OPCODES * $BSMSC EQU 1 MISCELLANEOUS FUNCITONS $BSFSF EQU 2 FILE SYSTEM $BSNCF EQU 3 NETWORK CONTROL $BSLDB EQU 4 LOAD BLOCK $BSSPL EQU 5 SPOOLER MESSAGE 180181WAL $BSAKM EQU 6 ACK, NAK, ENQ BROADCAST MESSAGE $BSIPL EQU 7 IPL REQU * * (COMMON) * **************************************************************** * * OFFSETS FOR USART PARAMETER CONTROL BLOCKS * $BLKDF >0 * $OFFDF $RESRV,2 RESERVATION FLAG $OFFDF $MMIO,2 MMIO BASE ADDRESS DPG140682 $OFFDF $CRU,2 CRU BASE ADDRESS DPG140682 $OFFDF $INTLV,2 INTERRUPT LEVEL DPG140682 EST $BSTRD EQU 8 TRANSMIT/RECEIVE DATALOCK $BSDLL EQU 9 DOWN LINE LOAD BLOCK 070181WAL ENDI * IF $$OM2 * * OMNI2 CRU AND MEMORY MAPPED IO DEFINITIONS * $DMABS EQU >1E00 DMA CONTROLLER CRU BASE ADDRESS $MEMBS EQU >1E80 MEMORY PAGING AND IPL PROM SELECT $KEYBS EQU >1C80 KEYBOARD CONTROLLER $INTBS EQU $KEYBS INTERRUPT MASK CONTROLLER $TMRBS EQU $KEYBS  $OFFDF $MMIOB,2 MMIO FOR OMNI RS232 BUS REG SHU010383 $OFFDF $UNDFA,2 UNDEFINED DPG140682 $OFFDF $IINTA,2 INPUT INTRPT PROC VECTOR ADDR DPG140682 $OFFDF $OINTA,2 OUTPUT INTRPT PROC VECTOR ADDR DPG140682 $OFFDF $EINTA,2 ERROR INTRPT PROC VECTOR ADDR DPG140682 $OFFDF $FINTA,2 RS232 BUS BUSFREE INTRPT ENTRY POINT SHU010383 $OFFDF $USRWS,2  INTERVAL TIMER $PRTBS EQU >1D80 PRINTER DATA (MOVE AMOUNTS, ETC.) $PSTBS EQU >1D20 PRINTER STATUS $PNTBS EQU >1D28 PRINTER STROBES * $DSKBS EQU >FF80 FLOPPY DISK CONTROLLER $DSPBS EQU >FF90 CRT CONTROLLER $DKSBS EQU >FFF8 DISK DRIVE/HEAD SELECT * $MMWR EQU 8 BIT FOR WRITING MEMORY MAPPED IO LOCS $MMAO EQU 2 SPECIAL BIT FOR " " " " $MMR $DPNFI,2 NUMBER OF FILES OPEN THIS DRIVE $DF $DPALA,2 FIRST ALU OF ALLOCATION FILE $OFFDF $DPNAL,2 # OF ALLOC. ALUS $OFFDF $DPSFC,FCBHSZ FCB FOR SYSTEM DIRECTORY ON THIS PACK $OFFDF $DPNAM,12 DISK NAME $OFFDF $DPEXC,2 DRIVER EXECUTION ADR WAL250382 $OFFDF $DPCCY,2 CURRENT CYLINDER $OFFDF $DPCHD,2 CURRENT HEAD $OFFDF $DPCSE,2 CURRENT SECD EQU 4 BIT FOR READING " " " " ENDI * EVEN LIST * TOR $OFFDF $DPAOF,2 ALU OFST, 0 FOR MV FOAT, ELSE 256 WAL250183 $OFFDF $DPOVF,2 OVF $OFFDF $DPRCN,2 RCNT $OFFDF $DPWRA,2 WRACC $OFFDF $DPNDP,2 POINTER TO NEXT DP TABLE $DPTSZ EQU $DU * ENDI IF $$BUS PAGE * * TRANSMIT RECEIVE BLOCK LAYOUT * $TRLNK EQU 0 TRB LINK $TRMSG EQU $TRLNK+2 MESSAGE ADDRESS $TRLEN EQU $TRMSG+2 XMIT LENGTH >      INTERRUPT WORKSPACE TO USE WAL231282 OFFDF $BLKTC,2 BLOCKED TCB TASK ID SHU010383 $OFFDF $PROTO,1 SERIAL INTERFACE PROTOCAL TYPE SHU010383 $OFFDF $ENQST,1 STATUS INTERROGATED SHU010383 $OFFDF $MDR1,1 MODE REGISTER 1 $OFFDF $MDR2,1 MODE REGISTER 2 $OFFDF $SYN1,1 SYNCHRONIZE BYTE 1 $OFFDF $SYN2,1 SYNCHRONIZE BYTE 2 $OFFD************************** PAGE * * UPDATE PHYSAL CURSOR POSITION * * CALL - BLWP @CURUPD * * MOVE CURSOR TO POSITION SPECIFIED BY CURRENT LINE * AND COLUMN * * REGISTER USAGE * * R2 POINTS TO START OF LINE IN SCREEN BUFFER * R5 LINE COUNTER * R9 'OLD' OFFSET * * * $CURUX DATA SCRREG,CEX CURUPD EQU $CURUX * * PERFORM WINDOWING AND PHYSICALLY POSITION CURSOR * CEX CLR R4 IN CASE WINDOW INHIBITED F $DLE,1 DLE BYTE $OFFDF $CMD COMMAND REG OVERLAY $OFFDF $IOBNK,2 I/O BUFFER BANK #'S (I=MSB,O=LSB) $OFFDF $IBUF,2 INPUT BUFFER ADDRESS $OFFDF $IMAX,2 LENGTH OF INPUT BUFFER $OFFDF $OBUF,2 OUTPUT BUFFER ADDRESS $OFFDF $OMAX,2 LENGTH OF OUTPUT BUFFER * * ALL VALUES FROM $RESRV TO HERE MUST BE INTIALIZED BY USER * $OFFDF $IIN,2 INPUT BUFFER POINTER $OFF WAL270781 MOV @$80COL,R2 CHECK COLUMNODE DPG030682 JNE CUROU1 80 COLUMN MODE? DPG030682 MOV *R8CRLN,R2 CHECK FOR WINDOW INHIBIT WAL270781 BL @GETLIN CHECK LINE FOR INHIBITED WAL270781 JLT CUROUT YES, DON'T CHANGE WINDOWED LINES WAL270781 MOV @SCROFS,R4 SET UP REGISTERS MOV R4,R10 DF $IOUT,2 OUTPUT BUFFER POINTER $OFFDF $NT,2 INPUT BUFFER CHAR COUNT $OFFDF $IEND,2 END OF INPUT BUFFER $OFFDF $OIN,2 OUTPUT BUFFER POINTER $OFFDF $OOUT,2 OUTPUT BUFFER POINTER $OFFDF $OCNT,2 OUTPUT BUFFER CHAR COUNT $OFFDF $OEND,2 END OF OUTPUT BUFFER $OFFDF $STAT,2 CURRENT STATUS $OFFDF $STATC,2 CUMULATIVE STATUS $OFFDF $SVCMD,2  WAL020682 MOV R4,R1 R4=OFFSET IF $OMNI2 AI R1,SCRWID-1 R1=OFFSET+79 WAL080781 ELSE $OMNI1,$OMNI3 AI R1,SCRWID R1=OFFSET+80 ENDI $OMNI2 MOV @$SCRLM,R2 MOV R2,R3 ANDI R3,>FF R3=RIGHT MARGIN VALUE SRL R2,8 R2=LEFT MARGIN * * MOV R4,R5 SEE IF INTO RIGHT MARGIN AREA A  LAST COMMAND ISSUED TO USART DPG140682 $FDF $INTWS,2 INTERUPT ROUTINE WORKSPACE REGS DPG140682 LIST  R3,R5 C *R7CRCL,R5 JLT WNDLF -N CI R1,CHPRLN -Y, SEE IF AT THE RIGHT LIMIT JHE CUROUT -YES, IGNORE IT PAGE * * WINDOW TO THE RIGHT * A *R7CRCL,R4 CURRENT POSITION WAL080781 S R5,R4 FIGURE AMOUNT TO MOVE WAL080781 INC R4 CALC NEW OFFSET (ALLOW FOR CURSOR) WAL080781 CI R4,CHPRLN-SCRWID+1 SEE IF AT OR PAST LINE LENGTH WAL080781 LT CNOSHF -N LI R4,CHPRLN-SCRWID+1 -Y, SET TO MAX WAL080781 JMP CNOSHF * * WNDLFT MOV R4,R5 FIGURE LIMIT PTR A R2,R5 C *R7CRCL,R5 AND SEE IF NEED TO WINDOW JGT CUROUT -N, EXIT MOV *R7CRCL,R4 FIGURE NEW OFFSET S R2,R4 ELSE FIGURE AMOUNT JGT CNOSHF NOT TOO LOW CLR R4 ELSE SET ALL THEAY BACK IF $OMNI2 CNOSHF C R10,R4 NEED TO MOVE? WAL080781 JEQ CUROUT -N, EXIT * * FOR EACH LINE, REPLACE THE PHYSICAL COLUMN 1 ATTRIBUTE CHARACTER * BY THE ORIGINAL CHARACTER THERE, AND THEN FIND THE FIRST * ATTRIBUTE PRECEEDING THE NEW-FIRST-COLUMN-OF-DISPLAY. PLACE * THIS CHARACTER IN THE NEW-FIRST-COLUMN-OF-DISPLAY, SAVING THE * CHARACTER FIRST. ************************************************************************* * * * ****** *** ***** ***** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ***** ***** * ******* * * * * * * * * * * * * CLR R5 START AT THE TOP * SHFLP MOV R5,R2 GET LINE POINTERS BL @GETLIN JLT SHFLPN -WINDOW INHIBITED, IGNORE IT * * MOV R2,R3 CALC PTR TO NEW COL 0 INC R3 SKIP FIRST WORD A R4,R3 FIGURE PTR TO NEW FIRST COLUMN WAL080781 MOVB *R3,R11 SAVE THE CHAR THERE WAL080781 MOV R3,R9 SAVE PTR  * * * * * * * * * * * ****** *** ***** * ****** * * * * * * (DSPSRC:DISPLY) * ************************************************************************ * * THIS IS THE SECOND PORTION OF THE DISPLAY DRIVER AND IS * INCLUDED BY THE FIRST. * ******************************************************?      COLUMN LDCR R1,0 ENDI $OMNI2,$OMNI1 ENDI $OMNI3 CURET RTWP * * * TURN OFF THE CURSOR * * CALL - BLWP @CUROFF * CUROFF DATA SCRREG,CURRUN CURONS DATA >1 * " PAGE * * DISPLAY CHARACTER SUBROUTINE * R6CHPR EQU 6 CHARACTERS PER LINE R7CRCL EQU 7 PTR TO CURRENT COLUMN WORD R8CRLN EQU 8 PTR TO CURRENT LINE WORD R10SCR EQU  WAL080781 SHFLP1 DEC R9 FIND PREVIOUS ATTRIBUTE BYTE WAL080781 MOVB *R9,R1 WAL080781 JGT SHFLP1 NOT ATRB, >8000 BIT NOT SET WAL080781 JEQ SHFLP1 DITT0 WAL080781 SLA R1,1 CHECK >4000 BIT WAL080781 JLT SHFLP1 SET, MUST BE GRAPHICS W 10 PTR TO SCREEN ACCESS ROUTINE SCRCHR EQU $ IF $OMNI2 DATA ATRRGS,SAVCHR ELSE $OMNI1,$OMNI3 DATA SCRREG,SCREX ENDI * PAGE IF $OMNI2 * * * * ROUTINES TO HANDLE OMNI-2 ATTRIBUTES * * THESE ROUTINES MAINTAIN THE FOLLOWING SET OF POINTERS IN THE PROPER * RELATIONSHIPS TO ALLOW FOR MINIMUM EXECUTION TIME TO PLACE A NEW * CHARACTER IN THE SCREEN BUFFER. THEY HANDLE THE INSERTION AND DELETION * OF ATAL080781 MOVB *R9,*R3 ATRGET IT WAL080781 SZCB @C00,*R3 CLEAR BITS TO INDICATE REPLACEMENT WAL080781 * OF ATTRIBUTE TO THE ATTR. HANDLING RTNES SHFLP3 MOV R5,R1 SLA R1,1 MOV R3,@LINOUT(R1) MOVB *R2,R1 WAS SAVED CHAR AN ATRB? WAL080781 SLA R1,1 WAL080781 JLT SHFLP6 NTRIBUTE BYTES TO MINIMIZE THE EFFECTS OF NON-TRANSPARENT ATTRIE * HANDLING ON THE OMNI-2. * * THERE ARE 4 ROUTINES: * * SAVCHR - SAVE THE CURRENT CHARACTER AT THE CURRENT POSITION, * UPDATING ATTRIBUTE BYTES ACCORDING TO THE * CURRENT SET OF ATTRIBUTES. * ATRADV - ADVANCE THE CURRENT PTR BY 1, ADJUSTING OTHER PTRS AS * NECESSARY. * ATRDEC - DECREMENT THE CURRENTO, >4000 BIT SET WAL080781 JOC HFLP7 YES, DON'T NEED TO RESTORE IT WAL080781 SHFLP6 MOV R10,R3 OLD OFFSET WAL080781 JEQ SHFLP7 IF 0, NO NEED TO RESTORE WAL080781 A R2,R3 GET OLD COL 0 ATRB PTR WAL080781 INC R3 SKIP SAVED BYTE WAL080781 MOVB *R2,*R3 RESTORE OLD CHAR  PTR, ADJUSTING OTHER PTRS AS NEC. * ATRINI - S UP NEW PTRS FROM SCRATCH (E.G. AFTER CURSOR POSITION * SEQUENCE.). * * REGISTER CONVENTIONS: * * R4PATR POINTER TO FIRST PRECEEDING ATTRIBUTE FROM * CURRENT POSITION * R5PSPC PTR TO FIRST PRECEEDING SPACE OR ATTRIBUTE * FROM CURRENT POSITION (MAY EQUAL R4PATR) * R6NSPC  WAL080781 SHFLP7 MOVB R11,*R2 MOVE IN NESAVED CHAR WAL080781 SHFLPN INC R5 NEXT LINE CI R5,NLINES (INCLUDE BLANK LINE) WAL170981 JLT SHFLP UNLESS DONE MOV R4,@SCROFS GET OLD WINDOW WAL080781 CUROUT DEC R4 COMPENSATE FOR SCREEN COLUMN 0 WAL051081 ELSE $OMNI1,$OMNI3 CNOSHF MOV R4,@SCROFS SAVE THE NEW OFFS PTR TO FIRST SPACE OR ATTRIBUTE CHARACTER * AFTER CURRENT POSITION * R7LPTR PTR TO CURRENT LINE (SAVED BYTE) * R8CPTR PTR TO CURRENT POSITION ON LINE * * THE FOLLOWING IS THE ALGORITHM IMPLEMENTED IN CODE: * * SAVCHR: * IF 'CHAR' <> SPACE * THEN 'CHAR'-->*R8CPTR 'SAVE THE CHARACTE * IF R6NSPC IS ATRB 'HANDLE TRAILING ATT. * ET IF $OMNI1 SLA R4,1 SET UP FOR INTERRUPT HANDLER MOV R4,@CRTWP8 SRA R4,1 RESTORE OFFSET WAL281081 ENDI $OMNI1 CUROUT EQU $ WAL051081 ENDI $OMNI2 * * NOW OUTPUT THE CURSOR POSITION * CUROU1 MOV @CURONS,R1 CURSOR DISPLAY ON? TS270582 JNE CUROU2 DISPLAY THEN IF $CHRMO=*R6NSPC, ' * THEN 'SPACE'-->*R7NATR 'CHANGE DUPLICATE ATT * ENDIF ' * ELSE *R4PATR-->*R6NSPC 'ISN'T,RESTORE CUR. * ENDIF 'AFTER INSERTION OF * 'NEW WHICH WILL HAPPN * 'BELOW * * $CHRM " CURRUN EQU $ CLR R4 TU CURSOR OFF LI R1,81 COLUMN 81 CROFVL EQU $-2 JMP CURSET CUROU2 MOV *R7CRCL,R1 SET CURRENT COLUMN WAL051081 S R4,R1 LESS OFFSET WAL281081 MOV *R8CRLN,R4 SET CURRENT LINE CURSET EQU $ IF $OMNI3 INC R4 LINE # OFFSET BY 1 FOR ERROR LINE SWPB R4 MOVB TO THAT BYTE MOVB *R9,R1 CURRENT C 0 IS ATRB? WAL080781 SLA R1,1 WAL080781 JLT SHFLP0 NO, >4000 BIT SET WAL080781 JOC SHFLP3 YES, 8000 BIT IS SET, LEAVE IT ALONE WAL080781 SHFLP0 MOVB @1(R9),R1 NO, CHECK NEXT BYTE (BACKSPACING) WAL080781 CZC @C00,R1 IS IT COL 0 ATRB? WAL080781 JNE  R4,@CURSVL SET LINE (VERTICAL) *!!! FOR DOUBLE WIH, SHOULD DOUBLE CURSOR COLUMN POSITION SWPB R1 MOVB R1,@CURSHZ SET COLUMN (HORIZONTAL) ELSE $OMNI1,$OMNI2 IF $OMNI2 MOV @CURCMD,@DISP+WR+A0 SET CURSOR COMMAND MOV R1,@DISP+WR OUTPUT CURSOR COLUMN MOV R4,@DISP+WR AND LINE ELSE $OMNI1 ORI R4,>6D00 SET CURSOR LINE LDCR R4,0 ORI R1,>6C00 ANDSHFLP1 NO WA80781 SLA R1,1 MAYBE, CHECK THAT IT'S AN ATRB WAL080781 JNC SHFLP1 NO, >8000 BIT NOT SET WAL080781 JLT SHFLP1 NO, >4000 BIT SET, GRAPHICS WAL080781 INC R9 COL 0 ATRB, MOVE IT BACK WAL080781 MOVB *R9,*R3 WAL080781 JMP SHFLP3 ?     O-->*R5PSPC;R12TEMP<--R4PATR 'INSERT CURRENT ATTR * R4PATR<--R5PSPC 'IN 1ST PREV. POSN * IF R5PSPC = TEMP 'IF NOT A SPACE,AND * THEN FIND PREV. 'ATR' WITH R12TEMP 'PREV.ATR IS SAME, * IF *R12TEMP=$CHRMO 'CHANGE TO SPACE * THEN 'SPACE'-->*R5PSPC;R4PATR<--TEMP * ENDIF * ELSE IF *R8CPTR<>'ATR';THEN SAVE CHARACTER;ENDIF ING OF GRAPHICS CHARS WAL251082 EVEN * *AVCHR EQU $ * BL @CKWND SET UP MOVB *$RWP,R12 GET THE CHARACTER WAL140681 BL @CHKSPC CHECK FOR A SPACE WAL140681 JNE DOSPC1 NOT A SPACE WAL140681 * MOVB @-1(R8CPTR),R12 PRECEDED BY A SPACE? WAL170881 BL @CHKSPC * ENDIF * * * ATRADV: * IF R8CPTR<'RIGHT LIT' * THEN R8CPTR<--R8CPTR+1 'ADVANCE CURRENT PTR * IF R8CPTR>=R6NSPC 'PASSING TRAILING PTRS? * THEN R5PSPC<--R6NSPC 'Y,UPDATE PRECEEDING PTRS * IF *R5PSPC='SPACE' * THEN R4PATR<--R5PSPC '?? * ENDIF * ENDIF * * IF R7NATR0 * THEN R8CPTR<--R8CPTR-1 * IF R8CPTR<=R5PSPC * THEN R6NSPC<--R5PSPC * IF *R6NSPC='ATR' * THEN R7NATR<--R6NSPC * R4PATR,R9 SAVE ORIGINAL ATRB WAL1401 SZCB @C00,R9 GET RID OF SPACE-TYPE BITS WAL140681 MOVB *R8CPTR,R12 SEE IF IT WOULD COVER AN ATTRIBUTE 180581WAL BL @CKATR JNE UPDPRM NO, PUT IT IN WAL140681 MOVB *R8CPTR,R2 DOES ATTRIBUTE CHANGE FROM PREV? WAL140681 SZCB @C00,R2 SKIP SPACE-TYPE BITS WAL140681 CB R9,R2  ENDIF * ENDIF * IF R8CPTR100 DISPLAY BANK ADDRESS DATA 0,0 SCRATCH DATA CURCOL PTR TO CURRENT COLUMN DATA 0,0,0,0,0,0 4-9 DATA 0,0 10-11 DATA 0 12 DATA 0,0,0 13-15 * * STORAGE FOR NEW ATTRIBU81 JHE UPDPRM NO, COLUMN 0 DOESN'T CHAE ? WAL270781 C R6NSPC,R12 IS NEXT SPACE (ATRB) ALSO TO LEFT? WAL270781 JLE UPDPRM PROPAGATION TO LEFT OF COLUMN 0 WAL270781 MOVB R9,*R12 CHANGED INTERVAL CONTAINING COL 0 WAL270781 * * UPDPRM MOVB *$RWP,*R8CPTR STORE THE CHARACTER WAL140681 * CB @$CHRMO+1,R9 WILL ATRB BE CHANGING? WAL140681 JEQ SAVCTES/FUNCTIONS * C00 DATA 00 BITS INDICATE TYPE OF SPACE REPLACES BY ATRB COL0PS DATA 0 SCREEN COLUMN 0 PTR WAL270781 NULATR BYTE 0 POINT HERE IF NO TRAILING ATRB WAL140681 SPACE BYTE >20 NORMAL SPACE WAL140681 INSSPC BYTE >9C->80 INSERT SPACE WAL140681 TABSPC BYTE >9E->80 TABBED SPACE WAL140681 LNINHW BYTE H0 NO 180581WA CB *R8CPTR,@HC0 GRAPHICS INPUT? WAL251082 JL UPDPR2 NO WAL251082 MOVB @$CHRMO+1,R11 YES, GET LOWER TWO MODE BITS WAL251082 MOV R11,R12 SAVE CURRENT ATRB WAL150383 ANDI R11,>300 (BLINK & HALF-INTENSITY) WAL251082 SOCB R11,*R8CPTR WHICH INDIV 0 WINDOW INHIBIT MODE FOR LINE W080781 CODSPC BYTE >9D-80 CODE SPACE WAL080981 * WAL140681 PNCTBL TEXT '.,?!";:' PUNCTUATION MARKS WAL140681 BYTE >27 SINGLE QUOTE WAL140681 PNCTND BYTE >95->80 END OF PARAGRAPH WAL080781 HC0 BYTE >C0 BEGINN@      R8CPTR,R9 SAVE PTR TO CURRENT CHARACTER INC R8CPTR BUMP FOR NEXT TIME MOV @$ATRIB,R12 INTELLIGENT ATTRIB HANDLING OFF? TS210582 JNE ATREX SKIP POINTERS SETTING TS210582 C R8CPTR,R6NSPC SEE IF OVERTAKING TRAILING PTRS JNE ATRA1 -N * BL @NXTSPC YES, MUST FIND NEXT SPACE WAL140681 * ATRA1 MOVB *R9,R12 LEAVING A SPACE? R6 YES, SENEW ATRB THERE WAL150383 BL @CKATR OR BY ATRB? WAL150383 JNE SAVCH0 NO, DON'T CHANGE ATRB WAL150383 * UPDPR6 C R5PSPC,R4PATR REAL SPACE BEFORE? WAL140681 JEQ UPDPR1 NO WAL110681 * UPDPRV MOV R5PSPC,R4PATR NEW ATRB POSITION WAL140681 UPDPR1 MOVB @$CHRMO+1,R2 GET NEW AT WAL140681 BL @CHKSPC WAL140681 JNE ATRA3 -N WAL140681 MOV R9,R5PSPC -Y, UPDATE TRAILING ATRA3 BL @CKATR JNE ATREX -N MOV R9,R4PATR -YES, UPDATE IT MOV R4PATR,R5PSPC * * ATREX EQU $ RTWP DONE * ATRA80 LI R11,SCRWID-1 CHECK IF AT END OF THE SCREEN RB WAL140681 MOV R4PATR,R PUT IT IN AS PREVIOUS WAL140681 BL @REPSPC WAL140681 * MOV @COL0PS,R12 CHECK IF WE SHOULD AFFECT SCREEN WAL270781 C R4PATR,R12 TO RIGHT OF COL 0? WAL270781 JH CHKNXT YES, NO CHANGES NEEDED WAL270781 JNE UPDPR4 TO LEFT, CHECK IT OVER  WAL040382 C *R3CRCL,R11 WAL040382 JL ATRA0 NOT YET WAL040382 CLR *R3CRCL AT END OF SCREEN, DO AUTO-WRAP WAL040382 INC @$CURLN BUMP LINE NUMBER LI R11,NLINES-1 CHECK IF ON LAST LINE WAL260882 C @$CURLN,@MAXLN WAL260882 JL ATRS1 NO, OK WAL270781 MOVB *R12,*R7LPTR UPDATING COL 0, DSAVED BYTE TOO WAL270781 JMP CHKNXT WAL270781 UPDPR4 C R6NSPC,R12 WILL NEXT ATRB BE TO LEFT OF COL 0? WAL270781 JLE CHKNXT WHOLE WORD TO LEFT OF COL 0 WAL270781 MOVB @$CHRMO+1,*R12 STRADDLES COL 0; PUT IN NEW ATRB WAL270781 * CHKNXT MOVB *R6NSPC,R12 SEE IF SPACE BEFORE NEXT ATTRIBUTE WAL140681 BL @ WAL260882 MOV @$DPRLN,CURLN YES, WRAP BACK TO TOP WAL260882 JMP ATRS1 RE-INITIALIZE WAL260882 * * MOVE POINTERS BACK * ATRDEC DATA ATRRGS DATA $+2 MOV *R3CRCL,R12 SEE IF TO LEFT MARGIN ALREADY JEQ ATRD80 -Y WAL040382 DEC *R3CRCL -N, DO IT MOV R8CPTR,R9 PRESERVE ORIGINAL PCHKSPC WAL1481 JEQ UPDNXS -THERE IS, IGNORE THIS WAL140681 * SZCB @C00,R12 ATRB, CLEAR SPACE TYPE BITS WAL140681 CB @$CHRMO+1,R12 -ISN'T, SEE IF ATTRIBUTE CHANGE WAL140681 JNE SAVCH0 -DOES, EXIT HERE WAL140681 MOV R6NSPC,R12 DOESN'T, CAN PUT IN A SPACE WAL140681 BL @RSTSPC PUT IN TR DEC R8CPTR MOV @$ATRIB,R12 INTELLIGENT ATTRIB HANDLING OFF? TS210582 JNE ATREX SKIP TS210582 C R8CPTR,R5PSPC RUNNING INTO PRECEEDING PTRS? JNE ATRD2 -N MOV R5PSPC,R4PATR FIND PREVIOUS ATTRIBUTE TO THAT WAL270781 BL @PRV AND PREV SPACE WAL270781 * ATRD2 MOVB *R9,R12 LEAVING A SPACE> BCORRECT TYPE OF SPACE WAL140681 JMP SAV AND EXIT HERE WAL140681 * * UPDNXS MOVB R9,R2 MOVE IN THE LAST ATTRIBUTE WAL140681 MOV R6NSPC,R12 WAL140681 BL @REPSPC IN PLACE OF SPACE WAL140681 C R6NSPC,@COL0PS ON SCREEN COL 0? WAL270781 JNE SAVCH0 NO L @CHKSPC JEQ ATRD3 YES WAL140681 BL @CKATR OR AN ATRB WAL140681 JNE ATREX -N WAL140681 ATRD3 MOV R9,R6NSPC -Y, UPDATE TRAILER JMP ATREX AND EXIT * ATRD80 MOVB @$80COL+1,R11 CHECK FOR COLUMN 80 MODE (AUTO-WRAP)DPG030682 JEQ ATREX NO, TAKE NO ACTION DPG03 WAL270781 MOVB *R6NSPC,*R7LPTR YES, UPDATEAVED BYTE TOO WAL270781 * SAVCH0 MOV R10PCP,R8CPTR RESTORE PTR IN CASE OF COLUMN 0 SITUATION JMP ATRAD * STORE CHARACTER WHEN BASIC IS RUNNING * SCRBAS DATA ATRRGS DATA $+2 MOVB *$RWP,*R8CPTR STORE THE CHARACTER TS270582 JMP ATRAD ADVANCE POINTERS " * PAGE * * ADVANCE POINTERS * ATRADV DATA ATRRGS DATAIDUALLY AFFECT GRAPHICS WAL251082 XOR R9,R12 SEE WHICH BITS CHANGE WAL150383 SLA R12,3 CHECK REV VIDEO BIT (AFFECTS GRPH) WAL150383 JLT UPDPR3 CHANGES, MUST ALTER ATRBS WAL150383 JMP SAVCH0 DON'T CHANGE ANY ATRBS FOR GRAPHICS WAL251082 * UPDPR2 BL @CHKPNC IS IT PUNCTUATION? WAL140681 JNE UPDPR6 NO, CHANGE ATRB W ATRAD AL281081 ATRAD MOVB @$80COL+1,R12 CHECK 80 LUMN FLAG DPG030682 JNE ATRA80 80 COLUMN MODE? DPG030682 LI R11,CHPRLN-1 OTHERWISE CHECK FOR END OF LINE WAL051081 C *R3CRCL,R11 PAST END? WAL040382 JHE ATREX -Y, IGNORE IT ATRA0 INC *R3CRCL -N, BUMP CURSOR POSITION MOV AL150383 UPDPR3 MOV R8CPTR,R12 IS IT IMMEDIATELY OCEEDED BY ATRB WAL150383 UPDPR5 DEC R12 PREVIOUS CHAR WAL150383 CB *R12,@HC0 IF PRECEEDED BY GRAPHICS, SCAN BACK WAL150383 JHE UPDPR5 WAL150383 MOVB *R12,R12 GET CHARACTER WAL150383 BL @CHKSPC PRECEDED BY SPACE? WAL150383 JEQ UPDP@     0682 LI R11,SCRWID-1 SET TO END OF THE EEN WAL040382 MOV R11,*R3CRCL WAL040382 C @CURLIN,@$DPRLN CHECK IF INTO PROTECTED AREA WAL040382 JLE ATRS1 YES, DON'T MOVE UP WAL040382 DEC @CURLIN PREVIOUS LINE WAL040382 JMP ATRS1 RE-INITIALIZE POINTERS WAL040382 * * INITIALIZE POIN INSERT SPACE? WAL270781 JL PRV1 NO WAL080981 CI R12,>1E00 TAB OR CODE SPACE? WAL080981 JH PRV1 NO, CONTINUE LOOKING WAL080981 * WAL270781 PRV6 MOV R4PATR,R5PSPC SAVE POSITION OF SPACE WAL270781 **!!! MORE SELF MODIFYING CODE!!! TERS * ATRINL DATA ATRRGS,ATRS2 INITIALIZE TRAILI PTR ONLY WAL111281 ATRINI DATA ATRRGS DATA $+2 ATRS1 MOV @CURLIN,R2 GET PTR TO THE LINE WAL040382 BL @GETLIN MOVB R1,@LNINHW SAVE WINDOW MODE FOR LINE WAL080781 MOV R2,R8 LINE POINTER WAL270781 INCT R8 TO FIRST DISPLAY CHAR WAL270781 A *R3CRCL,R8 AND WAL270781 MOV @INST3,@PRV2 ET UP INSTRUCTIONS FOR WAL270781 MOV @INST4,@PRV3 ATRB SEARCH ONLY WAL270781 JMP PRV1 WAL270781 * WAL270781 INST1 JLT $+4 JLT PRVATR WAL270781 INST2 DATA PRSCHK-PRVATR/2+>1000 JMP PRSCHK WAL270781  TO THE CHARACTER WAL270781 MOV RR7LPTR SAVE LINE PTR WAL270781 AI R2,CHPRLN CALC END OF LINE PTR WAL270781 MOV R2,@LINEND WAL270781 MOV @$ATRIB,R11 INTELLIGENT ATTIRIB HANDLING OFF? TS210582 JNE ATREX SKIP TS210582 * ATRS0 MOV R8CPTR,R4PATR FIND FIRST PRECEEDING ATTRIBUINST3 JGT $-4 JGT PRV1 WAL270781 INST4 JEQ $-6 JEQ PRV1 WAL270781 PAGE CKATR CZC @C00,R12 "COLUMN ZERO" ATRB? WAL140681 JEQ CKATR1 YES, DOESN'T COUNT, SET .NE. WAL140681 ANDI R12,>C000 CHECK FOR ATTRIBUTE WAL140681 CI R12,>8000 CHECK ATRB & GRAPHICS BITS WAL270781 RT CKATR1TE WAL270781 BL @PRV AND ACE WAL270781 * ATRS2 MOV R8CPTR,R6NSPC WAL270781 BL @NXTSPC FIND FIRST TRAILING SPACE WAL140681 JMP ATREX WAL140681 PAGE * * PRV CLR R12 WAL270781 CLR R5PSPC NO PREVIOUS SPACE YET WAL CI R11,0 MUST BE NON-ZERO WAL140681 RT WAL140681 * * NXTSPC INC R6NSPC LOOK FOR NEXT SPACE WAL140681 MOVB *R6NSPC,R12 GET CHAR WAL1406 CB R12,@SPACE CHECK FOR SPACE WAL080781 JH NXTSP1 NOT A SPACE WAL270781 JEQ NXTSPR 270781 **!!! SELF MODIFYING CODE!!! WAL270781 MOV @INST1,@PRV2 SET UP INSTRUCTIONS WAL270781 MOV @INST2,@PRV3 WAL270781 PRV1 DEC R4PATR BACK UP WAL270781 MOVB *R4,R12 GET BYTE WAL270781 **!!! MODIFIED AT RUN TIME WAL270781 PRV2 JMP $  YES WAL080781 CB R12,@INSSPC OR INSERT SPACE WAL080781 JL NXTSPR NO WAL080981 CB R12,@TABSPC OR TAB OR CODE SPACE WAL080781 JH NXTSP2 NO WAL080981 JMP NXTSPR YES, RETURN WAL080981 NXTSP1 CZC @C00,R12 "COLUMN ZERO" ATRB?  JLT PRVATR OR JGT PRV1 WAL270781RV3 JMP $ JMP PRSCHK OR JEQ PRV1 WAL270781 * WAL270781 PRVATR SLA R12,1 MAY BE AN ATRB WAL270781 JLT PRV1 NO, GRAPHICS WAL270781 ANDI R12,>1800 IS IT A COL 0 ATRB? WAL270781 JEQ PRV5 YES  WAL080781 JEQ NXTSP2 YESDOESN'T COUNT WAL080781 SLA R12,1 CHECK FOR ATTRIBUTE WAL080781 JLT NXTSP2 NO, >4000 BIT SET WAL080781 JOC NXTSPR YES, >8000 BIT SET WAL080781 NXTSP2 CI R6NSPC,0 TO END OF LINE? WAL080781 LINEND EQU $-2 WAL270781  WAL270781 MOV R5PSPC,R5PSPC ATRB, PRV SPACE FOUND YET? WAL270781 JNE PRV4 YES WAL200881 MOV R4PATR,R5PSPC NO, THIS BECOMES IT WAL270781 PRV4 RT WAL270781 * WAL270781 PRV5 MOVB *R7,R12 GET SAVED BYTE WAL2707JL NXTSPC NO, CONTINUE LOOKING WAL080781 LI R6NSPC,NULATR POINT TO NULL BYTE WAL140681 NXTSPR RT WAL080781 * WAL140681 * WAL140681 CHKSPC CB R12,@SPACE CHECK FOR SPACE WAL140681 JHE CHKSPR 81 JLT PRV1 IF ATRB, NOT INTERESTED WAL170981 JMP PRV2 CHECK IT OUT WAL270781 * WAL270781 PRSCHK CI R12,>2000 SPACE? WAL270781 JGT PRV1 NO WAL270781 JEQ PRV6 YES WAL270781 CI R12,>1C00 A      TABLE? WAL140681 JLE CHKPN1 NO WAL140681 CHKPN2 RT WAL140681 ELSE $OMNI1,$OMNI3 * * OMNI-1/OMNI-3 DISPLAY CHARACTER ROUTINE * SCREX EQU $ * * MOV *R7CRCL,R3 R3 = COL # MOV *R8CRLN,R2 R2 = LINE # SLA R2,1 X 2 FOR WORD INDEX MOV @TOPLIN(R2),R2 GET PTR TO START OF LINE  R1 WAL140681 CB *R12,@INSSPC INSERT SPACE? WAL140681 JEQ REPSP1 YES WAL140681 INC R1 WAL140681 CB *R12,@TABSPC TABBED SPACE? WAL140681 JNE REPATR NOT A SPACE, MUST BE AN ATRB WAL140681 REPSP1 INC R1 SLA R3,1 LINE ADDRESS A R3,R2 FIGURE PTR TO WORD IF $OMNI1 MOV *WP,R3 GET THE CHAR TO DISPLAY SRL R3,8 INTO RIGHT BYTE WAL140681 MOV @$CHRMO,R1 COC @UNLBIT,R1 UNDERLINE BIT SET? TS070682 JNE SCRAT1 NOT SET ANDI R1,>EFFF MASK OUT >1000 BIT ORI R1,>80 UNDERLINE BIT SCRAT WAL140681 SLA R0 GET SPACE TYPE BITS WAL140681 REPSP2 SOCB R2,R1 PUT IN ATRB BITS WAL140681 MOVB R1,*R12 STORE IT IN DISPLAY BUFFER WAL140681 RT WAL140681 REPATR MOVB *R12,R1 REPLACING ATRB,SAVE SPACE-TYPE BITS WAL140681 ANDI R1,>C00 GET RID OF ATRB BITS 1 SOC R1,R3 ADD CURRENT ATTRIBUTES WAL140681 MOV R3,*R2 SAVE IN SCREEN BUFFER ELSE $OMNI3 BLWP @MAPDSP MOVB @$CHRMO,*R2+ PUT IN CURRENT ATRB MOVB *WP,*R2 PUT IN CHAR BLWP @MAPOFF ENDI $OMNI1 * * * * UPDATE POINTERS * SCHDN MOV *R7CRCL,R1 MOVB @$80COL,R2 CHECK IF WINDOWING ENABLED DPG030682 JNE SCHDN1 NO, CHECK FOR END WAL140681 JMP REPSP2 PUIN NEW ATRB WAL140681 * WAL140681 * WAL140681 RSTSPC MOVB *R12,R1 REPLACE ATRB WITH SPACE WAL140681 C R12,@COL0PS SCREEN COL 0 BYTE? WAL270781 JEQ RSTSP1 YES, DO SAVED BYTE WAL270781 RSTSP0 SLA  OF SCREEN DPG030682 CI R1,CHPRLN-1 AT END OF LINE? SCHDN0 JHE EOLL - YES INC *R7CRCL - NO, MOVE CURSOR RIGHT EOLL RTWP AND RETURN SCHDN1 CI R1,SCRWID-1 CHECK FOR END OF SCREEN WAL051081 JMP SCHDN0 WAL051081 ENDI $OMNI2 PAGE * * ERASE TO END OF LINE * ERSELN DATA SCRREG DATA $+2 MOV *R7CR1,4 GET RID OF LEADING BITS WAL1481 SRL R1,14 GET SPACE TYPE BITS WAL140681 MOVB @NULATR(R1),*R12 PUT IN SPACE WAL140681 RT WAL140681 RSTSP1 SZCB @C00,*R12 CLEAR SPACE TYPE BITS WAL270781 MOV R7,R12 POINT TO SAVED BYTE WAL270781 JMP RSTSP0 CHANGE IRCL,R1 MOV *R8CRLN,R2 BL @EEOLSB ERASE THIS ONE RTWP AND RETURN * * ERASE TO END OF SCREEN * ERSEES DATA SCRREG DATA $+2 MOV *R7CRCL,R1 THE REMAINDER OF CURRENT LINE MOV *R8CRLN,R3 EEOS1 MOV R3,R2 BL @EEOLSB DO THE LINE CLR R1 ALL BUT FIRST ARE FROM START INC R3 NEXT LINE CI R3,NLINES SEE IF T WAL270781 * WAL140681 * WAL140681 CKWND MOV R8CPTR,R10PCP SAVE ORIGINAL PTR WAL140681 CLR @COL0PS NO COLUMN POS FOR INHIBITED LINE WAL270781 MOVB @LNINHW,R1 CURRENT LINE WINDOW INHIBITED? WAL080781 JLT CKWNDX -IT'S WINDOW INHIBITED, IGNORE DONE JL EEOS1 -NOT YET WAL051081 RTWP -Y, RETURN * * ERASE TO END OF LINE IN R2, STARTING AT THE POSITION IN R1 * EEOLSB SLA R2,1 GET START ADDRESS OF LINE MOV @TOPLIN(R2),R2 * * AUX ENTRY: R2 = LINE ADDRESS * R1 = START COL # FOR ERASE EEOLIN MOVB @$BLNKC,R9 GET BLANKING CHAR WAL270781 IF $OMNI1*$OMNI2 ANDI R9,>7F00 WAL140681 MOV @SCROFS,R1 CHK CURRENT HORIZONTAL POSITION WAL140681 INC R1 SKIP SAVED BYTE WAL270781 A R7,R1 PLUS LINE ADR WAL270781 MOV R1,@COL0PS SAVE SCREEN COLUMN 0 POSITION PTR WAL270781 C R1,R8CPTR TO SEE IF WE'RE ON THE OFFSET BYTE WAL270781 JNE CKWNDX -N WAL140681 MOV R7LMAYBE WAL080981 B R12,@INSSPC OR INSERT SPACE WAL140681 JLE CHKSPR MAYBE WAL080981 CB R12,@TABSPC OR TAB SPACE WAL140681 JHE CHKSPR MAYBE WAL080981 C R0,R0 MUST BE CODE SPACE, SET .EQ. WAL080981 CHKSPR RT PTR,R8CPTR -Y, SET PTR TO SAVE LOCATION WAL27078 CKWNDX RT AND RETURN WAL140681 * * WAL140681 CHKPNC LI R12,PNCTBL CHECK IF PUNCTUATION WAL140681 CHKPN1 CB *R12+,*R8CPTR POINTING TO PUNCTUATION? WAL140681 JEQ CHKPN2 YES WAL140681 CI R12,PNCTND TO END OF WAL140681 PAGE WAL140681 REPSPC CLR R1 REPLACE SPACE OR ATRB WITH NEW ATRB WAL140681 CB *R12,@SPACE NORMAL SPACE? WAL140681 JEQ REPSP1 YES WAL140681 CB *R12,@CODSPC CODE SPACE? WAL080981 JEQ REPSP1 YES, TREAT AS NORMAL SPACE WAL080981 INCA      DON'T USE TOP BIT WAL270781 ENDI MOV R6CHPR,R4 GET BYTE COUNT WAL170881 IF $OMNI2 WAL051081 C *R8CRLN,@MAXLN ON LAST (ERROR) LINE? WAL260882 JNE EEOLN0 NO WAL260882 LI R4,SCRWID YES, ONLY 80 COLUMNS THERE WAL260882 EEOLN0 MOV R1,R1 CHECK FOR SCRREG DATA $+2 CLR START AT COL 0 CLR R3 LINE 0 JMP EEOS1 ERASE SCREEN ENDI * * * GETLIN - GET LINE POINTER AND SET WINDOW INHIBIT STATUS * * THIS ROUTINE TAKES IN R2 A LOGICAL LINE NUMBER, AND RETURNS IN * R2 THE POINTER TO THE START OF THE LINE IN THE WCREEN BUFGFER, * AND SETS THE ARITHMETIC LESS-THAN IF THAT LINE IS WINDOW * INHIBITED. * GETLIN EQU $  COL 0 WAL140681 JNE EEOLN1 NO WAL140681 DEC R1 YES, USE COL -1 (ATRB BYTE) WAL140681 EEOLN1 S R1,R4 # OF COLS TO ERASE ELSE $OMNI1,$OMNI3 WAL051081 S R1,R4 # OF COLS TO ERASE JEQ ERSRT NONE SLA R1,1 X 2 FOR BYTE COUNT WAL051081  WAL140681 LI R1WNTBL ASSUME ONE OF FIRST 16 LINES WAL281081 CI R2,16 AND CHECK WAL080781 JL $+4 WAL080781 INCT R1 -N MOV *R1,R1 GET PROPER WORD WAL051181 ANDI R0,>FF00 PRESERVE BANK NUMBER 050481DPG A R2,R0  ENDI $OMNI2 WAL051081 A R2,R1 COLUMN + LINE ADR WAL170881 IF $OMNI2 WAL051081 INCT R1 SKIP SAVED CHAR & ATRB WAL170881 MOV R2,R5 LINE ADR WAL170881 INC R5 SKIP SAVED BYTE WAL170881 A @SCROFS,R5  ADD LINE NO. TO R0 FOR WNDTBL SHIFT 050481DPG SLA R2,1 AND GET PTR TO STRT OF LINE JEQ GTLIN1 LINE 0, NO SHIFT DESIRED WAL051181 SLA R1,R0 SHIFT INHIBIT BIT TO THE SIGN WAL270182 GTLIN1 MOV @TOPLIN(R2),R2 GET LINE ADR MOV R1,R1 SET STATUS FOR INHIBIT WAL051181 RT PAGE IF $OMNI3 MAPDSP EQU $ DATA MAPREG,$+2 * * MAP IN DISPLAYADR OF SCREEN COL 0 WAL170881 * C R9,@TABSPC CHECK TYPE OF SPACE WAL270781 JL EEOLN2 LOWER, MUST BE INSERT SPACE WAL140681 JEQ EEOLN3 EQUAL, MUST BE TAB SPACE WAL080781 ORI R9,>84 ATRB FOR COVERING BLANK WAL170881 JMP EEOLN4 WAL140681 EEOLN2 ORI R9,>88 ATRB FOR COVERING INSERT  BUFFER * MAPPED IN AT ADDRESS >4000->7FFF * DESTRO NOTHING * LIMI 0 NO INTERRUPTS WHILE IN PROGRESS MOV *R11,R9 SAVE CURRENT MAP MOV *R12,R10 ALL FOUR PAGES MOV R7,*R11 SET IT FOR DISPLAY BUFFER MOV R8,*R12 RTWP * * MAPOFF EQU $ DATA MAPREG,$+2 * * RESTORE MAP TO ORIGINAL CONDITION * LIMI 0 NO INTERRUPTS! MOV R9,*R11 MOV SPACE WAL170881 JMP EEOLN4 WAL140681 EEOLN3 ORI R9,>8C ATRB FOR COVERING TABBED SPACE WAL170881 EEOLN4 EQU $ WAL281081 SWPB R9 TO LOWER BYTE WAL051081 MOVB R9,*R1+ PUT ATRB IN BUFFER WAL170881 SWPB R9 BACK TO BLANKING CHAR WAL170881  R10,*R12 RTWP * DATA >FCFD R7, PAGES FOR 1ST HALF DISPLAY BUF DATA >FEFF R8, PAGES FOR SECOND HALF DATA 0 R9, SAVED PAGES FOR 1ST HALF DATA 0 R10, SAVED PAGES FOR 2ND HALF DATA >FFE4 R11, MAP TO >4000 DATA >FFE6 R12, MAP TO >6000 DATA 0,0,0 R13-R15 MAPREG EQU $-32 ENDI $OMNI3 * GRAPH DATA 0 JMP ERSB1 BUMP COUNT WAL140681 ERSB2 MOVB R9,*R2 BLANK OUT SAVED CHAR WAL170881 MOVB @$H8000,*R1+ PUT NULL ATRB IN SCREEN COL 0 WAL170881 JMP ERSB1 AND CONTINUE WAL170881 ERSB C R1,R5 ON SCREEN COL 0? WAL170881 JEQ ERSB2 YES, SPECIAL ACTION WAL170881 OVB R9,*R1+ NO,/ FLAG AND MASK FOR GRAPHICS INVERSION *A* *SAVERT DAT 0 / TEMPORARY STORAGE FOR RB RETURN ADRL *A* *PROTCT DATA 0 / TEMPORARY STORAGE FOR PROTECTED LINES*A* MAXLN DATA NLINES NUMBER OF LINES WAL260882 *  BLANK IT WAL170881 ELSE $O1,$OMNI3 SRL R9,8 BLANKING CHAR TO RIGHT BYTE WAL051081 IF $OMNI3 BLWP @MAPDSP MAP IN DISPLAY PAGE ENDI ERSB MOV R9,*R1+ WAL281081 ENDI $OMNI2 ERSB1 DEC R4 'TILL LINE FULL JNE ERSB IF $OMNI3 BLWP @MAPOFF RESTORE ORIGINAL MAP ENDI ERSRT RT THEN RETURN WAL140681 PAGE * * INITIALIZE LINE TO BLANKS * LINBLK DATA SCRREG DATA $+2 MOV *WP,R2 START ADDRESS OF LINE CLR R1 ERASE FROM COL 0 BL @EEOLIN CHARACTER CHANGED WAL051081 RTWP WAL051081 IF $OMNI1*$OMNI2 * * INITIALIZE SCREEN TO BLANKS * SCRBLK DATA B     0381DPG * INCLUDE FILE TABLE SECTION VALUES * CNTSEEQU 0 CONTROL SECTION KBDSEC EQU 1 KEYBOARD CHARACTER DEFINITION SECTION DSPSEC EQU 2 DISPLAY CHARACTER DEFINITION SECTION ACCSEC EQU 3 ACCENT TABLE SECTION * PAGE ****************************************************************** * GENERATE THE DISPLAY CHARACTER TABLE FOR DETEMINING THE * * PROCESS TO BE EXECUTED AND THE CHARACTER MAPPING TABLE. 'DSPTB2' ENDI IF TBLOPT-3 TIT 'OMNI3 DISPLAY TABLES' IDT 'DSPTB3' ENDI IF TBLOPT-6 TITL 'OMNI2 DISPLAY TABLES - U.K. VERSION' IDT 'DSPTB6' ENDI *************************************************************** * * * ***** **** ***** ******* ***** * * * * * * * * * * * * * * * * * *  * **************************************************************** * * 130381 DPG CREATED * * * CHARACTER PROCESS FUNCTION DEFINITIONS * ASIS EQU 0 CHARACTER SENT AS IS FUNC EQU 1 CHARACTER IS A FUNCTION CODE MAP EQU 2 CHARACTER IS TO BE MAPPED NULL EQU 3 IGNORE CHARACTER DEF $PROTB,$MAPTB,$ACNTB REF'D BY DISPLY MODULE ** DSPTBL MACRO - * MACRO TO GENERATE THE CHARACTER PRO * * * * * * * * * * ** ***** * ***** * * * * * * * * * * * * * * * * * * * * * * * * ***** **** * * ***** ****** * * * * (DISPLY:DSPSRC.DSPTBL) * * COPYWRITED, OMNIDATA, INC., WESTLAKE VLG, CA., AUGUST, 1981 * **************************CESS TABLE * * CALL: DSPTBL CHAR,PROC,MCHR * * WHERE - CHAR = CURRENT CHARACTER * PROC = ASIS,FUNC,MAP OR NULL * MCHR = CHARACTER TO MAP TO IF PROC = MAP * DMAC .L DSPTBL .C,.P,.M .L WDVL SETV WDVL*4+.P CNT SETV CNT+1 IF CNT-8 LIST M DATA WDVL LIST -M CNT SETV 0 ENDI ENDM ************************************************* * GENERATE THE CHARACTER PROCESS TABLE * ************************************************** * CHANGE LOG - * 170381 DPG COMBINE THE KEYBOARD CONTROL TABLE, KEYBOARD CHAR DEFINITION * TABLE, DISPLAY PROCESS TABLE, DISPLAY MAPPING TABLE, AND * THE $GTCHR ACCENT TABLE INTO ONE MODULE. * 170881 WAL DEFINED SOME SHIFTED FUNCTION KEYS FOR GRAPHICS INPUT * ON OMNI2; REDEFINED CODE + AND COMMA; CHANGED MAPPING * FOR CODES >AD AND >AF * 010981 WAL SPLIT CHRTB2 INTO TWO SECTIONS FOR FASTER ASSEMBLIES; ALLOW * ************************************ CNT SETV 0 WDVL SETV 0 $PROTB EQU $ TBLSEC SETV DSPSEC IF TBLOPT-1 INCL DSPTB1:2 ENDI IF TBLOPT-2 INCL DSPTB22 ENDI IF TBLOPT-3 INCL DSPTB2:2 ENDI IF TBLOPT-6 INCL DSPTB6:2 ENDI PAGE ** DSPTBL MACRO - * MACRO TO GENERATE THE CHARACTER MAPPING TABLE * DMAC .L DSPTBL .C,.P,.M .L CHR SETV .C MCHR SETV  BULLET CHAR TO REPEAT; ON KEYBRD MAP 00 TO A2; ON DISAY, * MAP 5F TO 2D (HYPHEN), A0 TO 58 (X), A1 TO 2F (/), A2 TO 30 * (0), 82 AND 98 TO 5F (NULL CHAR) * 030282 JDT CHANGED THE KEY PAD 00 KEY TO BE A IDENTICAL TO THE DEC TAB * KEY. ALSO ADDED NEW DISPLAY INCLUDE FILE IDENTICAL TO CHRTB2 * EXCEPT THAT THE UPPER CASE 6 KEY IS DISPLAYED AS AN ENGLISH * POUND SIGN. * * 19-03-82 AWV * ADDED NEW 'DSPTBL' ENTRIES FOR PE .M A SETV CHR/DIV * B = BI TRAILING THE CURRENT NODE BYTE OFFSET B SETV A*DIV B SETV CHR-B * BIND = CURRENT BYTE INDEX WITHIN CURRENT NODE WORD BIND SETV A/2*2 BIND SETV A-BIND * WIND = CURRENT WORD INDEX WITHIN CURRENT NODE WIND SETV A/4*4 WIND SETV A-WIND/2 * IF FIRST CHAR USING THIS NODE - INIT IT IF B+BIND+WIND ND0 SETV 0 ND1 SETV 0 RTEC PCC1000 INCLUDING THE * FOLLOWING: >04='LI'=LINE INSERT * >05='LD'=LINE DELETE * >11='CF'=CURSOR FORWARD (NO WRAP) * >12='CP'=CURSOR FORWARD (WITH WRAP) * >13='CM'=CURSOR BACKWARDS (WITH WRAP) * >14='UK'=UNLOCK KEYBOARD (CLEAR BUFFER) * >ED='GF'=GRAPHICS OFF (CHARACTER MAPPING) *  ENDI * IF CHAR IS MPED IF .P-MAP * IF LAST NODE (CHAR NODE) IF DIV-1 * SET CHAR INTO NODE SETLNK MCHR * ELSE ELSE * SET LINK TO NEXT NODE FOR CHAR SETLNK SPACE * ENDI ENDI * ENDI ENDI *  >EF='GO'=GRAPHICS ON (CHARACTER MAPP) * * CHANGES ARE MARKED *A* * * * 11-05-82 CHANGED U.K.SYTEM TO HAVE ITS OWN KEYBOARD TABLE (KEYBD6) * AND TO HAVE 6 KEY GENERATE 6,POUND,BAR,2BARS * SCREEN TABLE (CHRTB6) SHOULD NOW BE AS U.S. RTJW * 26-05-82 TS * ADDED NEW DSPTBL ENTRIES * >15: KEYBOARD LOCK ( NEGLECT 8MS INTERRUPT) * >16: KEYBOARD UNLOCK *  >17: INSERT SINGLE CHARACTER * >18: DELETE SINGLE CHARACTER * >19: CURSOR ON * >1A: CURSOR OFF * * 11-05-83 REMOVED BOTH TA VERSIONS AND THE FRENCH VERSION. ADDED * OPTION 3 AS OMNI3 TABLES. (DPG) * ******************************************************************************** PAGE * 16* LAST CHANGED 11 MAY 82 DPG TBLOPT SETV 1 X2000 CHARACTER TABLES 130381DPG 2TBLOPT SETV 2 OPTION 2 = OMNI2 CHARACTER TABLES 3TBLOPT SETV 3 OPTION 3 = OMNI3 CHARACTER TABLES DPG110583 6TBLOPT SETV 6 OPTION 6 = U. K. VERSION OF THE OMNI2 CHARS 030282JDT IF TBLOPT-1 TITL 'X2000 DISPLAY TABLES' IDT 'DSPTB1' ENDI IF TBLOPT-2 TITL 'OMNI2 DISPLAY TABLES' IDT B      IF CHAR IS LAST ONE DEALING WITH THIS E IF DIV-B-1 IF WIND+BIND-2 IF ND0+ND1 * IF NODE CONTAINS SOMETHING ELSE LIST LIST M * GENERATE NODE DATA ND0,ND1 UNL ENDI * ENDI ENDI * ENDI ENDI ENDM ** SETLNK MACRO - * TO SET A NEW LINK INTO THEPT-6 INCL DSPTB6:2 ENDI END  CURRENT NODE WORD, IF NOT ALREADY SET * DMAC SETLNK .VAL * IF IN FIRST NODE WORD (ND0) IF WIND * IF FIRST BYTE IN WORD IF BIND A SETV ND0/256 OFFS SETV .VAL*256 * ELSE SECOND BYTE IN WORD ELSE A SETV ND0/256*256 A SETV ND0-A OFFS SETV .VAL * ENDI ENDI * IF LINK NOT ALREADY SET IF A * SET LINK (OR CHAR) INTO NODE ND0 SETV ND0+OFFS * INC NEXT AVAIL NODE POINTER SPACE SETV SPACE+4 * ENDI ENDI * ELSE SECOND WORD (ND1) ELSE * IF FIRST BYTE IN WORD IF BIND A SETV ND1/256 OFFS SETV .VAL*256 * ELSE SECOND BYTE IN WORD ELSE A SETV ND1/256*256 A SETV D1-A OFFS SETV .VAL * ENDI ENDI * IF LINK NOT ALREADY SET IF A * SET LINK (OR CHAR) INTO NODE ND1 SETV ND1+OFFS * INC NEXT AVAIL NODE POINTER SPACE SETV SPACE+4 * ENDI ENDI * ENDI ENDI ENDM * * GENERATE THE MAP TABLE (TREE WITH FOUR BRANCHS PER NODE. THE * TREE HAS 4 LEVELS INCLUDING THE ROOT NODE. THE LAST NODE * CONTAINS 4 CHARACTERS) * $MAPTB EQU $ SPACE SETV 4 INITIALIZE NEXT AVALIABLE NODE OFFSET TBLSEC SETV DSPSEC GET DISPLAY CHARACTER TABLE FROM INCL FILE * LEVEL 0 (ROOT NODE) DIV SETV 64 UNL IF TBLOPT-1 INCL DSPTB1:2 ENDI IF TBLOPT-2 INCL DSPTB2:2 ENDI IF * * * MEMORY SWITCHING MACRO * * * ENPG [,] * * ::= CPU CRT * * ::= 0 1 2 3 * * ENPG SETS THE MEMORY SWITCHING BITS FOR THE BANK SPECIFIED. * BANK 0 IS 32-64K, BANK 1 IS 64-96K, BANK 2 IS 96-128K, AND * BANK 3 IS 128-160K. IF THE BANK # IS OMITTED, BANK 0 IS * SELECTED. * * DMAC ENPG .DEV,.BANK IF '.DEV'-'CPU' IF '.BANK'-' ' RESTORE SBZ 3  TBLOPT-3 INCL DSPTB2:2 ENDI IF TBLOPT-6 INCL DSPTB6:2 ENDI LIST * LEVEL 1 DIV SETV 16 UNL TBLSEC SETV DSPSEC IF TBLOPT-1 INCL DSPTB1:2 ENDI IF TBLOPT-2 INCL DSPTB2:2 ENDI IF TBLOPT-3 INCL DSPTB2:2 ENDI IF TBLOPT-6 INCL DSPTB6:2 ENDI LIST * LEVEL 2 DIV SETV 4 UNL TBLSEC SETV DSPSEC IF  CPU B = 0 SBZ 2 CPU A = 0 ELSE IF .BANK BANK 0 SBZ 3 CPU B = 0 SBZ 2 CPU A = 0 ENDI IF .BANK-1 BANK 1 SBZ 3 CPU B = 0 SBO 2 CPU A = 1 ENDI IF .BANK-2 BANK 2 SBO 3 CPU B = 1 SBZ 2 CPU A = 0 ENDI IF  TBLOPT-1 INCL DSPTB1:2 ENDI IF TBLOPT-2 INCL DSPTB2:2 ENDI IF TBLOPT-3 INCL DSPTB2:2 ENDI IF TBLOPT-6 INCL DSPTB6:2 ENDI LIST * LEVEL 3 (MAP CHARACTERS) DIV SETV 1 UNL TBLSEC SETV DSPSEC IF TBLOPT-1 INCL DSPTB1:2 ENDI IF TBLOPT-2 INCL DSPTB:2 ENDI IF TBLOPT-3 INCL DSPTB2:2 ENDI IF  .BANK-3 BANK 3 SBO 3 CPU B = 1 SBO 2 CPU A = 1 ENDI ENDI ENDI IF '.DEV'-'CRT' IF '.BANK'-' ' NO BANK SBZ 5 CRT B = 0 SBZ 4 CRT A = 0 ELSE IF .BANK BANK 0 SBZ 5 CRT B = 0 SBZ 4 CRT A = 0 ENDI IF .BANK-1 BANK 1 TBLOPT-6 INCL DSPTB6:2 ENDI LT PAGE ***************************************************************** * ACCENT AND ACCENTED CHARACTER TABLE FOR KEYBOARD INPUT * ***************************************************************** $ACNTB EQU $ TBLSEC SETV ACCSEC IF TBLOPT-1 INCL DSPTB1:2 ENDI IF TBLOPT-2 INCL DSPTB2:2 ENDI IF TBLOPT-3 INCL DSPTB2:2 ENDI IF TBLOC      ALLOW FOR ERROR LINE * MOV R10PLN,@SCRG 1ST TIME, SET # OF PROTECTED LINES * DEC R10PLN REMOVE ERROR LINE LI R1,NLINES*2+LINOUT FIRST LINE TO DO (BLANK LINE) MOV R1,R2 DECT R1 LI R3,NLINES S R10PLN,R3 # OF LINES TO DO BL @DSPMAP SWITCH ON MAP MOV *R2,R0 SAVE BLANK LINE ADR SCRL6 MOV *R1,*R2 MOVE LINE DECT R1  NEXT LINE UP DECT R2 DEC R3 DONE? JNE SCRL6 MOV R0,*R2 YES, PUT BACK BLANK LINE BL @MAPOFF TURN MAPS BACK OFF * LI R9SCRC,VBLK SET SCROLL REG LIMIT * *SCRL7 DEC R9SCRC BUMP SCROLL REG SCRL8 MOV R9SCRC,@SCRREG SET SCROLL REG JNE HORCHK STILL IN PROGRESS CLR R12SCF DONE WITH SCROLL PAGE * * CHECK FOR CHANGE NEEDED *LAST CHANGE 21 MAR 83 (WAL) * * INTERRUPT CODE FOR OMNI 3 DISPLAY * DEF $SCRFG SCROLLING IN PROGRESS FLAG DEF $PRTCL NUMBER OF PROTECTED LINES DEF $DHTWD DOUBLE HEIGHT/WIDTH FLAG DEF DSPREG,DSPINT INTERRUPT SERVICE VECTOR * R6MMIO EQU R6 R7DBHW EQU R7 R8OFST EQU R8 R9SCRC EQU R9 R10PLN EQU R10 R12SCF EQU R12 * NLINES EQU 24 24 REGULAR LINES (+ERROR+BLANK) LINOUT IN HORIZONTAL POS (WINDOWING) * HORCHK EQU $ C R8OFST,@$SCROF HAS HORIZONTAL OFFSET CHANGED? JEQ DBHTWD NO MOV @$SCROF,R8OFST NEW VALUE MOV R8OFST,R3 GET VALUE SRC R3,7 TO CORRECT BIT POSITIONS LI R1,LINOUT POINT TO LINOUT TABLE MOV @$WNTBL,R0 WINDOW INHIBIT BITS BL @DSPMAP MAP IN DISPLAY PAGE * WDCHK1 MOV *R1,R2 GET LINEQU >4002 (ALLOW FOR ERROR LINE) VBLK E 12 SCAN LINES PER ROW SCRREG EQU >FF2E MEMORY MAPPED ADR FOR SMOOTH SCROOL SCRSTR EQU >FF24 MEM MAPPD ADR FOR 1ST LINE TO SCROLL * DSPREG EQU $ DISPLAY REGS DATA 0!6 R0-R5, SCRATCH DATA >FFE4 R6, MEMORY MAPPED ADR FOR MAPPING $DHTWD DATA 0 R7, DOUBLE HEIGHT/WIDTH CHANGE FLAG DATA 0 E ADR FROM LINOUT TABLE ANDI R2,>FE CLEAR LEAST SIGN BITS (COL 0) SLA R0,1 WINDOW INHIBITED JOC WDCHK2 YES A R3,R2 NO, ADD IN WINDOW OFFSET WDCHK2 MOV R2,*R1+ UPDATE IT *NOTE: THIS WORKS ONLY BECAUSE LINES START ON 512 BYTE BOUNDARIES CI R1,LINOUT+16+16 HAVE WE DONE 16 LINES YET? JL WDCHK1 NO JNE WDCHK3 MORE THAN 16, CHECK FOR END R8, LAST WINDOW OFFSET DATA 0 R9, COUNT FOR SMOOTH SCROLL $PRTCL DATA 0 R10, # OF PROTECTED LINES DATA 0 R11, SCRATCH $SCRFG DATA 0 R12, SCROLL IN PROGRESS DATA 0!3 R13-R15 * DSPINT EQU $ INTERRUPT ENTRY POINT MOV R12SCF,R12SCF SCROLL IN PROGRESS? JEQ HORCHK NO JLT SCRL5 SCROLL DOWN MO MOV @$WNTBL+2,R0 YES, NEED MORE WINDOW HIBIT BITS WDCHK3 CI R1,LIOUT+NLINES+NLINES DONE THEM ALL YET? JLE WDCHK1 NO * BL @MAPOFF RESTORE MAP * * CHECK FOR DOUBLE HEIGHT/WIDTH CHANGES * DBHTWD EQU $ MOV R7DBHW,R7DBHW WAS THERE A CHANGE? JEQ DSPRT NO *!!! HAVE TO WORK THIS ONE OVER LATER * DSPRT RTWP * * MAP DISPLAY BUFFER (LINE OUT TABLE ONLY) INTO MEMORY * DSPMAP MOVB *R6MMIO,V R9SCRC,R9SCRC CHECK SCROLL COUNT JNE CRL1 NOT FIRST TIME INC R10PLN ALLOW FOR ERROR LINE MOV R10PLN,@SCRREG 1ST TIME, SET # OF PROTECTED LINES DEC R10PLN TAKE IT BACK OUT SCRL1 INC R9SCRC BUMP COUNT CI R9SCRC,VBLK DONE WHOLE SCROLL? JEQ SCRL2 YES MOV R9SCRC,@SCRREG SET NEW VALUE JMP HORCHK CHECK IF HORIZONTA@SAVMAP SAVE BYTE REPLACED MOVB @HFC,*R6MMIO MAP 1ST PAGE IN AT >4000 RT * MAPOFF MOVB @SAVMAP,*R6MMIO RESTORE MAP TO FORMER CONDITION RT * HEXFC BYTE >FC MEMORY MAP FOR FIRST PAGE SAVMAP BYTE 0 SAVE MEMORY MAP LOC * L CHANGE * SCRL2 EQU SCROLLING DONE, AUST TABLE LI R1,LINOUT POINT TO ROW TABLE A R10PLN,R1 1ST LINE TO DO A R10PLN,R1 (TWICE FOR WORD ADR) MOV R1,R2 INCT R1 NEW FIRST LINE LI R3,NLINES NUMBER OF LINES TO DO S R10PLN,R3 MINUS # PROTECTED BL @DSPMAP MAP IN DISPLAY STUFF MOV *R2,R0 SAVE LINE SBZ 5 CRT B = 0 SBO 4 CRT A = 1 ENDI IF .BANK-2 BANK 2 SBO 5 CRT B = 1 SBZ 4 CRT A = 0 ENDI IF .BANK-3 BANK 3 SBO 5 CRT B = 1 SBO 4 CRT A = 1 ENDI ENDI ENDI ENDM  SCROLLED SCRL3 MOV *R1+,*R2+ MOVE LINE AD DEC R3 DONE? JNE SCRL3 MOV R0,*R2 PUT TOP LINE AT END (BLANK LINE) BL @MAPOFF RESTORE MAP * CLR R9SCRC COUNT IS ZERO JMP SCRL8 SET SCROLL REG * SCRL5 EQU $ SCROLL DOWN (INSERT LINE) * MOV R9SCRC,R9SCRC FIRST TIME? * JNE SCRL7 NO * INC R10PLN C     ‚TBOOT990 ˆTBOOT990 IV.0 [a.3]å ’’Č   Ā JĘ JĘ ^JĘ JĘ JĘ JĘ  Ą`^ˆ!’Ą ńBżĮ`^ˆ%B*’ÜźźźźŹ ź ź źźźŹ„Ź„Ŗ Ź źźźź *’öŹ‚Ź‚ŹŠ ŖƒŹ źÉ ÅÅĵĄaĄaĄ” b‚ČJ”Č` ĄŹJĘ JʃJĘ JʂJĘ”JĘ  *’öĀJŹ‰Ź‰źźźĄa ČĄaĄ” b‚ČČJČ ĄŹJĘ JʃJĘ JʂJĘ”JĘ  Ą`Č!Ąa ą%ąĄ`Č`ŚĄŚ  ąČÓĄ“CÓĮ ” ŌDŌåõĄąCĄ“   ĀĀ ĄŚ  ąČCĄ“   ĀĀĄĪČĆ# ÄÄĄ`^ į  į ČCĻĄ` Č `ČĀą[`4TjLx $(.:@FLPZ`x’ø¾Ųąōž (2<LPnv†Ž– °“ø¾ĘŠŌŲäčų"&08FXbhlpt9 EåSYSUNT –2¾.NEGONE (OGEN BOOTMSG $TOSM GSEXOK Ę K SYSCMB FCSBM START SIB † B SEG  l0"ųäŌøŽONE ō’Z EREC vCE OPTABLE ROOTTASKXTOATKSEVEC CUTBACK 8Ų KSYSREAD “PP DNIL SYSBLK øFKL CHKSEX åDBUG DIRSZ TBOOT990 TBOOT990INIT TEMP TRAPSNAPCPOFST hbŲŠ¾TRUE SEGHI &č MEMTOPB (TMPO BZERO ° L<xL:SEGDSZ `@ZS SAVRTN tNT GBLVEC n žąSEGWORD CPOOL pOO L  ååååååD     åååååååååååååååD     åååååååååååååååE     åååååååååååååååE     åååååååååååååååF     åååååååååååååååF     åååååååååååååååG     åååååååååååååååG     åååååååååååååååH     åååååååååååååååH     åååååååååååååååI     åååååååååååååååI     åååååååååååååååJ     åååååååååååååååJ     åååååååååååååååK     åååååååååååååååK     åååååååååååååååL     åååååååååååååååL     ååååååååååååååå